2873 lines
224 KiB
COBOL
2873 lines
224 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/19/08
|
|
00002 PROGRAM-ID. DTSCS48. DTSCS48
|
|
00003 AUTHOR. NGC. LV007
|
|
00004 DATE-WRITTEN. APRIL 2004. DTSCS48
|
|
00005 DATE-COMPILED. DTSCS48
|
|
00006 SKIP3 DTSCS48
|
|
00007 ***** DTSCS48
|
|
00008 * DTSCS48
|
|
00009 * FUNCTION: COMPROMISE SETTLEMENT INQUIRY/UPDATE DTSCS48
|
|
00010 * SCREEN PROCESSOR. DTSCS48
|
|
00011 * DTSCS48
|
|
00012 * DTSCS48
|
|
00013 * MODIFICATION LOG: DTSCS48
|
|
00014 * DTSCS48
|
|
00015 * 04/23/2004 INITIAL DEVELOPMENT. DTSCS48
|
|
00016 * REFERENCE: COMPROMISE PROGRAMMER: DTSCS48
|
|
00017 * DTSCS48
|
|
00018 * DTSCS48
|
|
00019 * 04/25/2007 MODIFIED CODE TO EXCLUDE SUR-TAX FROM INTEREST DTSCS48
|
|
00020 * CALC. DTSCS48
|
|
00021 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS48
|
|
00022 * DTSCS48
|
|
00023 * DTSCS48
|
|
00024 * 02/12/2008 MODIFIED CODE TO INCLUDE SUR-TAX IN INTEREST DTSCS48
|
|
00025 * CALC. DTSCS48
|
|
00026 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS48
|
|
00027 * DTSCS48
|
|
00028 * DTSCS48
|
|
00029 * DESCRIPTION: DTSCS48
|
|
00030 * DTSCS48
|
|
00031 * CLEAR: DTSCS48
|
|
00032 * DTSCS48
|
|
00033 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS48
|
|
00034 * DTSCS48
|
|
00035 * DTSCS48
|
|
00036 * JUMP: DTSCS48
|
|
00037 * DTSCS48
|
|
00038 * F19 QUARTER INQUIRY (31). DTSCS48
|
|
00039 * F20 COLLECTIONS INQUIRY (41). DTSCS48
|
|
00040 * DTSCS48
|
|
00041 * DTSCS48
|
|
00042 * INQUIRY: DTSCS48
|
|
00043 * DTSCS48
|
|
00044 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS48
|
|
00045 * DTSCS48
|
|
00046 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR48-HOLD-AREA EMP-NO DTSCS48
|
|
00047 * DISPLAY RECORD INDICATED BY DTSCS48
|
|
00048 * LCCM-SCR48-HOLD-AREA DTSCS48
|
|
00049 * ELSE DTSCS48
|
|
00050 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS48
|
|
00051 * WITH LCCM-EMP-NO. DTSCS48
|
|
00052 * DTSCS48
|
|
00053 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS48
|
|
00054 * DTSCS48
|
|
00055 * DISPLAY SEQUENCE: ASCENDING ON MCMP-ESTB-ABSTIME. DTSCS48
|
|
00056 * DTSCS48
|
|
00057 * PAGE INITIALLY DISPLAYED: LAST. DTSCS48
|
|
00058 * DTSCS48
|
|
00059 * DTSCS48
|
|
00060 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS48
|
|
00061 * DTSCS48
|
|
00062 * STORE INFORMATION REPRESENTING PAGE DTSCS48
|
|
00063 * CURRENTLY DISPLAYED IN LCCM-SCR48-HOLD-AREA. DTSCS48
|
|
00064 * DTSCS48
|
|
00065 * DTSCS48
|
|
00066 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS48
|
|
00067 * DTSCS48
|
|
00068 * MAINTAIN LCCM-COMP-DATE. DTSCS48
|
|
00069 * DTSCS48
|
|
00070 * DTSCS48
|
|
00071 * UPDATE: DTSCS48
|
|
00072 * DTSCS48
|
|
00073 * ADD DTSCS48
|
|
00074 * MOD DTSCS48
|
|
00075 * DEL DTSCS48
|
|
00076 * DTSCS48
|
|
00077 * DTSCS48
|
|
00078 * RECORDS READ: DTSCS48
|
|
00079 * DTSCS48
|
|
00080 * MASTER: DTSCS48
|
|
00081 * DTSCS48
|
|
00082 * MPRF DTSCS48
|
|
00083 * MCMP DTSCS48
|
|
00084 * MQTR DTSCS48
|
|
00085 * DTSCS48
|
|
00086 * DTSCS48
|
|
00087 * ALTERNATE INDEX: DTSCS48
|
|
00088 * DTSCS48
|
|
00089 * NONE. DTSCS48
|
|
00090 * DTSCS48
|
|
00091 * DTSCS48
|
|
00092 * REFERENCE: DTSCS48
|
|
00093 * DTSCS48
|
|
00094 * NONE. DTSCS48
|
|
00095 * DTSCS48
|
|
00096 * DTSCS48
|
|
00097 * ACCOUNTING TRANSACTION COLLECTION: DTSCS48
|
|
00098 * DTSCS48
|
|
00099 * NONE. DTSCS48
|
|
00100 * DTSCS48
|
|
00101 * DTSCS48
|
|
00102 * RECORDS UPDATED: DTSCS48
|
|
00103 * DTSCS48
|
|
00104 * MASTER: DTSCS48
|
|
00105 * DTSCS48
|
|
00106 * MCMP (WRITE, REWRITE, DELETE) DTSCS48
|
|
00107 * DTSCS48
|
|
00108 * MEVL (WRITE) DTSCS48
|
|
00109 * IF A CMP IS ADDED OR DELETED, THEN WRITE A MEVL RECORD DTSCS48
|
|
00110 * COMMEMORATING THE EVENT. DTSCS48
|
|
00111 * IF A CMP IS 'WITHDRAWN', THEN WRITE A DTSCS48
|
|
00112 * MEVL RECORD COMMEMORATING THE EVENT. DTSCS48
|
|
00113 * DTSCS48
|
|
00114 * DTSCS48
|
|
00115 * REFERENCE: DTSCS48
|
|
00116 * DTSCS48
|
|
00117 * NONE. DTSCS48
|
|
00118 * DTSCS48
|
|
00119 * DTSCS48
|
|
00120 * ACCOUNTING TRANSACTION COLLECTION: DTSCS48
|
|
00121 * DTSCS48
|
|
00122 * NONE. DTSCS48
|
|
00123 * DTSCS48
|
|
00124 * DTSCS48
|
|
00125 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS48
|
|
00126 * DTSCS48
|
|
00127 * NONE. DTSCS48
|
|
00128 * DTSCS48
|
|
00129 * DTSCS48
|
|
00130 * TEMPORARY STORAGE USAGE: DTSCS48
|
|
00131 * DTSCS48
|
|
00132 * NONE DTSCS48
|
|
00133 * DTSCS48
|
|
00134 * DTSCS48
|
|
00135 * MODULES LINKED TO: DTSCS48
|
|
00136 * DTSCS48
|
|
00137 * DTSCU001 DATE EDIT/CONVERSION. DTSCS48
|
|
00138 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS48
|
|
00139 * DTSCU011 AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS48
|
|
00140 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS48
|
|
00141 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS48
|
|
00142 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS48
|
|
00143 * DTSCU034 COLLECTIONS CODES EDIT/DESCRIPTION. DTSCS48
|
|
00144 * DTSCU071 NAME EDIT/CONVERSION. DTSCS48
|
|
00145 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS48
|
|
00146 * DTSCU101 INTEREST AND PENALTY CHARGE/ABATEMENT DTSCS48
|
|
00147 * COMPUTATION. DTSCS48
|
|
00148 * DTSCU111 ADDRESS LOOKUP. DTSCS48
|
|
00149 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS48
|
|
00150 * DTSCU221 EMPLOYER LOCK/UNLOCK. DTSCS48
|
|
00151 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS48
|
|
00152 ***** DTSCS48
|
|
00153 DTSCS48
|
|
00154 ENVIRONMENT DIVISION. DTSCS48
|
|
00155 DTSCS48
|
|
00156 DATA DIVISION. DTSCS48
|
|
00157 DTSCS48
|
|
00158 WORKING-STORAGE SECTION. DTSCS48
|
|
001585 77 PAN-VALET PICTURE X(24) VALUE '007DTSCS48 05/19/08'. DTSCS48
|
|
00159 DTSCS48
|
|
00160 01 WRK-AREA. DTSCS48
|
|
00161 05 WRK-ABEND-CD PIC X(04) VALUE 'S48 '. DTSCS48
|
|
00162 DTSCS48
|
|
00163 05 WRK-SCR-ID. DTSCS48
|
|
00164 10 WRK-SCR-ID-N PIC 9(02) VALUE 48. DTSCS48
|
|
00165 DTSCS48
|
|
00166 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS48
|
|
00167 DTSCS48
|
|
00168 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS48
|
|
00169 VALUE +999999999. DTSCS48
|
|
00170 DTSCS48
|
|
00171 05 SCR-ACCESS-IND PIC X(01). DTSCS48
|
|
00172 88 SCR-ACCESS-INQ VALUE '1'. DTSCS48
|
|
00173 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS48
|
|
00174 DTSCS48
|
|
00175 05 CURSOR-SET-IND PIC X(01). DTSCS48
|
|
00176 88 CURSOR-SET-YES VALUE 'Y'. DTSCS48
|
|
00177 88 CURSOR-SET-NO VALUE 'N'. DTSCS48
|
|
00178 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS48
|
|
00179 DTSCS48
|
|
00180 05 REQ-IND PIC X(01). DTSCS48
|
|
00181 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS48
|
|
00182 88 REQ-ERROR VALUE 'O'. DTSCS48
|
|
00183 88 REQ-JUMP VALUE 'J'. DTSCS48
|
|
00184 88 REQ-UPDATE VALUE 'U'. DTSCS48
|
|
00185 88 REQ-INQUIRE VALUE 'I'. DTSCS48
|
|
00186 88 REQ-CLEAR VALUE 'C'. DTSCS48
|
|
00187 88 REQ-EDIT VALUE 'E'. DTSCS48
|
|
00188 DTSCS48
|
|
00189 05 RESP-IND PIC X(01). DTSCS48
|
|
00190 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS48
|
|
00191 88 RESP-SEND-MAP VALUE 'M'. DTSCS48
|
|
00192 88 RESP-JUMP VALUE 'J'. DTSCS48
|
|
00193 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS48
|
|
00194 DTSCS48
|
|
00195 05 WRK-MSG-AREA PIC X(64). DTSCS48
|
|
00196 DTSCS48
|
|
00197 05 WRK-ATB-AN PIC X(01). DTSCS48
|
|
00198 DTSCS48
|
|
00199 05 WRK-ATB-NUM PIC X(01). DTSCS48
|
|
00200 DTSCS48
|
|
00201 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS48
|
|
00202 DTSCS48
|
|
00203 05 WRK-AMT-DUE PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00204 05 WRK-TAX-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00205 05 WRK-PEN-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00206 05 WRK-INT-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00207 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00208 05 WRK-YRQ-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00209 05 WRK-YRQ-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00210 05 WRK-YRQ-TAX-BAL-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00211 05 WRK-YRQ-WRITTEN-OFF-AMT PIC S9(09)V9(02) COMP-3. DTSCS48
|
|
00212 05 WRK-STATUS-CD PIC X(01). DTSCS48
|
|
00213 DTSCS48
|
|
00214 05 WRK-SUB PIC S9(04) COMP. DTSCS48
|
|
00215 05 WRK-ANN-SUB PIC S9(04) COMP. DTSCS48
|
|
00216 05 MAP-CNT PIC S9(04) COMP. DTSCS48
|
|
00217 DTSCS48
|
|
00218 05 WRK-SUB2 PIC S9(04) COMP. DTSCS48
|
|
00219 DTSCS48
|
|
00220 DTSCS48
|
|
00221 05 WRK-YRQ PIC 9(05). DTSCS48
|
|
00222 05 FILLER REDEFINES WRK-YRQ. DTSCS48
|
|
00223 10 WRK-YRQ-YR PIC 9(04). DTSCS48
|
|
00224 10 WRK-YRQ-Q PIC 9(01). DTSCS48
|
|
00225 DTSCS48
|
|
00226 DTSCS48
|
|
00227 DTSCS48
|
|
00228 05 WRK-TBL-SUB PIC S9(04) COMP. DTSCS48
|
|
00229 DTSCS48
|
|
00230 05 WRK-SUB-MINUS-ONE PIC S9(04) COMP. DTSCS48
|
|
00231 DTSCS48
|
|
00232 05 WRK-NO-ENTRY-CTR PIC S9(04) COMP. DTSCS48
|
|
00233 DTSCS48
|
|
00234 05 WRK-MPRF-IND PIC X(01). DTSCS48
|
|
00235 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS48
|
|
00236 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS48
|
|
00237 DTSCS48
|
|
00238 05 WRK-MCMP-IND PIC X(01). DTSCS48
|
|
00239 88 WRK-MCMP-YES-88 VALUE 'Y'. DTSCS48
|
|
00240 88 WRK-MCMP-NO-88 VALUE 'N'. DTSCS48
|
|
00241 DTSCS48
|
|
00242 05 WRK-TBL OCCURS 40 TIMES. DTSCS48
|
|
00243 10 WRK-TBL-QTR PIC S9(05) COMP-3. DTSCS48
|
|
00244 10 WRK-TBL-BALANCE PIC S9(09)V99 COMP-3. DTSCS48
|
|
00245 DTSCS48
|
|
00246 DTSCS48
|
|
00247 05 WRK-DISPLAY PIC 9(11). DTSCS48
|
|
00248 DTSCS48
|
|
00249 05 FILLER REDEFINES WRK-DISPLAY. DTSCS48
|
|
00250 10 FILLER PIC X(05). DTSCS48
|
|
00251 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS48
|
|
00252 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS48
|
|
00253 DTSCS48
|
|
00254 05 FILLER REDEFINES WRK-DISPLAY. DTSCS48
|
|
00255 10 FILLER PIC X(05). DTSCS48
|
|
00256 10 WRK-DISPLAY-YR PIC X(02). DTSCS48
|
|
00257 10 WRK-DISPLAY-MO PIC X(02). DTSCS48
|
|
00258 10 WRK-DISPLAY-DA PIC X(02). DTSCS48
|
|
00259 DTSCS48
|
|
00260 05 FILLER REDEFINES WRK-DISPLAY. DTSCS48
|
|
00261 10 FILLER PIC X(08). DTSCS48
|
|
00262 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS48
|
|
00263 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS48
|
|
00264 DTSCS48
|
|
00265 DTSCS48
|
|
00266 05 INQUIRY-CONTROL-AREA. DTSCS48
|
|
00267 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS48
|
|
00268 10 WS-REC-NUM PIC S9(08) COMP. DTSCS48
|
|
00269 DTSCS48
|
|
00270 10 LAST-REC-KEY-AREA PIC X(16). DTSCS48
|
|
00271 10 SCR-REC-KEY-AREA PIC X(16). DTSCS48
|
|
00272 DTSCS48
|
|
00273 10 WS-REC-FOUND-IND PIC X(01). DTSCS48
|
|
00274 DTSCS48
|
|
00275 DTSCS48
|
|
00276 05 EVL-TEXT. DTSCS48
|
|
00277 10 FILLER PIC X(26) VALUE DTSCS48
|
|
00278 'COMPROMISE SETTLEMENT '. DTSCS48
|
|
00279 10 EVL-STATUS-CD-DSCR PIC X(12). DTSCS48
|
|
00280 EJECT DTSCS48
|
|
00281 01 MSG-LITERALS. DTSCS48
|
|
00282 DTSCS48
|
|
00283 05 MSG-E481-AREA. DTSCS48
|
|
00284 10 FILLER PIC X(04) VALUE 'E481'. DTSCS48
|
|
00285 10 FILLER PIC X(30) DTSCS48
|
|
00286 VALUE 'YRQ MUST BE IN ASCENDING SEQUE'. DTSCS48
|
|
00287 10 FILLER PIC X(30) DTSCS48
|
|
00288 VALUE 'NCE '. DTSCS48
|
|
00289 DTSCS48
|
|
00290 05 MSG-E482-AREA. DTSCS48
|
|
00291 10 FILLER PIC X(04) VALUE 'E482'. DTSCS48
|
|
00292 10 FILLER PIC X(30) DTSCS48
|
|
00293 VALUE 'NO UI TAX DUE '. DTSCS48
|
|
00294 10 FILLER PIC X(30) DTSCS48
|
|
00295 VALUE ' '. DTSCS48
|
|
00296 DTSCS48
|
|
00297 05 MSG-E483-AREA. DTSCS48
|
|
00298 10 FILLER PIC X(04) VALUE 'E483'. DTSCS48
|
|
00299 10 FILLER PIC X(30) DTSCS48
|
|
00300 VALUE 'STATUS MAY ONLY BE CHANGED TO '. DTSCS48
|
|
00301 10 FILLER PIC X(30) DTSCS48
|
|
00302 VALUE 'WITHDRAWN '. DTSCS48
|
|
00303 DTSCS48
|
|
00304 05 MSG-E484-AREA. DTSCS48
|
|
00305 10 FILLER PIC X(04) VALUE 'E484'. DTSCS48
|
|
00306 10 FILLER PIC X(30) DTSCS48
|
|
00307 VALUE 'AT LEAST ONE QUARTER MUST BE E'. DTSCS48
|
|
00308 10 FILLER PIC X(30) DTSCS48
|
|
00309 VALUE 'NTERED '. DTSCS48
|
|
00310 DTSCS48
|
|
00311 DTSCS48
|
|
00312 05 MSG-E486-AREA. DTSCS48
|
|
00313 10 FILLER PIC X(04) VALUE 'E486'. DTSCS48
|
|
00314 10 FILLER PIC X(30) DTSCS48
|
|
00315 VALUE 'STATUS MAY NOT BE CHANGED ONCE'. DTSCS48
|
|
00316 10 FILLER PIC X(30) DTSCS48
|
|
00317 VALUE ' WITHDRAWN '. DTSCS48
|
|
00318 DTSCS48
|
|
00319 05 MSG-E487-AREA. DTSCS48
|
|
00320 10 FILLER PIC X(04) VALUE 'E487'. DTSCS48
|
|
00321 10 FILLER PIC X(30) DTSCS48
|
|
00322 VALUE 'PENDING COMPROMISE SETTLEMENT '. DTSCS48
|
|
00323 10 FILLER PIC X(30) DTSCS48
|
|
00324 VALUE 'ALREADY ON FILE '. DTSCS48
|
|
00325 DTSCS48
|
|
00326 EJECT DTSCS48
|
|
00327 01 L001-COMM-AREA. DTSCS48
|
|
00328 ++INCLUDE DTSIL001 DTSCS48
|
|
00329 EJECT DTSCS48
|
|
00330 01 L011-COMM-AREA. DTSCS48
|
|
00331 ++INCLUDE DTSIL011 DTSCS48
|
|
00332 EJECT DTSCS48
|
|
00333 01 L013-COMM-AREA. DTSCS48
|
|
00334 ++INCLUDE DTSIL013 DTSCS48
|
|
00335 EJECT DTSCS48
|
|
00336 01 L015-COMM-AREA. DTSCS48
|
|
00337 ++INCLUDE DTSIL015 DTSCS48
|
|
00338 EJECT DTSCS48
|
|
00339 01 L018-COMM-AREA. DTSCS48
|
|
00340 ++INCLUDE DTSIL018 DTSCS48
|
|
00341 EJECT DTSCS48
|
|
00342 01 L029-COMM-AREA. DTSCS48
|
|
00343 ++INCLUDE DTSIL029 DTSCS48
|
|
00344 EJECT DTSCS48
|
|
00345 01 L034-COMM-AREA. DTSCS48
|
|
00346 ++INCLUDE DTSIL034 DTSCS48
|
|
00347 EJECT DTSCS48
|
|
00348 01 L071-COMM-AREA. DTSCS48
|
|
00349 ++INCLUDE DTSIL071 DTSCS48
|
|
00350 EJECT DTSCS48
|
|
00351 01 L082-COMM-AREA. DTSCS48
|
|
00352 ++INCLUDE DTSIL082 DTSCS48
|
|
00353 EJECT DTSCS48
|
|
00354 01 L101-COMM-AREA. DTSCS48
|
|
00355 ++INCLUDE DTSIL101 DTSCS48
|
|
00356 EJECT DTSCS48
|
|
00357 01 L111-COMM-AREA. DTSCS48
|
|
00358 ++INCLUDE DTSIL111 DTSCS48
|
|
00359 EJECT DTSCS48
|
|
00360 01 L112-COMM-AREA. DTSCS48
|
|
00361 ++INCLUDE DTSIL112 DTSCS48
|
|
00362 EJECT DTSCS48
|
|
00363 01 L109-COMM-AREA. DTSCS48
|
|
00364 ++INCLUDE DTSIL109 DTSCS48
|
|
00365 EJECT DTSCS48
|
|
00366 01 L221-COMM-AREA. DTSCS48
|
|
00367 ++INCLUDE DTSIL221 DTSCS48
|
|
00368 EJECT DTSCS48
|
|
00369 01 L805-COMM-AREA. DTSCS48
|
|
00370 ++INCLUDE DTSIL805 DTSCS48
|
|
00371 EJECT DTSCS48
|
|
00372 01 L810-COMM-AREA. DTSCS48
|
|
00373 05 L810-CONTROL-BLOCK. DTSCS48
|
|
00374 ++INCLUDE DTSIL810 DTSCS48
|
|
00375 EJECT DTSCS48
|
|
00376 05 MSKL-REC. DTSCS48
|
|
00377 ++INCLUDE DTSIMSKL DTSCS48
|
|
00378 EJECT DTSCS48
|
|
00379 01 MPRF-REC. DTSCS48
|
|
00380 ++INCLUDE DTSIMPRF DTSCS48
|
|
00381 EJECT DTSCS48
|
|
00382 01 MCMP-REC. DTSCS48
|
|
00383 ++INCLUDE DTSIMCMP DTSCS48
|
|
00384 EJECT DTSCS48
|
|
00385 01 MQTR-REC. DTSCS48
|
|
00386 ++INCLUDE DTSIMQTR DTSCS48
|
|
00387 EJECT DTSCS48
|
|
00388 01 MTCK-REC. DTSCS48
|
|
00389 ++INCLUDE DTSIMTCK DTSCS48
|
|
00390 EJECT DTSCS48
|
|
00391 01 MEVL-REC. DTSCS48
|
|
00392 ++INCLUDE DTSIMEVL DTSCS48
|
|
00393 EJECT DTSCS48
|
|
00394 01 L825-COMM-AREA. DTSCS48
|
|
00395 05 L825-CONTROL-BLOCK. DTSCS48
|
|
00396 ++INCLUDE DTSIL825 DTSCS48
|
|
00397 DTSCS48
|
|
00398 05 RSKL-REC. DTSCS48
|
|
00399 ++INCLUDE DTSIRSK1 DTSCS48
|
|
00400 SKIP3 DTSCS48
|
|
00401 01 T011-REC. DTSCS48
|
|
00402 ++INCLUDE DTSIT011 DTSCS48
|
|
00403 EJECT DTSCS48
|
|
00404 01 L851-COMM-AREA. DTSCS48
|
|
00405 ++INCLUDE DTSIL851 DTSCS48
|
|
00406 DTSCS48
|
|
00407 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS48
|
|
00408 ++INCLUDE DTSIS48 DTSCS48
|
|
00409 EJECT DTSCS48
|
|
00410 01 CATB-LITERALS. DTSCS48
|
|
00411 ++INCLUDE DTSICATB DTSCS48
|
|
00412 DTSCS48
|
|
00413 01 CFKD-LITERALS. DTSCS48
|
|
00414 ++INCLUDE DTSICFKD DTSCS48
|
|
00415 DTSCS48
|
|
00416 01 CECD-LITERALS. DTSCS48
|
|
00417 ++INCLUDE DTSICECD DTSCS48
|
|
00418 DTSCS48
|
|
00419 01 CPCD-LITERALS. DTSCS48
|
|
00420 ++INCLUDE DTSICPCD DTSCS48
|
|
00421 EJECT DTSCS48
|
|
00422 DTSCS48
|
|
00423 01 MMAX-LITERALS. DTSCS48
|
|
00424 ++INCLUDE DTSIMMAX DTSCS48
|
|
00425 EJECT DTSCS48
|
|
00426 LINKAGE SECTION. DTSCS48
|
|
00427 DTSCS48
|
|
00428 01 DFHCOMMAREA. DTSCS48
|
|
00429 ++INCLUDE DTSILCCM DTSCS48
|
|
00430 SKIP3 DTSCS48
|
|
00431 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS48
|
|
00432 20 LCCM-SCR-HOLD-PROG-NAME PIC X(07). DTSCS48
|
|
00433 20 LCCM-SCR-HOLD-KEY PIC X(16). DTSCS48
|
|
00434 20 LCCM-SCR-HOLD-STATUS-CD PIC X(01). DTSCS48
|
|
00435 EJECT DTSCS48
|
|
00436 ***************************************************************** DTSCS48
|
|
00437 * DTSCS48
|
|
00438 ***************************************************************** DTSCS48
|
|
00439 DTSCS48
|
|
00440 PROCEDURE DIVISION. DTSCS48
|
|
00441 DTSCS48
|
|
00442 MOVE +0 TO WRK-EMP-NO. DTSCS48
|
|
00443 DTSCS48
|
|
00444 SET WRK-MPRF-NO-88 TO TRUE. DTSCS48
|
|
00445 DTSCS48
|
|
00446 SET WRK-MCMP-NO-88 TO TRUE. DTSCS48
|
|
00447 DTSCS48
|
|
00448 MOVE LOW-VALUES TO MAP-AREA. DTSCS48
|
|
00449 DTSCS48
|
|
00450 SET CURSOR-SET-NO TO TRUE. DTSCS48
|
|
00451 DTSCS48
|
|
00452 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS48
|
|
00453 TO SCR-ACCESS-IND. DTSCS48
|
|
00454 DTSCS48
|
|
00455 IF SCR-ACCESS-UPDATE DTSCS48
|
|
00456 IF LCCM-OP-IS-FLD-DESK-88 DTSCS48
|
|
00457 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS48
|
|
00458 NEXT SENTENCE DTSCS48
|
|
00459 ELSE DTSCS48
|
|
00460 SET SCR-ACCESS-INQ TO TRUE DTSCS48
|
|
00461 END-IF. DTSCS48
|
|
00462 DTSCS48
|
|
00463 MOVE SPACE TO REQ-IND. DTSCS48
|
|
00464 DTSCS48
|
|
00465 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS48
|
|
00466 DTSCS48
|
|
00467 *----------------------------------------------------- DTSCS48
|
|
00468 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS48
|
|
00469 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS48
|
|
00470 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS48
|
|
00471 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS48
|
|
00472 * DTSCS48
|
|
00473 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS48
|
|
00474 * PROCESSED. DTSCS48
|
|
00475 * DTSCS48
|
|
00476 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS48
|
|
00477 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS48
|
|
00478 * WORK STATION OPERATOR. DTSCS48
|
|
00479 *----------------------------------------------------- DTSCS48
|
|
00480 DTSCS48
|
|
00481 MOVE SPACE TO RESP-IND. DTSCS48
|
|
00482 DTSCS48
|
|
00483 IF REQ-ERROR DTSCS48
|
|
00484 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS48
|
|
00485 ELSE DTSCS48
|
|
00486 IF REQ-JUMP DTSCS48
|
|
00487 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS48
|
|
00488 ELSE DTSCS48
|
|
00489 IF REQ-CLEAR DTSCS48
|
|
00490 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS48
|
|
00491 ELSE DTSCS48
|
|
00492 IF REQ-CURSOR-TO-GOTO DTSCS48
|
|
00493 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS48
|
|
00494 ELSE DTSCS48
|
|
00495 IF REQ-INQUIRE DTSCS48
|
|
00496 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS48
|
|
00497 ELSE DTSCS48
|
|
00498 IF REQ-EDIT DTSCS48
|
|
00499 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS48
|
|
00500 ELSE DTSCS48
|
|
00501 IF REQ-UPDATE DTSCS48
|
|
00502 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS48
|
|
00503 ELSE DTSCS48
|
|
00504 GO TO S899-ABEND. DTSCS48
|
|
00505 DTSCS48
|
|
00506 *----------------------------------------------------- DTSCS48
|
|
00507 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS48
|
|
00508 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS48
|
|
00509 *----------------------------------------------------- DTSCS48
|
|
00510 DTSCS48
|
|
00511 IF RESP-SEND-MAP DTSCS48
|
|
00512 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS48
|
|
00513 SET LCCM-END-TASK-88 TO TRUE DTSCS48
|
|
00514 ELSE DTSCS48
|
|
00515 IF RESP-SEND-MSGONLY DTSCS48
|
|
00516 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS48
|
|
00517 SET LCCM-END-TASK-88 TO TRUE DTSCS48
|
|
00518 ELSE DTSCS48
|
|
00519 IF RESP-JUMP DTSCS48
|
|
00520 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48
|
|
00521 ELSE DTSCS48
|
|
00522 IF RESP-CURSOR-TO-GOTO DTSCS48
|
|
00523 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS48
|
|
00524 SET LCCM-END-TASK-88 TO TRUE DTSCS48
|
|
00525 ELSE DTSCS48
|
|
00526 GO TO S899-ABEND. DTSCS48
|
|
00527 DTSCS48
|
|
00528 MAINLINE-EXIT. DTSCS48
|
|
00529 DTSCS48
|
|
00530 EXEC CICS DTSCS48
|
|
00531 RETURN DTSCS48
|
|
00532 END-EXEC. DTSCS48
|
|
00533 DTSCS48
|
|
00534 * GOBACK. DTSCS48
|
|
00535 EJECT DTSCS48
|
|
00536 /**************************************************************** DTSCS48
|
|
00537 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION DTSCS48
|
|
00538 ***************************************************************** DTSCS48
|
|
00539 P1000-ANALYZE-REQUEST. DTSCS48
|
|
00540 DTSCS48
|
|
00541 *----------------------------------------------------- DTSCS48
|
|
00542 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS48
|
|
00543 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS48
|
|
00544 * REPLACED WITH ENTER) DTSCS48
|
|
00545 *----------------------------------------------------- DTSCS48
|
|
00546 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS48
|
|
00547 SET LCCM-ENTER-88 TO TRUE DTSCS48
|
|
00548 IF LCCM-EMP-NO > ZERO DTSCS48
|
|
00549 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS48
|
|
00550 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS48
|
|
00551 END-IF DTSCS48
|
|
00552 SET REQ-INQUIRE TO TRUE DTSCS48
|
|
00553 GO TO P1000-EXIT. DTSCS48
|
|
00554 DTSCS48
|
|
00555 *----------------------------------------------------- DTSCS48
|
|
00556 * MAP IS RECEIVED DTSCS48
|
|
00557 *----------------------------------------------------- DTSCS48
|
|
00558 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS48
|
|
00559 DTSCS48
|
|
00560 *----------------------------------------------------- DTSCS48
|
|
00561 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS48
|
|
00562 * WORK STATION DTSCS48
|
|
00563 *----------------------------------------------------- DTSCS48
|
|
00564 IF LCCM-CLEAR-88 DTSCS48
|
|
00565 SET REQ-CLEAR TO TRUE DTSCS48
|
|
00566 GO TO P1000-EXIT. DTSCS48
|
|
00567 DTSCS48
|
|
00568 *----------------------------------------------------- DTSCS48
|
|
00569 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS48
|
|
00570 *----------------------------------------------------- DTSCS48
|
|
00571 IF LCCM-SCR-UPDATE-LOCKED DTSCS48
|
|
00572 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS48
|
|
00573 GO TO P1000-EXIT. DTSCS48
|
|
00574 DTSCS48
|
|
00575 *----------------------------------------------------- DTSCS48
|
|
00576 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS48
|
|
00577 *----------------------------------------------------- DTSCS48
|
|
00578 IF LCCM-PA2-88 DTSCS48
|
|
00579 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS48
|
|
00580 GO TO P1000-EXIT. DTSCS48
|
|
00581 DTSCS48
|
|
00582 *----------------------------------------------------- DTSCS48
|
|
00583 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS48
|
|
00584 *----------------------------------------------------- DTSCS48
|
|
00585 IF LCCM-PA-88 DTSCS48
|
|
00586 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS48
|
|
00587 SET REQ-ERROR TO TRUE DTSCS48
|
|
00588 GO TO P1000-EXIT. DTSCS48
|
|
00589 DTSCS48
|
|
00590 *----------------------------------------------------- DTSCS48
|
|
00591 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS48
|
|
00592 * THEN CLEAR SCREEN. DTSCS48
|
|
00593 *----------------------------------------------------- DTSCS48
|
|
00594 IF LCCM-F12-88 DTSCS48
|
|
00595 MOVE LOW-VALUES TO MAP-AREA DTSCS48
|
|
00596 SET REQ-CLEAR TO TRUE DTSCS48
|
|
00597 GO TO P1000-EXIT. DTSCS48
|
|
00598 DTSCS48
|
|
00599 *----------------------------------------------------- DTSCS48
|
|
00600 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS48
|
|
00601 *----------------------------------------------------- DTSCS48
|
|
00602 IF LCCM-F03-88 DTSCS48
|
|
00603 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS48
|
|
00604 SET REQ-JUMP TO TRUE DTSCS48
|
|
00605 GO TO P1000-EXIT. DTSCS48
|
|
00606 DTSCS48
|
|
00607 *----------------------------------------------------- DTSCS48
|
|
00608 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS48
|
|
00609 *----------------------------------------------------- DTSCS48
|
|
00610 IF LCCM-F04-88 DTSCS48
|
|
00611 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS48
|
|
00612 SET REQ-JUMP TO TRUE DTSCS48
|
|
00613 GO TO P1000-EXIT. DTSCS48
|
|
00614 DTSCS48
|
|
00615 *--------------------------------------------------------- DTSCS48
|
|
00616 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS48
|
|
00617 * CORRESPONDENCE SCREEN. DTSCS48
|
|
00618 *--------------------------------------------------------- DTSCS48
|
|
00619 DTSCS48
|
|
00620 IF LCCM-F14-88 DTSCS48
|
|
00621 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS48
|
|
00622 SET REQ-JUMP TO TRUE DTSCS48
|
|
00623 GO TO P1000-EXIT. DTSCS48
|
|
00624 DTSCS48
|
|
00625 *----------------------------------------------------- DTSCS48
|
|
00626 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS48
|
|
00627 * REQUESTED SCREEN TYPE DTSCS48
|
|
00628 *----------------------------------------------------- DTSCS48
|
|
00629 * DTSCS48
|
|
00630 * IF LCCM-F19-88 DTSCS48
|
|
00631 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS48
|
|
00632 * SET REQ-JUMP TO TRUE DTSCS48
|
|
00633 * GO TO P1000-EXIT. DTSCS48
|
|
00634 * DTSCS48
|
|
00635 * IF LCCM-F20-88 DTSCS48
|
|
00636 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS48
|
|
00637 * SET REQ-JUMP TO TRUE DTSCS48
|
|
00638 * GO TO P1000-EXIT. DTSCS48
|
|
00639 * DTSCS48
|
|
00640 *----------------------------------------------------- DTSCS48
|
|
00641 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS48
|
|
00642 * REQUESTED SCREEN TYPE DTSCS48
|
|
00643 *----------------------------------------------------- DTSCS48
|
|
00644 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS48
|
|
00645 NEXT SENTENCE DTSCS48
|
|
00646 ELSE DTSCS48
|
|
00647 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS48
|
|
00648 SET REQ-JUMP TO TRUE DTSCS48
|
|
00649 GO TO P1000-EXIT. DTSCS48
|
|
00650 DTSCS48
|
|
00651 *----------------------------------------------------- DTSCS48
|
|
00652 * IF REQUEST TO UPDATE THE DATA (ADD,MOD) DTSCS48
|
|
00653 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS48
|
|
00654 *----------------------------------------------------- DTSCS48
|
|
00655 IF LCCM-F09-88 DTSCS48
|
|
00656 OR LCCM-F10-88 DTSCS48
|
|
00657 IF SCR-ACCESS-UPDATE DTSCS48
|
|
00658 SET REQ-EDIT TO TRUE DTSCS48
|
|
00659 GO TO P1000-EXIT DTSCS48
|
|
00660 ELSE DTSCS48
|
|
00661 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS48
|
|
00662 SET REQ-ERROR TO TRUE DTSCS48
|
|
00663 GO TO P1000-EXIT. DTSCS48
|
|
00664 DTSCS48
|
|
00665 *----------------------------------------------------- DTSCS48
|
|
00666 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS48
|
|
00667 * OR F8), INDICATE INQUIRY REQUEST DTSCS48
|
|
00668 *----------------------------------------------------- DTSCS48
|
|
00669 IF LCCM-INQUIRY-88 DTSCS48
|
|
00670 SET REQ-INQUIRE TO TRUE DTSCS48
|
|
00671 GO TO P1000-EXIT. DTSCS48
|
|
00672 DTSCS48
|
|
00673 *----------------------------------------------------- DTSCS48
|
|
00674 * ANY OTHER KEY IS INVALID DTSCS48
|
|
00675 *----------------------------------------------------- DTSCS48
|
|
00676 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS48
|
|
00677 SET REQ-ERROR TO TRUE. DTSCS48
|
|
00678 P1000-EXIT. DTSCS48
|
|
00679 EXIT. DTSCS48
|
|
00680 DTSCS48
|
|
00681 ***************************************************************** DTSCS48
|
|
00682 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH DTSCS48
|
|
00683 ***************************************************************** DTSCS48
|
|
00684 DTSCS48
|
|
00685 P1100-UPDATE-LOCKED. DTSCS48
|
|
00686 *----------------------------------------------------- DTSCS48
|
|
00687 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS48
|
|
00688 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS48
|
|
00689 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS48
|
|
00690 *----------------------------------------------------- DTSCS48
|
|
00691 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS48
|
|
00692 SET REQ-UPDATE TO TRUE DTSCS48
|
|
00693 ELSE DTSCS48
|
|
00694 SET REQ-ERROR TO TRUE DTSCS48
|
|
00695 IF LCCM-SCR-ADD-LOCKED DTSCS48
|
|
00696 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS48
|
|
00697 ELSE DTSCS48
|
|
00698 IF LCCM-SCR-MOD-LOCKED DTSCS48
|
|
00699 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS48
|
|
00700 ELSE DTSCS48
|
|
00701 GO TO S899-ABEND. DTSCS48
|
|
00702 P1100-EXIT. DTSCS48
|
|
00703 EXIT. DTSCS48
|
|
00704 /**************************************************************** DTSCS48
|
|
00705 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. DTSCS48
|
|
00706 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. DTSCS48
|
|
00707 ***************************************************************** DTSCS48
|
|
00708 DTSCS48
|
|
00709 P2000-REQUEST-ERROR. DTSCS48
|
|
00710 IF LCCM-MSG DTSCS48
|
|
00711 SET RESP-SEND-MSGONLY TO TRUE DTSCS48
|
|
00712 ELSE DTSCS48
|
|
00713 GO TO S899-ABEND. DTSCS48
|
|
00714 P2000-EXIT. DTSCS48
|
|
00715 EXIT. DTSCS48
|
|
00716 /**************************************************************** DTSCS48
|
|
00717 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED DTSCS48
|
|
00718 ***************************************************************** DTSCS48
|
|
00719 DTSCS48
|
|
00720 P3000-REQUEST-JUMP. DTSCS48
|
|
00721 *----------------------------------------------------- DTSCS48
|
|
00722 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS48
|
|
00723 * BY USER DTSCS48
|
|
00724 *----------------------------------------------------- DTSCS48
|
|
00725 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS48
|
|
00726 DTSCS48
|
|
00727 *----------------------------------------------------- DTSCS48
|
|
00728 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS48
|
|
00729 *----------------------------------------------------- DTSCS48
|
|
00730 IF LCCM-MSG DTSCS48
|
|
00731 SET RESP-SEND-MSGONLY TO TRUE DTSCS48
|
|
00732 SET CURSOR-SET-GOTO TO TRUE DTSCS48
|
|
00733 GO TO P3000-EXIT. DTSCS48
|
|
00734 SKIP3 DTSCS48
|
|
00735 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS48
|
|
00736 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS48
|
|
00737 IF L018-VALID DTSCS48
|
|
00738 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS48
|
|
00739 DTSCS48
|
|
00740 *----------------------------------------------------- DTSCS48
|
|
00741 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS48
|
|
00742 *----------------------------------------------------- DTSCS48
|
|
00743 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS48
|
|
00744 LCCM-SCR-HOLD-AREA. DTSCS48
|
|
00745 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS48
|
|
00746 SET RESP-JUMP TO TRUE. DTSCS48
|
|
00747 P3000-EXIT. DTSCS48
|
|
00748 EXIT. DTSCS48
|
|
00749 /**************************************************************** DTSCS48
|
|
00750 * CLEAR KEY WAS PRESSED DTSCS48
|
|
00751 ***************************************************************** DTSCS48
|
|
00752 DTSCS48
|
|
00753 P4000-REQUEST-CLEAR. DTSCS48
|
|
00754 DTSCS48
|
|
00755 *----------------------------------------------------- DTSCS48
|
|
00756 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS48
|
|
00757 * FIELDS FROM EARLIER REQUESTS DTSCS48
|
|
00758 *----------------------------------------------------- DTSCS48
|
|
00759 IF LCCM-EMP-NO > ZERO DTSCS48
|
|
00760 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS48
|
|
00761 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS48
|
|
00762 DTSCS48
|
|
00763 MOVE ZERO TO LCCM-EMP-NO. DTSCS48
|
|
00764 DTSCS48
|
|
00765 DTSCS48
|
|
00766 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS48
|
|
00767 DTSCS48
|
|
00768 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48
|
|
00769 DTSCS48
|
|
00770 SET LCCM-SCR-CLEAR TO TRUE. DTSCS48
|
|
00771 DTSCS48
|
|
00772 IF SCR-ACCESS-UPDATE DTSCS48
|
|
00773 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS48
|
|
00774 ELSE DTSCS48
|
|
00775 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS48
|
|
00776 DTSCS48
|
|
00777 SET RESP-SEND-MAP TO TRUE. DTSCS48
|
|
00778 P4000-EXIT. DTSCS48
|
|
00779 EXIT. DTSCS48
|
|
00780 /**************************************************************** DTSCS48
|
|
00781 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED DTSCS48
|
|
00782 ***************************************************************** DTSCS48
|
|
00783 DTSCS48
|
|
00784 P5000-CURSOR-TO-GOTO. DTSCS48
|
|
00785 SET CURSOR-SET-GOTO TO TRUE. DTSCS48
|
|
00786 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS48
|
|
00787 P5000-EXIT. DTSCS48
|
|
00788 EXIT. DTSCS48
|
|
00789 /**************************************************************** DTSCS48
|
|
00790 * INQUIRY WAS REQUESTED DTSCS48
|
|
00791 ***************************************************************** DTSCS48
|
|
00792 DTSCS48
|
|
00793 P6000-REQUEST-INQUIRE. DTSCS48
|
|
00794 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS48
|
|
00795 MOVE LOW-VALUES TO MAP-AREA. DTSCS48
|
|
00796 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS48
|
|
00797 DTSCS48
|
|
00798 SET LCCM-SCR-CLEAR TO TRUE. DTSCS48
|
|
00799 DTSCS48
|
|
00800 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48
|
|
00801 DTSCS48
|
|
00802 IF LCCM-SCR-HOLD-PROG-NAME = 'DTSCS48' DTSCS48
|
|
00803 MOVE LCCM-SCR-HOLD-KEY TO SCR-REC-KEY-AREA DTSCS48
|
|
00804 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS48
|
|
00805 ELSE DTSCS48
|
|
00806 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS48
|
|
00807 END-IF. DTSCS48
|
|
00808 DTSCS48
|
|
00809 SET RESP-SEND-MAP TO TRUE. DTSCS48
|
|
00810 DTSCS48
|
|
00811 IF SCR-ACCESS-UPDATE DTSCS48
|
|
00812 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS48
|
|
00813 ELSE DTSCS48
|
|
00814 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS48
|
|
00815 DTSCS48
|
|
00816 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
00817 IF LCCM-MSG DTSCS48
|
|
00818 GO TO P6000-EXIT. DTSCS48
|
|
00819 DTSCS48
|
|
00820 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS48
|
|
00821 DTSCS48
|
|
00822 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48
|
|
00823 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48
|
|
00824 SET MSKL-CMP-88 TO TRUE. DTSCS48
|
|
00825 PERFORM S810-COUNT THRU S810-EXIT. DTSCS48
|
|
00826 DTSCS48
|
|
00827 IF L810-RECORD-CNT = +0 DTSCS48
|
|
00828 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
00829 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
00830 GO TO P6000-EXIT. DTSCS48
|
|
00831 DTSCS48
|
|
00832 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS48
|
|
00833 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS48
|
|
00834 DTSCS48
|
|
00835 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS48
|
|
00836 IF LCCM-MSG DTSCS48
|
|
00837 GO TO P6000-EXIT. DTSCS48
|
|
00838 DTSCS48
|
|
00839 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS48
|
|
00840 DTSCS48
|
|
00841 MOVE 'DTSCS48' TO LCCM-SCR-HOLD-PROG-NAME. DTSCS48
|
|
00842 MOVE MCMP-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS48
|
|
00843 DTSCS48
|
|
00844 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS48
|
|
00845 DTSCS48
|
|
00846 IF SCR-ACCESS-UPDATE DTSCS48
|
|
00847 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48
|
|
00848 P6000-EXIT. DTSCS48
|
|
00849 EXIT. DTSCS48
|
|
00850 EJECT DTSCS48
|
|
00851 DTSCS48
|
|
00852 P6100-LOCATE-REC. DTSCS48
|
|
00853 *------------------------------------------------------------ DTSCS48
|
|
00854 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS48
|
|
00855 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS48
|
|
00856 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS48
|
|
00857 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS48
|
|
00858 * RECORD WITH THE GREATEST MCMP-ESTB-DATE DTSCS48
|
|
00859 *------------------------------------------------------------ DTSCS48
|
|
00860 DTSCS48
|
|
00861 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS48
|
|
00862 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS48
|
|
00863 GO TO P6100-EXIT. DTSCS48
|
|
00864 DTSCS48
|
|
00865 MOVE SCR-REC-KEY-AREA TO MCMP-KEY-AREA. DTSCS48
|
|
00866 DTSCS48
|
|
00867 IF WRK-EMP-NO = MCMP-EMP-NO DTSCS48
|
|
00868 NEXT SENTENCE DTSCS48
|
|
00869 ELSE DTSCS48
|
|
00870 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS48
|
|
00871 GO TO P6100-EXIT. DTSCS48
|
|
00872 DTSCS48
|
|
00873 IF LCCM-F05-88 DTSCS48
|
|
00874 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS48
|
|
00875 GO TO P6100-EXIT. DTSCS48
|
|
00876 DTSCS48
|
|
00877 IF LCCM-F06-88 DTSCS48
|
|
00878 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS48
|
|
00879 GO TO P6100-EXIT. DTSCS48
|
|
00880 DTSCS48
|
|
00881 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48
|
|
00882 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48
|
|
00883 SET MSKL-CMP-88 TO TRUE. DTSCS48
|
|
00884 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48
|
|
00885 IF L810-NO-REC-88 DTSCS48
|
|
00886 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
00887 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
00888 GO TO P6100-EXIT. DTSCS48
|
|
00889 DTSCS48
|
|
00890 MOVE +0 TO WS-REC-NUM. DTSCS48
|
|
00891 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS48
|
|
00892 PERFORM P6190-BROWSE-MCMP THRU P6190-EXIT DTSCS48
|
|
00893 UNTIL (L810-NO-REC-88) DTSCS48
|
|
00894 OR DTSCS48
|
|
00895 (WS-REC-FOUND-IND = 'Y'). DTSCS48
|
|
00896 DTSCS48
|
|
00897 IF L810-NO-REC-88 DTSCS48
|
|
00898 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS48
|
|
00899 GO TO P6100-EXIT. DTSCS48
|
|
00900 DTSCS48
|
|
00901 IF LCCM-ENTER-88 DTSCS48
|
|
00902 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48
|
|
00903 GO TO P6100-EXIT. DTSCS48
|
|
00904 DTSCS48
|
|
00905 IF LCCM-F07-88 DTSCS48
|
|
00906 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS48
|
|
00907 GO TO P6100-EXIT. DTSCS48
|
|
00908 DTSCS48
|
|
00909 IF LCCM-F08-88 DTSCS48
|
|
00910 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS48
|
|
00911 GO TO P6100-EXIT. DTSCS48
|
|
00912 DTSCS48
|
|
00913 GO TO S899-ABEND. DTSCS48
|
|
00914 P6100-EXIT. DTSCS48
|
|
00915 EXIT. DTSCS48
|
|
00916 DTSCS48
|
|
00917 P6101-DEFAULT-PAGE. DTSCS48
|
|
00918 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS48
|
|
00919 P6101-EXIT. DTSCS48
|
|
00920 EXIT. DTSCS48
|
|
00921 DTSCS48
|
|
00922 P6110-FIRST-REC. DTSCS48
|
|
00923 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48
|
|
00924 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48
|
|
00925 SET MSKL-CMP-88 TO TRUE. DTSCS48
|
|
00926 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48
|
|
00927 IF L810-NO-REC-88 DTSCS48
|
|
00928 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
00929 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
00930 GO TO P6110-EXIT. DTSCS48
|
|
00931 DTSCS48
|
|
00932 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48
|
|
00933 DTSCS48
|
|
00934 MOVE MSKL-REC TO MCMP-REC. DTSCS48
|
|
00935 DTSCS48
|
|
00936 MOVE +1 TO WS-REC-NUM. DTSCS48
|
|
00937 P6110-EXIT. DTSCS48
|
|
00938 EXIT. DTSCS48
|
|
00939 DTSCS48
|
|
00940 P6120-PREV-REC. DTSCS48
|
|
00941 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS48
|
|
00942 IF L810-NO-REC-88 DTSCS48
|
|
00943 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
00944 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
00945 GO TO P6120-EXIT. DTSCS48
|
|
00946 DTSCS48
|
|
00947 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS48
|
|
00948 IF L810-NO-REC-88 DTSCS48
|
|
00949 GO TO P6120-EXIT. DTSCS48
|
|
00950 DTSCS48
|
|
00951 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48
|
|
00952 DTSCS48
|
|
00953 SUBTRACT 1 FROM WS-REC-NUM. DTSCS48
|
|
00954 DTSCS48
|
|
00955 MOVE MSKL-REC TO MCMP-REC. DTSCS48
|
|
00956 P6120-EXIT. DTSCS48
|
|
00957 EXIT. DTSCS48
|
|
00958 DTSCS48
|
|
00959 P6130-NEXT-REC. DTSCS48
|
|
00960 IF MCMP-KEY-AREA > SCR-REC-KEY-AREA DTSCS48
|
|
00961 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48
|
|
00962 GO TO P6130-EXIT. DTSCS48
|
|
00963 DTSCS48
|
|
00964 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS48
|
|
00965 DTSCS48
|
|
00966 IF L810-NO-REC-88 DTSCS48
|
|
00967 GO TO P6130-EXIT. DTSCS48
|
|
00968 DTSCS48
|
|
00969 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48
|
|
00970 DTSCS48
|
|
00971 ADD +1 TO WS-REC-NUM. DTSCS48
|
|
00972 DTSCS48
|
|
00973 MOVE MSKL-REC TO MCMP-REC. DTSCS48
|
|
00974 P6130-EXIT. DTSCS48
|
|
00975 EXIT. DTSCS48
|
|
00976 DTSCS48
|
|
00977 P6140-LAST-REC. DTSCS48
|
|
00978 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS48
|
|
00979 PERFORM S810-READ THRU S810-EXIT. DTSCS48
|
|
00980 IF L810-NO-REC-88 DTSCS48
|
|
00981 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
00982 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
00983 GO TO P6140-EXIT. DTSCS48
|
|
00984 DTSCS48
|
|
00985 MOVE MSKL-REC TO MCMP-REC. DTSCS48
|
|
00986 DTSCS48
|
|
00987 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS48
|
|
00988 P6140-EXIT. DTSCS48
|
|
00989 EXIT. DTSCS48
|
|
00990 DTSCS48
|
|
00991 P6190-BROWSE-MCMP. DTSCS48
|
|
00992 MOVE MSKL-REC TO MCMP-REC. DTSCS48
|
|
00993 ADD +1 TO WS-REC-NUM. DTSCS48
|
|
00994 IF MCMP-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS48
|
|
00995 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS48
|
|
00996 ELSE DTSCS48
|
|
00997 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS48
|
|
00998 P6190-EXIT. DTSCS48
|
|
00999 EXIT. DTSCS48
|
|
01000 /**************************************************************** DTSCS48
|
|
01001 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS DTSCS48
|
|
01002 ***************************************************************** DTSCS48
|
|
01003 DTSCS48
|
|
01004 P6900-CONSTRUCT-SCREEN. DTSCS48
|
|
01005 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS48
|
|
01006 PERFORM P6910-FROM-MCMP THRU P6910-EXIT. DTSCS48
|
|
01007 DTSCS48
|
|
01008 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS48
|
|
01009 P6900-EXIT. DTSCS48
|
|
01010 EXIT. DTSCS48
|
|
01011 DTSCS48
|
|
01012 P6910-FROM-MCMP. DTSCS48
|
|
01013 MOVE MCMP-STATUS-CD TO MAP-STATUS-CD DTSCS48
|
|
01014 LCCM-SCR-HOLD-STATUS-CD. DTSCS48
|
|
01015 DTSCS48
|
|
01016 MOVE MCMP-SETTLEMENT-DATE TO WRK-DISPLAY. DTSCS48
|
|
01017 MOVE WRK-DISPLAY-MO TO MAP-SETTLEMENT-MO. DTSCS48
|
|
01018 MOVE WRK-DISPLAY-DA TO MAP-SETTLEMENT-DA. DTSCS48
|
|
01019 MOVE WRK-DISPLAY-YR TO MAP-SETTLEMENT-YR. DTSCS48
|
|
01020 DTSCS48
|
|
01021 MOVE MCMP-INT-COMP-DATE TO WRK-DISPLAY. DTSCS48
|
|
01022 MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO. DTSCS48
|
|
01023 MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA. DTSCS48
|
|
01024 MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR. DTSCS48
|
|
01025 DTSCS48
|
|
01026 MOVE MCMP-AUTHORIZE-OP-ID TO MAP-AUTHORIZE-OP-ID. DTSCS48
|
|
01027 DTSCS48
|
|
01028 MOVE MCMP-MAILING-LINE-1 TO MAP-MAILING-LINE-1. DTSCS48
|
|
01029 MOVE MCMP-MAILING-LINE-2 TO MAP-MAILING-LINE-2. DTSCS48
|
|
01030 MOVE MCMP-MAILING-LINE-3 TO MAP-MAILING-LINE-3. DTSCS48
|
|
01031 MOVE MCMP-MAILING-LINE-4 TO MAP-MAILING-LINE-4. DTSCS48
|
|
01032 MOVE MCMP-MAILING-LINE-5 TO MAP-MAILING-LINE-5. DTSCS48
|
|
01033 DTSCS48
|
|
01034 MOVE +0 TO MAP-CNT. DTSCS48
|
|
01035 MOVE +0 TO WRK-AMT-DUE. DTSCS48
|
|
01036 MOVE 99999 TO WRK-YRQ. DTSCS48
|
|
01037 DTSCS48
|
|
01038 PERFORM P6911-COVERED-YRQ THRU P6911-EXIT DTSCS48
|
|
01039 VARYING WRK-SUB FROM 1 BY 1 DTSCS48
|
|
01040 UNTIL WRK-SUB > MCMP-COV-CNT. DTSCS48
|
|
01041 DTSCS48
|
|
01042 MOVE MCMP-TAX-WAIVED-AMT TO MAP-TAX-WAIVED-AMT-Z. DTSCS48
|
|
01043 MOVE MCMP-PEN-WAIVED-AMT TO MAP-PEN-WAIVED-AMT-Z. DTSCS48
|
|
01044 MOVE MCMP-INT-WAIVED-AMT TO MAP-INT-WAIVED-AMT-Z. DTSCS48
|
|
01045 MOVE MCMP-TOT-BALANCE-AMT TO MAP-TOT-BALANCE-AMT-Z. DTSCS48
|
|
01046 DTSCS48
|
|
01047 P6910-EXIT. DTSCS48
|
|
01048 EXIT. DTSCS48
|
|
01049 DTSCS48
|
|
01050 P6911-COVERED-YRQ. DTSCS48
|
|
01051 DTSCS48
|
|
01052 MOVE ZEROS TO WRK-YRQ. DTSCS48
|
|
01053 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS48
|
|
01054 MOVE MCMP-EMP-NO TO MQTR-EMP-NO. DTSCS48
|
|
01055 SET MQTR-QTR-88 TO TRUE. DTSCS48
|
|
01056 MOVE MCMP-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS48
|
|
01057 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS48
|
|
01058 DTSCS48
|
|
01059 PERFORM S810-READ THRU S810-EXIT. DTSCS48
|
|
01060 DTSCS48
|
|
01061 IF L810-NO-REC-88 DTSCS48
|
|
01062 GO TO P6911-EXIT. DTSCS48
|
|
01063 DTSCS48
|
|
01064 MOVE MSKL-REC TO MQTR-REC. DTSCS48
|
|
01065 DTSCS48
|
|
01066 * IF MQTR-ANNUAL-YES-88 DTSCS48
|
|
01067 * MOVE MQTR-YRQ TO WRK-YRQ. DTSCS48
|
|
01068 * DTSCS48
|
|
01069 * IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR DTSCS48
|
|
01070 * ADD 1 TO MAP-CNT DTSCS48
|
|
01071 * MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48
|
|
01072 * WRK-YRQ-WRITTEN-OFF-AMT. DTSCS48
|
|
01073 DTSCS48
|
|
01074 ADD 1 TO MAP-CNT. DTSCS48
|
|
01075 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48
|
|
01076 WRK-YRQ-WAIVED-AMT DTSCS48
|
|
01077 WRK-YRQ-WRITTEN-OFF-AMT DTSCS48
|
|
01078 L101-PAID-CHNG DTSCS48
|
|
01079 L101-INT-CHARGE-CHNG DTSCS48
|
|
01080 L101-INT-WAIVE-CHNG. DTSCS48
|
|
01081 DTSCS48
|
|
01082 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS48
|
|
01083 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS48
|
|
01084 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
01085 TO WRK-YRQ-BALANCE-AMT DTSCS48
|
|
01086 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
01087 TO WRK-YRQ-WRITTEN-OFF-AMT DTSCS48
|
|
01088 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
01089 TO WRK-YRQ-WAIVED-AMT DTSCS48
|
|
01090 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS48
|
|
01091 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
01092 TO L101-PAID-CHNG DTSCS48
|
|
01093 END-IF DTSCS48
|
|
01094 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS48
|
|
01095 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS48
|
|
01096 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
01097 TO L101-PAID-CHNG DTSCS48
|
|
01098 END-IF DTSCS48
|
|
01099 END-PERFORM. DTSCS48
|
|
01100 DTSCS48
|
|
01101 PERFORM S4010-INTEREST THRU S4010-EXIT. DTSCS48
|
|
01102 DTSCS48
|
|
01103 ADD L101-INT-CHARGE-CHNG TO WRK-YRQ-BALANCE-AMT. DTSCS48
|
|
01104 DTSCS48
|
|
01105 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-YRQ-BALANCE-AMT. DTSCS48
|
|
01106 DTSCS48
|
|
01107 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS48
|
|
01108 MOVE ' WRITE OFF' TO MAP-WAIVED-AMT (MAP-CNT) DTSCS48
|
|
01109 ELSE DTSCS48
|
|
01110 * IF MQTR-ANNUAL-YES-88 DTSCS48
|
|
01111 * ADD WRK-YRQ-BALANCE-AMT TO WRK-AMT-DUE DTSCS48
|
|
01112 * MOVE WRK-AMT-DUE TO MAP-AMT-DUE-Z (MAP-CNT) DTSCS48
|
|
01113 * ELSE DTSCS48
|
|
01114 MOVE WRK-YRQ-WAIVED-AMT TO MAP-WAIVED-AMT-Z (MAP-CNT) DTSCS48
|
|
01115 MOVE WRK-YRQ-BALANCE-AMT TO MAP-BALANCE-AMT-Z (MAP-CNT)DTSCS48
|
|
01116 END-IF. DTSCS48
|
|
01117 DTSCS48
|
|
01118 DTSCS48
|
|
01119 IF MCMP-COVERED-YRQ (WRK-SUB) = LCCM-PICKUP-YRQ DTSCS48
|
|
01120 MOVE 'PU' TO MAP-COVERED-YRQ-YR (MAP-CNT) DTSCS48
|
|
01121 MOVE ' ' TO MAP-COVERED-YRQ-Q (MAP-CNT) DTSCS48
|
|
01122 ELSE DTSCS48
|
|
01123 MOVE MCMP-COVERED-YRQ(WRK-SUB) TO WRK-DISPLAY DTSCS48
|
|
01124 * IF MQTR-ANNUAL-YES-88 DTSCS48
|
|
01125 * MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YR DTSCS48
|
|
01126 * MOVE ZERO TO WRK-CURR-ANN-Q DTSCS48
|
|
01127 * MOVE WRK-CURR-ANN-YY TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS48
|
|
01128 * MOVE '*' TO MAP-COVERED-YRQ-Q(MAP-CNT) DTSCS48
|
|
01129 * ELSE DTSCS48
|
|
01130 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS48
|
|
01131 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q(MAP-CNT). DTSCS48
|
|
01132 DTSCS48
|
|
01133 P6911-EXIT. DTSCS48
|
|
01134 EXIT. DTSCS48
|
|
01135 DTSCS48
|
|
01136 P6990-PAGE-NUMBER. DTSCS48
|
|
01137 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS48
|
|
01138 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS48
|
|
01139 DTSCS48
|
|
01140 IF WS-REC-NUM = +1 DTSCS48
|
|
01141 IF LAST-REC-NUM = +1 DTSCS48
|
|
01142 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS48
|
|
01143 ELSE DTSCS48
|
|
01144 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS48
|
|
01145 ELSE DTSCS48
|
|
01146 IF WS-REC-NUM = LAST-REC-NUM DTSCS48
|
|
01147 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS48
|
|
01148 P6990-EXIT. DTSCS48
|
|
01149 EXIT. DTSCS48
|
|
01150 /**************************************************************** DTSCS48
|
|
01151 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. DTSCS48
|
|
01152 ***************************************************************** DTSCS48
|
|
01153 DTSCS48
|
|
01154 P7000-REQUEST-EDIT. DTSCS48
|
|
01155 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48
|
|
01156 DTSCS48
|
|
01157 IF LCCM-F09-88 DTSCS48
|
|
01158 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS48
|
|
01159 ELSE DTSCS48
|
|
01160 IF LCCM-F10-88 DTSCS48
|
|
01161 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS48
|
|
01162 * ELSE DTSCS48
|
|
01163 * IF LCCM-F23-88 DTSCS48
|
|
01164 * PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS48
|
|
01165 ELSE DTSCS48
|
|
01166 GO TO S899-ABEND. DTSCS48
|
|
01167 DTSCS48
|
|
01168 *------------------------------------------------------ DTSCS48
|
|
01169 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS48
|
|
01170 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS48
|
|
01171 * REMAIN IN 'INQUIRE' STATUS. DTSCS48
|
|
01172 *------------------------------------------------------ DTSCS48
|
|
01173 DTSCS48
|
|
01174 IF LCCM-MSG DTSCS48
|
|
01175 NEXT SENTENCE DTSCS48
|
|
01176 ELSE DTSCS48
|
|
01177 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS48
|
|
01178 IF LCCM-F09-88 DTSCS48
|
|
01179 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS48
|
|
01180 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS48
|
|
01181 ELSE DTSCS48
|
|
01182 IF LCCM-F10-88 DTSCS48
|
|
01183 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS48
|
|
01184 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCS48
|
|
01185 * ELSE DTSCS48
|
|
01186 * IF LCCM-F23-88 DTSCS48
|
|
01187 * SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS48
|
|
01188 * MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS48
|
|
01189 DTSCS48
|
|
01190 SET RESP-SEND-MAP TO TRUE. DTSCS48
|
|
01191 P7000-EXIT. DTSCS48
|
|
01192 EXIT. DTSCS48
|
|
01193 /**************************************************************** DTSCS48
|
|
01194 * ADD FUNCTION WAS REQUESTED DTSCS48
|
|
01195 ***************************************************************** DTSCS48
|
|
01196 DTSCS48
|
|
01197 P7100-EDIT-ADD. DTSCS48
|
|
01198 *----------------------------------------------------- DTSCS48
|
|
01199 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS48
|
|
01200 *----------------------------------------------------- DTSCS48
|
|
01201 IF NOT LCCM-SCR-CLEAR DTSCS48
|
|
01202 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS48
|
|
01203 GO TO P7100-EXIT. DTSCS48
|
|
01204 DTSCS48
|
|
01205 *----------------------------------------------------- DTSCS48
|
|
01206 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS48
|
|
01207 *----------------------------------------------------- DTSCS48
|
|
01208 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
01209 IF LCCM-MSG DTSCS48
|
|
01210 GO TO P7100-EXIT. DTSCS48
|
|
01211 DTSCS48
|
|
01212 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS48
|
|
01213 P7100-EXIT. DTSCS48
|
|
01214 EXIT. DTSCS48
|
|
01215 /**************************************************************** DTSCS48
|
|
01216 * MODIFICATION FUNCTION WAS REQUESTED DTSCS48
|
|
01217 ***************************************************************** DTSCS48
|
|
01218 DTSCS48
|
|
01219 P7200-EDIT-MOD. DTSCS48
|
|
01220 *----------------------------------------------------- DTSCS48
|
|
01221 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS48
|
|
01222 * INQUIRED DTSCS48
|
|
01223 *----------------------------------------------------- DTSCS48
|
|
01224 IF NOT LCCM-SCR-INQUIRE DTSCS48
|
|
01225 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS48
|
|
01226 GO TO P7200-EXIT. DTSCS48
|
|
01227 DTSCS48
|
|
01228 *----------------------------------------------------- DTSCS48
|
|
01229 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS48
|
|
01230 *----------------------------------------------------- DTSCS48
|
|
01231 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
01232 IF LCCM-MSG DTSCS48
|
|
01233 GO TO P7200-EXIT. DTSCS48
|
|
01234 DTSCS48
|
|
01235 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS48
|
|
01236 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS48
|
|
01237 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
01238 GO TO P7200-EXIT. DTSCS48
|
|
01239 DTSCS48
|
|
01240 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS48
|
|
01241 DTSCS48
|
|
01242 P7200-EXIT. DTSCS48
|
|
01243 EXIT. DTSCS48
|
|
01244 /**************************************************************** DTSCS48
|
|
01245 * DELETE FUNCTION WAS REQUESTED DTSCS48
|
|
01246 ***************************************************************** DTSCS48
|
|
01247 DTSCS48
|
|
01248 *P7300-EDIT-DEL. DTSCS48
|
|
01249 *----------------------------------------------------- DTSCS48
|
|
01250 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS48
|
|
01251 * INQUIRED DTSCS48
|
|
01252 *----------------------------------------------------- DTSCS48
|
|
01253 * IF NOT LCCM-SCR-INQUIRE DTSCS48
|
|
01254 * MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS48
|
|
01255 * GO TO P7300-EXIT. DTSCS48
|
|
01256 * DTSCS48
|
|
01257 *----------------------------------------------------- DTSCS48
|
|
01258 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DELETE DTSCS48
|
|
01259 *----------------------------------------------------- DTSCS48
|
|
01260 * PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
01261 * IF LCCM-MSG DTSCS48
|
|
01262 * GO TO P7300-EXIT. DTSCS48
|
|
01263 * DTSCS48
|
|
01264 * IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS48
|
|
01265 * MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS48
|
|
01266 * PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS48
|
|
01267 * DTSCS48
|
|
01268 *P7300-EXIT. DTSCS48
|
|
01269 * EXIT. DTSCS48
|
|
01270 /**************************************************************** DTSCS48
|
|
01271 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED DTSCS48
|
|
01272 ***************************************************************** DTSCS48
|
|
01273 DTSCS48
|
|
01274 P8000-REQUEST-UPDATE. DTSCS48
|
|
01275 DTSCS48
|
|
01276 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48
|
|
01277 DTSCS48
|
|
01278 IF LCCM-SCR-ADD-LOCKED DTSCS48
|
|
01279 PERFORM P8100-ADD THRU P8100-EXIT DTSCS48
|
|
01280 ELSE DTSCS48
|
|
01281 IF LCCM-SCR-MOD-LOCKED DTSCS48
|
|
01282 PERFORM P8200-MOD THRU P8200-EXIT DTSCS48
|
|
01283 * ELSE DTSCS48
|
|
01284 * IF LCCM-SCR-DEL-LOCKED DTSCS48
|
|
01285 * PERFORM P8300-DEL THRU P8300-EXIT DTSCS48
|
|
01286 ELSE DTSCS48
|
|
01287 GO TO S899-ABEND. DTSCS48
|
|
01288 DTSCS48
|
|
01289 SET RESP-SEND-MAP TO TRUE. DTSCS48
|
|
01290 P8000-EXIT. DTSCS48
|
|
01291 EXIT. DTSCS48
|
|
01292 /**************************************************************** DTSCS48
|
|
01293 * DTSCS48
|
|
01294 ***************************************************************** DTSCS48
|
|
01295 DTSCS48
|
|
01296 P8100-ADD. DTSCS48
|
|
01297 SET LCCM-SCR-CLEAR TO TRUE. DTSCS48
|
|
01298 DTSCS48
|
|
01299 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48
|
|
01300 DTSCS48
|
|
01301 IF LCCM-F12-88 DTSCS48
|
|
01302 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS48
|
|
01303 GO TO P8100-EXIT. DTSCS48
|
|
01304 DTSCS48
|
|
01305 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
01306 DTSCS48
|
|
01307 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS48
|
|
01308 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS48
|
|
01309 IF LCCM-MSG DTSCS48
|
|
01310 GO TO P8100-EXIT. DTSCS48
|
|
01311 DTSCS48
|
|
01312 PERFORM P8110-CONSTRUCT-MCMP THRU P8110-EXIT. DTSCS48
|
|
01313 DTSCS48
|
|
01314 * IF MPRF-NO-MCMP-88 DTSCS48
|
|
01315 * PERFORM P8120-UPDATE-MPRF THRU P8120-EXIT. DTSCS48
|
|
01316 DTSCS48
|
|
01317 * IF MAP-STATUS-CD = 'P' DTSCS48
|
|
01318 * PERFORM P8130-CREATE-MTCK THRU P8130-EXIT. DTSCS48
|
|
01319 DTSCS48
|
|
01320 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS48
|
|
01321 DTSCS48
|
|
01322 MOVE 'DTSCS48' TO LCCM-SCR-HOLD-PROG-NAME. DTSCS48
|
|
01323 MOVE MCMP-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS48
|
|
01324 DTSCS48
|
|
01325 SET LCCM-ENTER-88 TO TRUE. DTSCS48
|
|
01326 DTSCS48
|
|
01327 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS48
|
|
01328 DTSCS48
|
|
01329 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS48
|
|
01330 DTSCS48
|
|
01331 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48
|
|
01332 P8100-EXIT. DTSCS48
|
|
01333 EXIT. DTSCS48
|
|
01334 DTSCS48
|
|
01335 P8110-CONSTRUCT-MCMP. DTSCS48
|
|
01336 MOVE LOW-VALUES TO MCMP-REC. DTSCS48
|
|
01337 DTSCS48
|
|
01338 MOVE WRK-EMP-NO TO MCMP-EMP-NO. DTSCS48
|
|
01339 SET MCMP-CMP-88 TO TRUE. DTSCS48
|
|
01340 MOVE LCCM-TASK-START-ABSTIME TO MCMP-ESTB-ABSTIME. DTSCS48
|
|
01341 DTSCS48
|
|
01342 MOVE ZERO TO MCMP-PURGE-DATE. DTSCS48
|
|
01343 DTSCS48
|
|
01344 SET MCMP-NOT-CONVERTED-88 TO TRUE. DTSCS48
|
|
01345 MOVE LCCM-CURR-RUN-DATE TO MCMP-ESTB-DATE. DTSCS48
|
|
01346 MOVE LCCM-CURR-RUN-DATE TO MCMP-CHNG-DATE. DTSCS48
|
|
01347 DTSCS48
|
|
01348 SET MCMP-STATUS-PENDING-88 TO TRUE. DTSCS48
|
|
01349 DTSCS48
|
|
01350 MOVE MAP-MAILING-LINE-1 TO MCMP-MAILING-LINE-1. DTSCS48
|
|
01351 MOVE MAP-MAILING-LINE-2 TO MCMP-MAILING-LINE-2. DTSCS48
|
|
01352 MOVE MAP-MAILING-LINE-3 TO MCMP-MAILING-LINE-3. DTSCS48
|
|
01353 MOVE MAP-MAILING-LINE-4 TO MCMP-MAILING-LINE-4. DTSCS48
|
|
01354 MOVE MAP-MAILING-LINE-5 TO MCMP-MAILING-LINE-5. DTSCS48
|
|
01355 DTSCS48
|
|
01356 MOVE MAP-SETTLEMENT-DATE-AREA TO L015-S-DATE-AREA. DTSCS48
|
|
01357 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48
|
|
01358 MOVE L015-DATE TO MCMP-SETTLEMENT-DATE. DTSCS48
|
|
01359 DTSCS48
|
|
01360 MOVE MAP-INT-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS48
|
|
01361 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48
|
|
01362 MOVE L015-DATE TO MCMP-INT-COMP-DATE. DTSCS48
|
|
01363 DTSCS48
|
|
01364 MOVE MAP-AUTHORIZE-OP-ID TO MCMP-AUTHORIZE-OP-ID. DTSCS48
|
|
01365 DTSCS48
|
|
01366 MOVE +0.00 TO L011-MIN-AMT. DTSCS48
|
|
01367 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48
|
|
01368 MOVE MAP-TAX-WAIVED-AMT-AREA TO L011-S-AMT-AREA. DTSCS48
|
|
01369 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48
|
|
01370 MOVE L011-AMT TO MCMP-TAX-WAIVED-AMT. DTSCS48
|
|
01371 DTSCS48
|
|
01372 MOVE +0.00 TO L011-MIN-AMT. DTSCS48
|
|
01373 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48
|
|
01374 MOVE MAP-PEN-WAIVED-AMT-AREA TO L011-S-AMT-AREA. DTSCS48
|
|
01375 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48
|
|
01376 MOVE L011-AMT TO MCMP-PEN-WAIVED-AMT. DTSCS48
|
|
01377 DTSCS48
|
|
01378 MOVE +0.00 TO L011-MIN-AMT. DTSCS48
|
|
01379 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48
|
|
01380 MOVE MAP-INT-WAIVED-AMT-AREA TO L011-S-AMT-AREA. DTSCS48
|
|
01381 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48
|
|
01382 MOVE L011-AMT TO MCMP-INT-WAIVED-AMT. DTSCS48
|
|
01383 DTSCS48
|
|
01384 MOVE +0.00 TO L011-MIN-AMT. DTSCS48
|
|
01385 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48
|
|
01386 MOVE MAP-TOT-BALANCE-AMT-AREA TO L011-S-AMT-AREA. DTSCS48
|
|
01387 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48
|
|
01388 MOVE L011-AMT TO MCMP-TOT-BALANCE-AMT. DTSCS48
|
|
01389 DTSCS48
|
|
01390 MOVE +0 TO MCMP-COV-CNT. DTSCS48
|
|
01391 DTSCS48
|
|
01392 PERFORM P8111-COVERED-YRQ-LOOP THRU P8111-EXIT DTSCS48
|
|
01393 VARYING WRK-SUB FROM 1 BY 1 DTSCS48
|
|
01394 UNTIL WRK-SUB > MMAX-CMP-COV-MAX. DTSCS48
|
|
01395 DTSCS48
|
|
01396 MOVE MCMP-REC TO MSKL-REC. DTSCS48
|
|
01397 PERFORM S810-WRITE THRU S810-EXIT. DTSCS48
|
|
01398 DTSCS48
|
|
01399 PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS48
|
|
01400 DTSCS48
|
|
01401 PERFORM P8112-ADD-T011 THRU P8112-EXIT. DTSCS48
|
|
01402 DTSCS48
|
|
01403 P8110-EXIT. EXIT. DTSCS48
|
|
01404 DTSCS48
|
|
01405 P8111-COVERED-YRQ-LOOP. DTSCS48
|
|
01406 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS48
|
|
01407 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS48
|
|
01408 DTSCS48
|
|
01409 IF L029-VALID DTSCS48
|
|
01410 ADD +1 TO MCMP-COV-CNT DTSCS48
|
|
01411 MOVE L029-YRQ TO MCMP-COVERED-YRQ (MCMP-COV-CNT). DTSCS48
|
|
01412 P8111-EXIT. DTSCS48
|
|
01413 EXIT. DTSCS48
|
|
01414 SKIP3 DTSCS48
|
|
01415 P8112-ADD-T011. DTSCS48
|
|
01416 MOVE MCMP-EMP-NO TO T011-EMP-NO. DTSCS48
|
|
01417 MOVE LCCM-OP-ID TO T011-OP-ID. DTSCS48
|
|
01418 MOVE WRK-SCR-ID TO T011-SCR-ID. DTSCS48
|
|
01419 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE. DTSCS48
|
|
01420 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME. DTSCS48
|
|
01421 MOVE LOW-VALUES TO T011-DATA-AREA. DTSCS48
|
|
01422 MOVE ZEROS TO T011-START-YRQ DTSCS48
|
|
01423 T011-END-YRQ DTSCS48
|
|
01424 T011-BATCH-NO DTSCS48
|
|
01425 T011-ITEM-NO. DTSCS48
|
|
01426 SET T011-CMP-PKG TO TRUE. DTSCS48
|
|
01427 MOVE LCCM-OP-ID TO T011-RESP-OP-ID. DTSCS48
|
|
01428 MOVE MCMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME. DTSCS48
|
|
01429 MOVE LENGTH OF T011-REC TO T011-LENGTH. DTSCS48
|
|
01430 MOVE T011-REC TO RSKL-REC. DTSCS48
|
|
01431 PERFORM S825-WRITE THRU S825-EXIT. DTSCS48
|
|
01432 P8112-EXIT. DTSCS48
|
|
01433 EXIT. DTSCS48
|
|
01434 SKIP3 DTSCS48
|
|
01435 *P8120-UPDATE-MPRF. DTSCS48
|
|
01436 * PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS48
|
|
01437 * DTSCS48
|
|
01438 * SET MPRF-MCMP-EXISTS-88 TO TRUE. DTSCS48
|
|
01439 * MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS48
|
|
01440 * MOVE MPRF-REC TO MSKL-REC. DTSCS48
|
|
01441 * PERFORM S810-REWRITE THRU S810-EXIT. DTSCS48
|
|
01442 *P8120-EXIT. DTSCS48
|
|
01443 * EXIT. DTSCS48
|
|
01444 DTSCS48
|
|
01445 *P8130-CREATE-MTCK. DTSCS48
|
|
01446 * MOVE LOW-VALUE TO MTCK-REC. DTSCS48
|
|
01447 * MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSCS48
|
|
01448 * SET MTCK-TCK-88 TO TRUE. DTSCS48
|
|
01449 * MOVE LCCM-SCR-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS48
|
|
01450 * DTSCS48
|
|
01451 * MOVE +0 TO MTCK-PURGE-DATE. DTSCS48
|
|
01452 * DTSCS48
|
|
01453 * INITIALIZE MTCK-DATA-AREA. DTSCS48
|
|
01454 * SET MTCK-TYPE-CMP-PEND-88 TO TRUE. DTSCS48
|
|
01455 * DTSCS48
|
|
01456 * MOVE LCCM-NEXT-RUN-DATE TO MTCK-TRIGGER-DATE. DTSCS48
|
|
01457 * DTSCS48
|
|
01458 * SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSCS48
|
|
01459 * SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSCS48
|
|
01460 * MOVE MCMP-ESTB-ABSTIME TO MTCK-CMP-ESTB-ABSTIME. DTSCS48
|
|
01461 * SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSCS48
|
|
01462 * MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSCS48
|
|
01463 * MTCK-CHNG-DATE. DTSCS48
|
|
01464 * MOVE +0 TO MTCK-TEXT-CNT. DTSCS48
|
|
01465 * DTSCS48
|
|
01466 * MOVE MTCK-REC TO MSKL-REC. DTSCS48
|
|
01467 * PERFORM S810-WRITE THRU S810-EXIT. DTSCS48
|
|
01468 *P8130-EXIT. DTSCS48
|
|
01469 * EXIT. DTSCS48
|
|
01470 /**************************************************************** DTSCS48
|
|
01471 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS DTSCS48
|
|
01472 ***************************************************************** DTSCS48
|
|
01473 DTSCS48
|
|
01474 P8200-MOD. DTSCS48
|
|
01475 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS48
|
|
01476 DTSCS48
|
|
01477 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48
|
|
01478 DTSCS48
|
|
01479 IF LCCM-F12-88 DTSCS48
|
|
01480 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS48
|
|
01481 GO TO P8200-EXIT. DTSCS48
|
|
01482 DTSCS48
|
|
01483 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
01484 DTSCS48
|
|
01485 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS48
|
|
01486 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS48
|
|
01487 IF LCCM-MSG DTSCS48
|
|
01488 GO TO P8200-EXIT. DTSCS48
|
|
01489 DTSCS48
|
|
01490 PERFORM P8210-CONSTRUCT-MCMP THRU P8210-EXIT. DTSCS48
|
|
01491 DTSCS48
|
|
01492 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS48
|
|
01493 DTSCS48
|
|
01494 MOVE 'DTSCS48' TO LCCM-SCR-HOLD-PROG-NAME. DTSCS48
|
|
01495 MOVE MCMP-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS48
|
|
01496 DTSCS48
|
|
01497 SET LCCM-ENTER-88 TO TRUE. DTSCS48
|
|
01498 DTSCS48
|
|
01499 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS48
|
|
01500 DTSCS48
|
|
01501 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS48
|
|
01502 DTSCS48
|
|
01503 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48
|
|
01504 P8200-EXIT. DTSCS48
|
|
01505 EXIT. DTSCS48
|
|
01506 EJECT DTSCS48
|
|
01507 P8210-CONSTRUCT-MCMP. DTSCS48
|
|
01508 IF LCCM-SCR-HOLD-PROG-NAME = 'DTSCS48' DTSCS48
|
|
01509 MOVE LCCM-SCR-HOLD-KEY TO MSKL-KEY-AREA DTSCS48
|
|
01510 PERFORM S810-READ THRU S810-EXIT DTSCS48
|
|
01511 IF L810-NO-REC-88 DTSCS48
|
|
01512 PERFORM S899-ABEND THRU S899-EXIT DTSCS48
|
|
01513 ELSE DTSCS48
|
|
01514 MOVE MSKL-REC TO MCMP-REC DTSCS48
|
|
01515 END-IF DTSCS48
|
|
01516 ELSE DTSCS48
|
|
01517 PERFORM S899-ABEND THRU S899-EXIT DTSCS48
|
|
01518 END-IF. DTSCS48
|
|
01519 DTSCS48
|
|
01520 MOVE MCMP-STATUS-CD TO WRK-STATUS-CD. DTSCS48
|
|
01521 DTSCS48
|
|
01522 MOVE MAP-STATUS-CD TO MCMP-STATUS-CD. DTSCS48
|
|
01523 DTSCS48
|
|
01524 IF (WRK-STATUS-CD = 'F' OR 'P') DTSCS48
|
|
01525 AND DTSCS48
|
|
01526 (MCMP-STATUS-WITHDRAWN-88) DTSCS48
|
|
01527 PERFORM P8212-ADD-T011 THRU P8212-EXIT DTSCS48
|
|
01528 PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS48
|
|
01529 DTSCS48
|
|
01530 MOVE MCMP-REC TO MSKL-REC. DTSCS48
|
|
01531 DTSCS48
|
|
01532 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS48
|
|
01533 P8210-EXIT. EXIT. DTSCS48
|
|
01534 DTSCS48
|
|
01535 P8212-ADD-T011. DTSCS48
|
|
01536 MOVE MCMP-EMP-NO TO T011-EMP-NO. DTSCS48
|
|
01537 MOVE LCCM-OP-ID TO T011-OP-ID. DTSCS48
|
|
01538 MOVE WRK-SCR-ID TO T011-SCR-ID. DTSCS48
|
|
01539 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE. DTSCS48
|
|
01540 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME. DTSCS48
|
|
01541 MOVE LOW-VALUES TO T011-DATA-AREA. DTSCS48
|
|
01542 SET T011-CMP-WD TO TRUE. DTSCS48
|
|
01543 MOVE LCCM-OP-ID TO T011-RESP-OP-ID. DTSCS48
|
|
01544 MOVE MCMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME. DTSCS48
|
|
01545 MOVE LENGTH OF T011-REC TO T011-LENGTH. DTSCS48
|
|
01546 MOVE T011-REC TO RSKL-REC. DTSCS48
|
|
01547 PERFORM S825-WRITE THRU S825-EXIT. DTSCS48
|
|
01548 P8212-EXIT. EXIT. DTSCS48
|
|
01549 DTSCS48
|
|
01550 /**************************************************************** DTSCS48
|
|
01551 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS DTSCS48
|
|
01552 ***************************************************************** DTSCS48
|
|
01553 DTSCS48
|
|
01554 *P8300-DEL. DTSCS48
|
|
01555 * SET LCCM-SCR-INQUIRE TO TRUE. DTSCS48
|
|
01556 * DTSCS48
|
|
01557 * IF LCCM-F12-88 DTSCS48
|
|
01558 * MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS48
|
|
01559 * GO TO P8300-EXIT. DTSCS48
|
|
01560 * DTSCS48
|
|
01561 * PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48
|
|
01562 * DTSCS48
|
|
01563 * MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS48
|
|
01564 * PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS48
|
|
01565 * IF LCCM-MSG DTSCS48
|
|
01566 * GO TO P8300-EXIT. DTSCS48
|
|
01567 * DTSCS48
|
|
01568 * MOVE LCCM-SCR48-HOLD-AREA TO MSKL-KEY-AREA. DTSCS48
|
|
01569 * PERFORM S810-READ THRU S810-EXIT. DTSCS48
|
|
01570 * IF L810-NO-REC-88 DTSCS48
|
|
01571 * GO TO S899-ABEND. DTSCS48
|
|
01572 * DTSCS48
|
|
01573 * PERFORM S810-DELETE THRU S810-EXIT. DTSCS48
|
|
01574 * DTSCS48
|
|
01575 * MOVE LOW-VALUE TO MCMP-STATUS-CD. DTSCS48
|
|
01576 * PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS48
|
|
01577 * DTSCS48
|
|
01578 * MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS48
|
|
01579 * MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48
|
|
01580 * SET MSKL-CMP-88 TO TRUE. DTSCS48
|
|
01581 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48
|
|
01582 * IF L810-NO-REC-88 DTSCS48
|
|
01583 * PERFORM S1110-READ-MPRF THRU S1110-EXIT DTSCS48
|
|
01584 * SET MPRF-NO-MCMP-88 TO TRUE DTSCS48
|
|
01585 * MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS48
|
|
01586 * MOVE MPRF-REC TO MSKL-REC DTSCS48
|
|
01587 * PERFORM S810-REWRITE THRU S810-EXIT DTSCS48
|
|
01588 * ELSE DTSCS48
|
|
01589 * PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48
|
|
01590 * DTSCS48
|
|
01591 * PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS48
|
|
01592 * DTSCS48
|
|
01593 * SET LCCM-SCR-CLEAR TO TRUE. DTSCS48
|
|
01594 * MOVE LOW-VALUE TO MAP-AREA. DTSCS48
|
|
01595 * PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48
|
|
01596 * DTSCS48
|
|
01597 * MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS48
|
|
01598 * MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS48
|
|
01599 * MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS48
|
|
01600 * DTSCS48
|
|
01601 * MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS48
|
|
01602 * DTSCS48
|
|
01603 * MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48
|
|
01604 *P8300-EXIT. DTSCS48
|
|
01605 * EXIT. DTSCS48
|
|
01606 EJECT DTSCS48
|
|
01607 P8810-LOCK-EMPLOYER. DTSCS48
|
|
01608 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS48
|
|
01609 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS48
|
|
01610 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS48
|
|
01611 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS48
|
|
01612 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS48
|
|
01613 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS48
|
|
01614 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS48
|
|
01615 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS48
|
|
01616 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS48
|
|
01617 DTSCS48
|
|
01618 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS48
|
|
01619 P8810-EXIT. DTSCS48
|
|
01620 EXIT. DTSCS48
|
|
01621 DTSCS48
|
|
01622 DTSCS48
|
|
01623 P8820-CREATE-MEVL. DTSCS48
|
|
01624 MOVE LOW-VALUES TO MEVL-REC. DTSCS48
|
|
01625 DTSCS48
|
|
01626 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS48
|
|
01627 SET MEVL-EVL-88 TO TRUE. DTSCS48
|
|
01628 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS48
|
|
01629 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS48
|
|
01630 DTSCS48
|
|
01631 IF MCMP-STATUS-PENDING-88 DTSCS48
|
|
01632 MOVE 'PENDING.' TO EVL-STATUS-CD-DSCR DTSCS48
|
|
01633 ELSE DTSCS48
|
|
01634 IF MCMP-STATUS-WITHDRAWN-88 DTSCS48
|
|
01635 MOVE 'WITHDRAWN.' TO EVL-STATUS-CD-DSCR DTSCS48
|
|
01636 ELSE DTSCS48
|
|
01637 IF MCMP-STATUS-FINAL-88 DTSCS48
|
|
01638 MOVE 'FINAL.' TO EVL-STATUS-CD-DSCR DTSCS48
|
|
01639 ELSE DTSCS48
|
|
01640 GO TO P8820-EXIT. DTSCS48
|
|
01641 DTSCS48
|
|
01642 MOVE EVL-TEXT TO MEVL-TEXT. DTSCS48
|
|
01643 DTSCS48
|
|
01644 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS48
|
|
01645 DTSCS48
|
|
01646 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS48
|
|
01647 DTSCS48
|
|
01648 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS48
|
|
01649 MEVL-CHNG-DATE. DTSCS48
|
|
01650 DTSCS48
|
|
01651 MOVE MEVL-REC TO MSKL-REC. DTSCS48
|
|
01652 PERFORM S810-WRITE THRU S810-EXIT. DTSCS48
|
|
01653 P8820-EXIT. DTSCS48
|
|
01654 EXIT. DTSCS48
|
|
01655 /**************************************************************** DTSCS48
|
|
01656 * LINKS TO UTILITY MODULES DTSCS48
|
|
01657 ***************************************************************** DTSCS48
|
|
01658 DTSCS48
|
|
01659 S001-FROM-FED-8. DTSCS48
|
|
01660 SET L001-FROM-FED-8 TO TRUE. DTSCS48
|
|
01661 GO TO S001-DATE. DTSCS48
|
|
01662 DTSCS48
|
|
01663 S001-FROM-ABS-DATE. DTSCS48
|
|
01664 SET L001-FROM-ABS-DAY TO TRUE. DTSCS48
|
|
01665 GO TO S001-DATE. DTSCS48
|
|
01666 DTSCS48
|
|
01667 S001-DATE. DTSCS48
|
|
01668 EXEC CICS LINK DTSCS48
|
|
01669 PROGRAM('DTSCU001') DTSCS48
|
|
01670 COMMAREA(L001-COMM-AREA) DTSCS48
|
|
01671 END-EXEC. DTSCS48
|
|
01672 S001-EXIT. DTSCS48
|
|
01673 EXIT. DTSCS48
|
|
01674 DTSCS48
|
|
01675 S011-AMT-FROM-SCREEN. DTSCS48
|
|
01676 EXEC CICS LINK DTSCS48
|
|
01677 PROGRAM ('DTSCU011') DTSCS48
|
|
01678 COMMAREA (L011-COMM-AREA) DTSCS48
|
|
01679 END-EXEC. DTSCS48
|
|
01680 S011-EXIT. DTSCS48
|
|
01681 EXIT. DTSCS48
|
|
01682 DTSCS48
|
|
01683 S015-DATE-FROM-SCREEN. DTSCS48
|
|
01684 EXEC CICS LINK DTSCS48
|
|
01685 PROGRAM ('DTSCU015') DTSCS48
|
|
01686 COMMAREA (L015-COMM-AREA) DTSCS48
|
|
01687 END-EXEC. DTSCS48
|
|
01688 S015-EXIT. DTSCS48
|
|
01689 EXIT. DTSCS48
|
|
01690 DTSCS48
|
|
01691 S013-COUNT-FROM-SCREEN. DTSCS48
|
|
01692 EXEC CICS LINK DTSCS48
|
|
01693 PROGRAM('DTSCU013') DTSCS48
|
|
01694 COMMAREA(L013-COMM-AREA) DTSCS48
|
|
01695 END-EXEC. DTSCS48
|
|
01696 S013-EXIT. DTSCS48
|
|
01697 EXIT. DTSCS48
|
|
01698 DTSCS48
|
|
01699 S018-EMP-NO-FROM-SCREEN. DTSCS48
|
|
01700 EXEC CICS LINK DTSCS48
|
|
01701 PROGRAM('DTSCU018') DTSCS48
|
|
01702 COMMAREA(L018-COMM-AREA) DTSCS48
|
|
01703 END-EXEC. DTSCS48
|
|
01704 S018-EXIT. DTSCS48
|
|
01705 EXIT. DTSCS48
|
|
01706 DTSCS48
|
|
01707 DTSCS48
|
|
01708 S029-YRQ-FROM-SCREEN. DTSCS48
|
|
01709 EXEC CICS LINK DTSCS48
|
|
01710 PROGRAM('DTSCU029') DTSCS48
|
|
01711 COMMAREA(L029-COMM-AREA) DTSCS48
|
|
01712 END-EXEC. DTSCS48
|
|
01713 S029-EXIT. DTSCS48
|
|
01714 EXIT. DTSCS48
|
|
01715 DTSCS48
|
|
01716 DTSCS48
|
|
01717 S034-MCMP-STATUS-CD. DTSCS48
|
|
01718 SET L034-MCMP-STATUS-CD TO TRUE. DTSCS48
|
|
01719 GO TO S034-LINK. DTSCS48
|
|
01720 DTSCS48
|
|
01721 S034-LINK. DTSCS48
|
|
01722 EXEC CICS LINK DTSCS48
|
|
01723 PROGRAM ('DTSCU034') DTSCS48
|
|
01724 COMMAREA (L034-COMM-AREA) DTSCS48
|
|
01725 END-EXEC. DTSCS48
|
|
01726 S034-EXIT. DTSCS48
|
|
01727 EXIT. DTSCS48
|
|
01728 DTSCS48
|
|
01729 S071-CONVERT-NAME. DTSCS48
|
|
01730 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS48
|
|
01731 EXEC CICS LINK DTSCS48
|
|
01732 PROGRAM ('DTSCU071') DTSCS48
|
|
01733 COMMAREA (L071-COMM-AREA) DTSCS48
|
|
01734 END-EXEC. DTSCS48
|
|
01735 S071-EXIT. DTSCS48
|
|
01736 EXIT. DTSCS48
|
|
01737 DTSCS48
|
|
01738 S082-OP-ID-EDIT. DTSCS48
|
|
01739 EXEC CICS LINK DTSCS48
|
|
01740 PROGRAM('DTSCU082') DTSCS48
|
|
01741 COMMAREA(L082-COMM-AREA) DTSCS48
|
|
01742 END-EXEC. DTSCS48
|
|
01743 DTSCS48
|
|
01744 IF L082-FILE-CLOSED DTSCS48
|
|
01745 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
01746 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48
|
|
01747 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48
|
|
01748 GO TO MAINLINE-EXIT. DTSCS48
|
|
01749 S082-EXIT. DTSCS48
|
|
01750 EXIT. DTSCS48
|
|
01751 DTSCS48
|
|
01752 S101-PER-MONTH-YES. DTSCS48
|
|
01753 SET L101-PER-MONTH-YES-88 TO TRUE. DTSCS48
|
|
01754 GO TO S101-INT-COMP. DTSCS48
|
|
01755 DTSCS48
|
|
01756 S101-INT-COMP. DTSCS48
|
|
01757 EXEC CICS LINK DTSCS48
|
|
01758 PROGRAM ('DTSCU101') DTSCS48
|
|
01759 COMMAREA (L101-COMM-AREA) DTSCS48
|
|
01760 END-EXEC. DTSCS48
|
|
01761 S101-EXIT. DTSCS48
|
|
01762 EXIT. DTSCS48
|
|
01763 S109-SUR-TAX-QTR. DTSCS48
|
|
01764 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS48
|
|
01765 EXEC CICS LINK DTSCS48
|
|
01766 PROGRAM ('DTSCU109') DTSCS48
|
|
01767 COMMAREA (L109-COMM-AREA) DTSCS48
|
|
01768 END-EXEC. DTSCS48
|
|
01769 S109-EXIT. DTSCS48
|
|
01770 EXIT. DTSCS48
|
|
01771 DTSCS48
|
|
01772 S111-ADDR-LOOKUP. DTSCS48
|
|
01773 EXEC CICS LINK DTSCS48
|
|
01774 PROGRAM('DTSCU111') DTSCS48
|
|
01775 COMMAREA(L111-COMM-AREA) DTSCS48
|
|
01776 END-EXEC. DTSCS48
|
|
01777 DTSCS48
|
|
01778 IF L111-FILE-CLOSED-88 DTSCS48
|
|
01779 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
01780 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48
|
|
01781 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48
|
|
01782 GO TO MAINLINE-EXIT. DTSCS48
|
|
01783 S111-EXIT. DTSCS48
|
|
01784 EXIT. DTSCS48
|
|
01785 DTSCS48
|
|
01786 S112-ADDR-FORMAT. DTSCS48
|
|
01787 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS48
|
|
01788 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS48
|
|
01789 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS48
|
|
01790 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS48
|
|
01791 DTSCS48
|
|
01792 EXEC CICS LINK DTSCS48
|
|
01793 PROGRAM('DTSCU112') DTSCS48
|
|
01794 COMMAREA(L112-COMM-AREA) DTSCS48
|
|
01795 END-EXEC. DTSCS48
|
|
01796 S112-EXIT. DTSCS48
|
|
01797 EXIT. DTSCS48
|
|
01798 DTSCS48
|
|
01799 S221-EMP-LOCK. DTSCS48
|
|
01800 SET L221-START-UPDATE TO TRUE. DTSCS48
|
|
01801 GO TO S221-EMP-LOCK-UNLOCK. DTSCS48
|
|
01802 DTSCS48
|
|
01803 S221-EMP-UNLOCK. DTSCS48
|
|
01804 SET L221-END-UPDATE TO TRUE. DTSCS48
|
|
01805 GO TO S221-EMP-LOCK-UNLOCK. DTSCS48
|
|
01806 DTSCS48
|
|
01807 S221-EMP-LOCK-UNLOCK. DTSCS48
|
|
01808 EXEC CICS LINK DTSCS48
|
|
01809 PROGRAM('DTSCU221') DTSCS48
|
|
01810 COMMAREA(L221-COMM-AREA) DTSCS48
|
|
01811 END-EXEC. DTSCS48
|
|
01812 DTSCS48
|
|
01813 IF L221-FILE-CLOSED DTSCS48
|
|
01814 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
01815 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48
|
|
01816 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48
|
|
01817 GO TO MAINLINE-EXIT. DTSCS48
|
|
01818 DTSCS48
|
|
01819 IF L221-NOT-OK DTSCS48
|
|
01820 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS48
|
|
01821 S221-EXIT. DTSCS48
|
|
01822 EXIT. DTSCS48
|
|
01823 DTSCS48
|
|
01824 DTSCS48
|
|
01825 S803-REQ-SCR-ID-EDIT. DTSCS48
|
|
01826 EXEC CICS LINK DTSCS48
|
|
01827 PROGRAM ('DTSCU803') DTSCS48
|
|
01828 COMMAREA (DFHCOMMAREA) DTSCS48
|
|
01829 END-EXEC. DTSCS48
|
|
01830 S803-EXIT. DTSCS48
|
|
01831 EXIT. DTSCS48
|
|
01832 DTSCS48
|
|
01833 S804-INVALID-KEY. DTSCS48
|
|
01834 EXEC CICS LINK DTSCS48
|
|
01835 PROGRAM ('DTSCU804') DTSCS48
|
|
01836 COMMAREA (DFHCOMMAREA) DTSCS48
|
|
01837 END-EXEC. DTSCS48
|
|
01838 S804-EXIT. DTSCS48
|
|
01839 EXIT. DTSCS48
|
|
01840 DTSCS48
|
|
01841 S805-MSG-AREA. DTSCS48
|
|
01842 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS48
|
|
01843 DTSCS48
|
|
01844 EXEC CICS LINK DTSCS48
|
|
01845 PROGRAM ('DTSCU805') DTSCS48
|
|
01846 COMMAREA (L805-COMM-AREA) DTSCS48
|
|
01847 END-EXEC. DTSCS48
|
|
01848 DTSCS48
|
|
01849 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS48
|
|
01850 S805-EXIT. DTSCS48
|
|
01851 EXIT. DTSCS48
|
|
01852 EJECT DTSCS48
|
|
01853 S810-READ. DTSCS48
|
|
01854 SET L810-READ-88 TO TRUE. DTSCS48
|
|
01855 GO TO S810-IO. DTSCS48
|
|
01856 DTSCS48
|
|
01857 S810-START-BROWSE. DTSCS48
|
|
01858 SET L810-START-BROWSE-88 TO TRUE. DTSCS48
|
|
01859 GO TO S810-IO. DTSCS48
|
|
01860 DTSCS48
|
|
01861 S810-READ-NEXT. DTSCS48
|
|
01862 SET L810-READ-NEXT-88 TO TRUE. DTSCS48
|
|
01863 GO TO S810-IO. DTSCS48
|
|
01864 DTSCS48
|
|
01865 S810-READ-PREV. DTSCS48
|
|
01866 SET L810-READ-PREV-88 TO TRUE. DTSCS48
|
|
01867 GO TO S810-IO. DTSCS48
|
|
01868 DTSCS48
|
|
01869 S810-END-BROWSE. DTSCS48
|
|
01870 SET L810-END-BROWSE-88 TO TRUE. DTSCS48
|
|
01871 GO TO S810-IO. DTSCS48
|
|
01872 DTSCS48
|
|
01873 S810-COUNT. DTSCS48
|
|
01874 SET L810-COUNT-88 TO TRUE. DTSCS48
|
|
01875 GO TO S810-IO. DTSCS48
|
|
01876 DTSCS48
|
|
01877 S810-REWRITE. DTSCS48
|
|
01878 SET L810-REWRITE-88 TO TRUE. DTSCS48
|
|
01879 GO TO S810-IO. DTSCS48
|
|
01880 DTSCS48
|
|
01881 S810-WRITE. DTSCS48
|
|
01882 SET L810-WRITE-88 TO TRUE. DTSCS48
|
|
01883 GO TO S810-IO. DTSCS48
|
|
01884 DTSCS48
|
|
01885 S810-DELETE. DTSCS48
|
|
01886 SET L810-DELETE-88 TO TRUE. DTSCS48
|
|
01887 GO TO S810-IO. DTSCS48
|
|
01888 DTSCS48
|
|
01889 S810-IO. DTSCS48
|
|
01890 DTSCS48
|
|
01891 EXEC CICS LINK DTSCS48
|
|
01892 PROGRAM ('DTSCU810') DTSCS48
|
|
01893 COMMAREA (L810-COMM-AREA) DTSCS48
|
|
01894 END-EXEC. DTSCS48
|
|
01895 DTSCS48
|
|
01896 IF L810-FILE-CLOSED-88 DTSCS48
|
|
01897 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
01898 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48
|
|
01899 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48
|
|
01900 GO TO MAINLINE-EXIT. DTSCS48
|
|
01901 S810-EXIT. DTSCS48
|
|
01902 EXIT. DTSCS48
|
|
01903 SKIP3 DTSCS48
|
|
01904 S825-WRITE. DTSCS48
|
|
01905 SET L825-WRITE-88 TO TRUE. DTSCS48
|
|
01906 GO TO S825-O. DTSCS48
|
|
01907 DTSCS48
|
|
01908 S825-O. DTSCS48
|
|
01909 EXEC CICS DTSCS48
|
|
01910 LINK DTSCS48
|
|
01911 PROGRAM ('DTSCU825') DTSCS48
|
|
01912 COMMAREA (L825-COMM-AREA) DTSCS48
|
|
01913 END-EXEC. DTSCS48
|
|
01914 DTSCS48
|
|
01915 IF L825-FILE-CLOSED-88 DTSCS48
|
|
01916 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
01917 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48
|
|
01918 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48
|
|
01919 GO TO MAINLINE-EXIT. DTSCS48
|
|
01920 S825-EXIT. DTSCS48
|
|
01921 EXIT. DTSCS48
|
|
01922 SKIP3 DTSCS48
|
|
01923 S851-SCREEN-PROCESSING. DTSCS48
|
|
01924 EXEC CICS LINK DTSCS48
|
|
01925 PROGRAM ('DTSCU851') DTSCS48
|
|
01926 COMMAREA (L851-COMM-AREA) DTSCS48
|
|
01927 END-EXEC. DTSCS48
|
|
01928 S851-EXIT. DTSCS48
|
|
01929 EXIT. DTSCS48
|
|
01930 DTSCS48
|
|
01931 S899-ABEND. DTSCS48
|
|
01932 EXEC CICS ABEND DTSCS48
|
|
01933 ABCODE(WRK-ABEND-CD) DTSCS48
|
|
01934 END-EXEC. DTSCS48
|
|
01935 S899-EXIT. DTSCS48
|
|
01936 EXIT. DTSCS48
|
|
01937 /**************************************************************** DTSCS48
|
|
01938 * EDIT THE INFORMATION ON THE SCREEN. DTSCS48
|
|
01939 ***************************************************************** DTSCS48
|
|
01940 DTSCS48
|
|
01941 S1000-SCREEN-EDITS. DTSCS48
|
|
01942 DTSCS48
|
|
01943 IF LCCM-F09-88 DTSCS48
|
|
01944 PERFORM S1130-CHK-MCMP THRU S1130-EXIT DTSCS48
|
|
01945 IF LCCM-MSG DTSCS48
|
|
01946 GO TO S1000-EXIT DTSCS48
|
|
01947 ELSE DTSCS48
|
|
01948 PERFORM S1200-STATUS-CD THRU S1200-EXIT DTSCS48
|
|
01949 PERFORM S1300-SETTLEMENT-DATE THRU S1300-EXIT DTSCS48
|
|
01950 PERFORM S1400-MAIL-ADDRESS THRU S1400-EXIT DTSCS48
|
|
01951 PERFORM S1500-COMP-DATE THRU S1500-EXIT DTSCS48
|
|
01952 PERFORM S2400-AUTHORIZE-OP-ID THRU S2400-EXIT DTSCS48
|
|
01953 PERFORM S2900-COVERED-YRQ THRU S2900-EXIT DTSCS48
|
|
01954 END-IF DTSCS48
|
|
01955 ELSE DTSCS48
|
|
01956 PERFORM S1120-READ-MCMP THRU S1120-EXIT DTSCS48
|
|
01957 IF WRK-MCMP-YES-88 DTSCS48
|
|
01958 PERFORM S1200-STATUS-CD THRU S1200-EXIT DTSCS48
|
|
01959 PERFORM S2400-AUTHORIZE-OP-ID DTSCS48
|
|
01960 THRU S2400-EXIT DTSCS48
|
|
01961 PERFORM S2500-INT-COMP-DATE THRU S2500-EXIT DTSCS48
|
|
01962 END-IF DTSCS48
|
|
01963 END-IF. DTSCS48
|
|
01964 DTSCS48
|
|
01965 IF LCCM-MSG DTSCS48
|
|
01966 GO TO S1000-EXIT. DTSCS48
|
|
01967 DTSCS48
|
|
01968 S1000-EXIT. EXIT. DTSCS48
|
|
01969 EJECT DTSCS48
|
|
01970 DTSCS48
|
|
01971 S1100-EDIT-KEY. DTSCS48
|
|
01972 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS48
|
|
01973 S1100-EXIT. EXIT. DTSCS48
|
|
01974 /**************************************************************** DTSCS48
|
|
01975 * DTSCS48
|
|
01976 ***************************************************************** DTSCS48
|
|
01977 S1101-EMP-NO. DTSCS48
|
|
01978 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS48
|
|
01979 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS48
|
|
01980 DTSCS48
|
|
01981 IF L018-NO-ENTRY DTSCS48
|
|
01982 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48
|
|
01983 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
01984 GO TO S1101-EXIT. DTSCS48
|
|
01985 DTSCS48
|
|
01986 IF L018-NOT-VALID DTSCS48
|
|
01987 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
01988 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
01989 GO TO S1101-EXIT. DTSCS48
|
|
01990 DTSCS48
|
|
01991 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS48
|
|
01992 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS48
|
|
01993 S1101-EXIT. EXIT. DTSCS48
|
|
01994 DTSCS48
|
|
01995 S1110-READ-MPRF. DTSCS48
|
|
01996 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS48
|
|
01997 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS48
|
|
01998 SET MPRF-PRF-88 TO TRUE. DTSCS48
|
|
01999 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS48
|
|
02000 PERFORM S810-READ THRU S810-EXIT. DTSCS48
|
|
02001 IF L810-NO-REC-88 DTSCS48
|
|
02002 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS48
|
|
02003 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
02004 ELSE DTSCS48
|
|
02005 MOVE MSKL-REC TO MPRF-REC DTSCS48
|
|
02006 SET WRK-MPRF-YES-88 TO TRUE. DTSCS48
|
|
02007 S1110-EXIT. DTSCS48
|
|
02008 EXIT. DTSCS48
|
|
02009 DTSCS48
|
|
02010 S1120-READ-MCMP. DTSCS48
|
|
02011 MOVE LCCM-SCR-HOLD-KEY TO MSKL-KEY-AREA. DTSCS48
|
|
02012 DTSCS48
|
|
02013 PERFORM S810-READ THRU S810-EXIT. DTSCS48
|
|
02014 DTSCS48
|
|
02015 IF L810-NO-REC-88 DTSCS48
|
|
02016 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
02017 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
02018 ELSE DTSCS48
|
|
02019 MOVE MSKL-REC TO MCMP-REC DTSCS48
|
|
02020 SET WRK-MCMP-YES-88 TO TRUE. DTSCS48
|
|
02021 S1120-EXIT. DTSCS48
|
|
02022 EXIT. DTSCS48
|
|
02023 DTSCS48
|
|
02024 S1130-CHK-MCMP. DTSCS48
|
|
02025 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48
|
|
02026 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48
|
|
02027 SET MSKL-CMP-88 TO TRUE. DTSCS48
|
|
02028 DTSCS48
|
|
02029 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48
|
|
02030 DTSCS48
|
|
02031 IF L810-NO-REC-88 DTSCS48
|
|
02032 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48
|
|
02033 ELSE DTSCS48
|
|
02034 PERFORM DTSCS48
|
|
02035 UNTIL L810-NO-REC-88 DTSCS48
|
|
02036 OR WRK-MCMP-YES-88 DTSCS48
|
|
02037 MOVE MSKL-REC TO MCMP-REC DTSCS48
|
|
02038 IF MCMP-STATUS-PENDING-88 DTSCS48
|
|
02039 SET WRK-MCMP-YES-88 TO TRUE DTSCS48
|
|
02040 ELSE DTSCS48
|
|
02041 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS48
|
|
02042 END-IF DTSCS48
|
|
02043 END-PERFORM DTSCS48
|
|
02044 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48
|
|
02045 IF WRK-MCMP-YES-88 DTSCS48
|
|
02046 MOVE MSG-E487-AREA TO WRK-MSG-AREA DTSCS48
|
|
02047 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48
|
|
02048 END-IF DTSCS48
|
|
02049 END-IF. DTSCS48
|
|
02050 DTSCS48
|
|
02051 S1130-EXIT. DTSCS48
|
|
02052 EXIT. DTSCS48
|
|
02053 DTSCS48
|
|
02054 S1199-ERROR. DTSCS48
|
|
02055 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS48
|
|
02056 MAP-EMP-NO-2-A. DTSCS48
|
|
02057 IF LCCM-NO-MSG DTSCS48
|
|
02058 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02059 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS48
|
|
02060 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02061 S1199-EXIT. EXIT. DTSCS48
|
|
02062 DTSCS48
|
|
02063 /**************************************************************** DTSCS48
|
|
02064 * DTSCS48
|
|
02065 ***************************************************************** DTSCS48
|
|
02066 S1200-STATUS-CD. DTSCS48
|
|
02067 IF LCCM-F09-88 DTSCS48
|
|
02068 SET MCMP-STATUS-PENDING-88 TO TRUE DTSCS48
|
|
02069 MOVE MCMP-STATUS-CD TO MAP-STATUS-CD DTSCS48
|
|
02070 GO TO S1200-EXIT DTSCS48
|
|
02071 ELSE DTSCS48
|
|
02072 MOVE MAP-STATUS-CD TO L034-CD DTSCS48
|
|
02073 PERFORM S034-MCMP-STATUS-CD THRU S034-EXIT DTSCS48
|
|
02074 IF NOT L034-VALID DTSCS48
|
|
02075 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02076 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS48
|
|
02077 GO TO S1200-EXIT DTSCS48
|
|
02078 ELSE DTSCS48
|
|
02079 PERFORM S1220-MOD THRU S1220-EXIT DTSCS48
|
|
02080 END-IF DTSCS48
|
|
02081 END-IF. DTSCS48
|
|
02082 DTSCS48
|
|
02083 S1200-EXIT. EXIT. DTSCS48
|
|
02084 DTSCS48
|
|
02085 S1201-ERROR. DTSCS48
|
|
02086 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-CD-A. DTSCS48
|
|
02087 IF LCCM-NO-MSG DTSCS48
|
|
02088 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02089 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS48
|
|
02090 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02091 S1201-EXIT. EXIT. DTSCS48
|
|
02092 DTSCS48
|
|
02093 DTSCS48
|
|
02094 S1220-MOD. DTSCS48
|
|
02095 IF MAP-STATUS-CD = MCMP-STATUS-CD DTSCS48
|
|
02096 GO TO S1220-EXIT. DTSCS48
|
|
02097 DTSCS48
|
|
02098 IF MCMP-STATUS-CD = 'P' OR 'F' DTSCS48
|
|
02099 IF MAP-STATUS-CD = 'W' DTSCS48
|
|
02100 GO TO S1220-EXIT DTSCS48
|
|
02101 ELSE DTSCS48
|
|
02102 MOVE MSG-E483-AREA TO WRK-MSG-AREA DTSCS48
|
|
02103 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS48
|
|
02104 GO TO S1220-EXIT DTSCS48
|
|
02105 END-IF DTSCS48
|
|
02106 END-IF. DTSCS48
|
|
02107 DTSCS48
|
|
02108 IF MAP-STATUS-CD = 'W' DTSCS48
|
|
02109 MOVE MSG-E486-AREA TO WRK-MSG-AREA DTSCS48
|
|
02110 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS48
|
|
02111 GO TO S1220-EXIT. DTSCS48
|
|
02112 DTSCS48
|
|
02113 S1220-EXIT. DTSCS48
|
|
02114 EXIT. DTSCS48
|
|
02115 DTSCS48
|
|
02116 /**************************************************************** DTSCS48
|
|
02117 * DTSCS48
|
|
02118 ***************************************************************** DTSCS48
|
|
02119 S1300-SETTLEMENT-DATE. DTSCS48
|
|
02120 MOVE MAP-SETTLEMENT-DATE-AREA TO L015-S-DATE-AREA. DTSCS48
|
|
02121 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48
|
|
02122 DTSCS48
|
|
02123 IF L015-NO-ENTRY DTSCS48
|
|
02124 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS48
|
|
02125 MOVE WRK-DISPLAY-MO TO MAP-SETTLEMENT-MO DTSCS48
|
|
02126 MOVE WRK-DISPLAY-DA TO MAP-SETTLEMENT-DA DTSCS48
|
|
02127 MOVE WRK-DISPLAY-YR TO MAP-SETTLEMENT-YR DTSCS48
|
|
02128 ELSE DTSCS48
|
|
02129 IF L015-NOT-VALID DTSCS48
|
|
02130 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02131 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS48
|
|
02132 S1300-EXIT. DTSCS48
|
|
02133 EXIT. DTSCS48
|
|
02134 DTSCS48
|
|
02135 S1301-ERROR. DTSCS48
|
|
02136 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS48
|
|
02137 TO MAP-SETTLEMENT-MO-A DTSCS48
|
|
02138 MAP-SETTLEMENT-DA-A DTSCS48
|
|
02139 MAP-SETTLEMENT-YR-A. DTSCS48
|
|
02140 IF LCCM-NO-MSG DTSCS48
|
|
02141 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02142 MOVE CATB-CURSOR TO MAP-SETTLEMENT-MO-L DTSCS48
|
|
02143 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02144 S1301-EXIT. EXIT. DTSCS48
|
|
02145 DTSCS48
|
|
02146 /**************************************************************** DTSCS48
|
|
02147 * DTSCS48
|
|
02148 ***************************************************************** DTSCS48
|
|
02149 S1400-MAIL-ADDRESS. DTSCS48
|
|
02150 PERFORM S1410-ADDR-TYPE THRU S1410-EXIT. DTSCS48
|
|
02151 DTSCS48
|
|
02152 PERFORM S1420-MAIL-ID-NO THRU S1420-EXIT. DTSCS48
|
|
02153 S1400-EXIT. DTSCS48
|
|
02154 EXIT. DTSCS48
|
|
02155 /**************************************************************** DTSCS48
|
|
02156 * DTSCS48
|
|
02157 ***************************************************************** DTSCS48
|
|
02158 S1410-ADDR-TYPE. DTSCS48
|
|
02159 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS48
|
|
02160 SET MAP-ADDR-TAX-88 TO TRUE DTSCS48
|
|
02161 ELSE DTSCS48
|
|
02162 IF MAP-ADDR-VALID-88 DTSCS48
|
|
02163 NEXT SENTENCE DTSCS48
|
|
02164 ELSE DTSCS48
|
|
02165 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02166 PERFORM S1411-ERROR THRU S1411-EXIT. DTSCS48
|
|
02167 S1410-EXIT. EXIT. DTSCS48
|
|
02168 DTSCS48
|
|
02169 S1411-ERROR. DTSCS48
|
|
02170 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS48
|
|
02171 IF LCCM-NO-MSG DTSCS48
|
|
02172 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02173 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS48
|
|
02174 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02175 S1411-EXIT. EXIT. DTSCS48
|
|
02176 /**************************************************************** DTSCS48
|
|
02177 * DTSCS48
|
|
02178 ***************************************************************** DTSCS48
|
|
02179 S1420-MAIL-ID-NO. DTSCS48
|
|
02180 INSPECT MAP-ADDR-ID-NO DTSCS48
|
|
02181 CONVERTING LOW-VALUES TO SPACES. DTSCS48
|
|
02182 DTSCS48
|
|
02183 IF MAP-ADDR-TAD-88 DTSCS48
|
|
02184 PERFORM S1430-ADDR-TAD THRU S1430-EXIT DTSCS48
|
|
02185 GO TO S1420-EXIT. DTSCS48
|
|
02186 DTSCS48
|
|
02187 IF MAP-ADDR-ID-NO = SPACES DTSCS48
|
|
02188 IF MAP-ADDR-NONE-88 DTSCS48
|
|
02189 PERFORM S1440-REQUIRE-ADDRESS THRU S1440-EXIT DTSCS48
|
|
02190 GO TO S1420-EXIT DTSCS48
|
|
02191 ELSE DTSCS48
|
|
02192 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48
|
|
02193 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02194 GO TO S1420-EXIT. DTSCS48
|
|
02195 DTSCS48
|
|
02196 IF MAP-ADDR-NONE-88 DTSCS48
|
|
02197 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS48
|
|
02198 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02199 GO TO S1420-EXIT. DTSCS48
|
|
02200 DTSCS48
|
|
02201 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS48
|
|
02202 MOVE +1 TO L013-MIN-CNT DTSCS48
|
|
02203 MOVE +999 TO L013-MAX-CNT. DTSCS48
|
|
02204 DTSCS48
|
|
02205 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS48
|
|
02206 DTSCS48
|
|
02207 IF L013-VALID DTSCS48
|
|
02208 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS48
|
|
02209 IF MAP-ADDR-TAA-OPO-88 DTSCS48
|
|
02210 PERFORM S1450-ADDR-TAA-OPO THRU S1450-EXIT DTSCS48
|
|
02211 ELSE DTSCS48
|
|
02212 NEXT SENTENCE DTSCS48
|
|
02213 ELSE DTSCS48
|
|
02214 IF L013-NO-ENTRY DTSCS48
|
|
02215 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48
|
|
02216 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02217 ELSE DTSCS48
|
|
02218 IF L013-INVALID-NEGATIVE DTSCS48
|
|
02219 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS48
|
|
02220 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02221 ELSE DTSCS48
|
|
02222 IF L013-EXCEEDS-MIN-MAX DTSCS48
|
|
02223 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS48
|
|
02224 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02225 ELSE DTSCS48
|
|
02226 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02227 PERFORM S1421-ERROR THRU S1421-EXIT. DTSCS48
|
|
02228 S1420-EXIT. EXIT. DTSCS48
|
|
02229 DTSCS48
|
|
02230 S1421-ERROR. DTSCS48
|
|
02231 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A DTSCS48
|
|
02232 IF LCCM-NO-MSG DTSCS48
|
|
02233 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02234 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS48
|
|
02235 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02236 S1421-EXIT. EXIT. DTSCS48
|
|
02237 DTSCS48
|
|
02238 S1430-ADDR-TAD. DTSCS48
|
|
02239 IF MAP-ADDR-ID-NO NOT = SPACES DTSCS48
|
|
02240 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS48
|
|
02241 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02242 GO TO S1430-EXIT. DTSCS48
|
|
02243 DTSCS48
|
|
02244 DTSCS48
|
|
02245 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS48
|
|
02246 IF MAP-ADDR-TAX-88 DTSCS48
|
|
02247 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS48
|
|
02248 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS48
|
|
02249 ELSE DTSCS48
|
|
02250 IF MAP-ADDR-PHY-88 DTSCS48
|
|
02251 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS48
|
|
02252 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS48
|
|
02253 ELSE DTSCS48
|
|
02254 GO TO S899-ABEND. DTSCS48
|
|
02255 DTSCS48
|
|
02256 DTSCS48
|
|
02257 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS48
|
|
02258 DTSCS48
|
|
02259 IF L111-ADDR-NOT-FOUND-88 DTSCS48
|
|
02260 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS48
|
|
02261 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02262 GO TO S1430-EXIT. DTSCS48
|
|
02263 DTSCS48
|
|
02264 PERFORM S1460-FORMAT THRU S1460-EXIT. DTSCS48
|
|
02265 DTSCS48
|
|
02266 S1430-EXIT. DTSCS48
|
|
02267 EXIT. DTSCS48
|
|
02268 S1440-REQUIRE-ADDRESS. DTSCS48
|
|
02269 INSPECT MAP-MAILING-LINE-1 DTSCS48
|
|
02270 CONVERTING LOW-VALUES TO SPACES. DTSCS48
|
|
02271 INSPECT MAP-MAILING-LINE-2 DTSCS48
|
|
02272 CONVERTING LOW-VALUES TO SPACES. DTSCS48
|
|
02273 INSPECT MAP-MAILING-LINE-3 DTSCS48
|
|
02274 CONVERTING LOW-VALUES TO SPACES. DTSCS48
|
|
02275 INSPECT MAP-MAILING-LINE-4 DTSCS48
|
|
02276 CONVERTING LOW-VALUES TO SPACES. DTSCS48
|
|
02277 INSPECT MAP-MAILING-LINE-5 DTSCS48
|
|
02278 CONVERTING LOW-VALUES TO SPACES. DTSCS48
|
|
02279 DTSCS48
|
|
02280 IF (MAP-MAILING-LINE-1 = SPACES) DTSCS48
|
|
02281 AND DTSCS48
|
|
02282 (MAP-MAILING-LINE-2 = SPACES) DTSCS48
|
|
02283 AND DTSCS48
|
|
02284 (MAP-MAILING-LINE-3 = SPACES) DTSCS48
|
|
02285 AND DTSCS48
|
|
02286 (MAP-MAILING-LINE-4 = SPACES) DTSCS48
|
|
02287 AND DTSCS48
|
|
02288 (MAP-MAILING-LINE-5 = SPACES) DTSCS48
|
|
02289 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48
|
|
02290 PERFORM S1441-ERROR THRU S1441-EXIT. DTSCS48
|
|
02291 S1440-EXIT. DTSCS48
|
|
02292 EXIT. DTSCS48
|
|
02293 DTSCS48
|
|
02294 S1441-ERROR. DTSCS48
|
|
02295 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS48
|
|
02296 TO MAP-MAILING-LINE-1-A. DTSCS48
|
|
02297 IF LCCM-NO-MSG DTSCS48
|
|
02298 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02299 MOVE CATB-CURSOR TO MAP-MAILING-LINE-1-L DTSCS48
|
|
02300 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02301 S1441-EXIT. EXIT. DTSCS48
|
|
02302 DTSCS48
|
|
02303 /**************************************************************** DTSCS48
|
|
02304 * DTSCS48
|
|
02305 ***************************************************************** DTSCS48
|
|
02306 S1450-ADDR-TAA-OPO. DTSCS48
|
|
02307 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS48
|
|
02308 IF MAP-ADDR-TAX-ALT-88 DTSCS48
|
|
02309 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS48
|
|
02310 ELSE DTSCS48
|
|
02311 IF MAP-ADDR-OPO-88 DTSCS48
|
|
02312 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS48
|
|
02313 ELSE DTSCS48
|
|
02314 GO TO S899-ABEND. DTSCS48
|
|
02315 DTSCS48
|
|
02316 IF L013-CNT = 0 DTSCS48
|
|
02317 MOVE 1 TO L111-ID-NO DTSCS48
|
|
02318 ELSE DTSCS48
|
|
02319 MOVE L013-CNT TO L111-ID-NO. DTSCS48
|
|
02320 DTSCS48
|
|
02321 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS48
|
|
02322 DTSCS48
|
|
02323 IF L111-ADDR-NOT-FOUND-88 DTSCS48
|
|
02324 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS48
|
|
02325 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48
|
|
02326 GO TO S1450-EXIT. DTSCS48
|
|
02327 DTSCS48
|
|
02328 PERFORM S1460-FORMAT THRU S1460-EXIT. DTSCS48
|
|
02329 DTSCS48
|
|
02330 S1450-EXIT. DTSCS48
|
|
02331 EXIT. DTSCS48
|
|
02332 /**************************************************************** DTSCS48
|
|
02333 * DTSCS48
|
|
02334 ***************************************************************** DTSCS48
|
|
02335 S1460-FORMAT. DTSCS48
|
|
02336 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS48
|
|
02337 DTSCS48
|
|
02338 MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1. DTSCS48
|
|
02339 MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2. DTSCS48
|
|
02340 MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3. DTSCS48
|
|
02341 MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4. DTSCS48
|
|
02342 MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5. DTSCS48
|
|
02343 S1460-EXIT. EXIT. DTSCS48
|
|
02344 DTSCS48
|
|
02345 S1500-COMP-DATE. DTSCS48
|
|
02346 IF MAP-STATUS-PENDING-88 DTSCS48
|
|
02347 NEXT SENTENCE DTSCS48
|
|
02348 ELSE DTSCS48
|
|
02349 GO TO S1500-EXIT DTSCS48
|
|
02350 END-IF. DTSCS48
|
|
02351 DTSCS48
|
|
02352 MOVE MAP-INT-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS48
|
|
02353 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48
|
|
02354 DTSCS48
|
|
02355 IF L015-NO-ENTRY DTSCS48
|
|
02356 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS48
|
|
02357 MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO DTSCS48
|
|
02358 MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA DTSCS48
|
|
02359 MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR DTSCS48
|
|
02360 ELSE DTSCS48
|
|
02361 IF L015-NOT-VALID DTSCS48
|
|
02362 IF MAP-INT-COMP-MO = '99' DTSCS48
|
|
02363 AND MAP-INT-COMP-DA = '99' DTSCS48
|
|
02364 AND MAP-INT-COMP-YR = '99' DTSCS48
|
|
02365 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS48
|
|
02366 ELSE DTSCS48
|
|
02367 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02368 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS48
|
|
02369 END-IF DTSCS48
|
|
02370 ELSE DTSCS48
|
|
02371 MOVE L015-DATE TO LCCM-COMP-DATE DTSCS48
|
|
02372 END-IF DTSCS48
|
|
02373 END-IF. DTSCS48
|
|
02374 DTSCS48
|
|
02375 S1500-EXIT. DTSCS48
|
|
02376 EXIT. DTSCS48
|
|
02377 DTSCS48
|
|
02378 S1501-ERROR. DTSCS48
|
|
02379 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS48
|
|
02380 TO MAP-INT-COMP-MO-A DTSCS48
|
|
02381 MAP-INT-COMP-DA-A DTSCS48
|
|
02382 MAP-INT-COMP-YR-A. DTSCS48
|
|
02383 IF LCCM-NO-MSG DTSCS48
|
|
02384 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02385 MOVE CATB-CURSOR TO MAP-INT-COMP-MO-L DTSCS48
|
|
02386 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02387 S1501-EXIT. DTSCS48
|
|
02388 EXIT. DTSCS48
|
|
02389 DTSCS48
|
|
02390 /**************************************************************** DTSCS48
|
|
02391 * DTSCS48
|
|
02392 ***************************************************************** DTSCS48
|
|
02393 S2400-AUTHORIZE-OP-ID. DTSCS48
|
|
02394 IF MAP-AUTHORIZE-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS48
|
|
02395 MOVE LCCM-RESP-OP-ID TO MAP-AUTHORIZE-OP-ID. DTSCS48
|
|
02396 DTSCS48
|
|
02397 IF MAP-AUTHORIZE-OP-ID = LCCM-OP-ID DTSCS48
|
|
02398 NEXT SENTENCE DTSCS48
|
|
02399 ELSE DTSCS48
|
|
02400 MOVE MAP-AUTHORIZE-OP-ID TO L082-OP-ID DTSCS48
|
|
02401 PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS48
|
|
02402 IF (L082-NOT-VALID-OP) OR (L082-INTERNAL-88) DTSCS48
|
|
02403 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02404 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS48
|
|
02405 GO TO S2400-EXIT. DTSCS48
|
|
02406 DTSCS48
|
|
02407 S2400-EXIT. EXIT. DTSCS48
|
|
02408 DTSCS48
|
|
02409 S2401-ERROR. DTSCS48
|
|
02410 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUTHORIZE-OP-ID-A. DTSCS48
|
|
02411 IF LCCM-NO-MSG DTSCS48
|
|
02412 SET CURSOR-SET-YES TO TRUE DTSCS48
|
|
02413 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02414 MOVE CATB-CURSOR TO MAP-AUTHORIZE-OP-ID-L. DTSCS48
|
|
02415 S2401-EXIT. EXIT. DTSCS48
|
|
02416 DTSCS48
|
|
02417 S2500-INT-COMP-DATE. DTSCS48
|
|
02418 MOVE MCMP-INT-COMP-DATE TO WRK-DISPLAY DTSCS48
|
|
02419 LCCM-COMP-DATE. DTSCS48
|
|
02420 MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO. DTSCS48
|
|
02421 MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA. DTSCS48
|
|
02422 MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR. DTSCS48
|
|
02423 DTSCS48
|
|
02424 S2500-EXIT. DTSCS48
|
|
02425 EXIT. DTSCS48
|
|
02426 DTSCS48
|
|
02427 /**************************************************************** DTSCS48
|
|
02428 * DTSCS48
|
|
02429 ***************************************************************** DTSCS48
|
|
02430 S2900-COVERED-YRQ. DTSCS48
|
|
02431 DTSCS48
|
|
02432 MOVE +0 TO WRK-TAX-WAIVED-AMT DTSCS48
|
|
02433 WRK-PEN-WAIVED-AMT DTSCS48
|
|
02434 WRK-INT-WAIVED-AMT. DTSCS48
|
|
02435 DTSCS48
|
|
02436 MOVE +0 TO WRK-NO-ENTRY-CTR. DTSCS48
|
|
02437 DTSCS48
|
|
02438 PERFORM S2910-YRQ-LOOP THRU S2910-EXIT DTSCS48
|
|
02439 VARYING WRK-SUB FROM 1 BY 1 DTSCS48
|
|
02440 UNTIL WRK-SUB > MMAX-CMP-COV-MAX. DTSCS48
|
|
02441 DTSCS48
|
|
02442 IF WRK-NO-ENTRY-CTR NOT < MMAX-CMP-COV-MAX DTSCS48
|
|
02443 MOVE MSG-E484-AREA TO WRK-MSG-AREA DTSCS48
|
|
02444 MOVE +1 TO WRK-SUB DTSCS48
|
|
02445 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48
|
|
02446 GO TO S2900-EXIT. DTSCS48
|
|
02447 DTSCS48
|
|
02448 IF LCCM-MSG DTSCS48
|
|
02449 MOVE LOW-VALUES TO MAP-TAX-WAIVED-AMT DTSCS48
|
|
02450 MAP-PEN-WAIVED-AMT DTSCS48
|
|
02451 MAP-INT-WAIVED-AMT DTSCS48
|
|
02452 GO TO S2900-EXIT DTSCS48
|
|
02453 ELSE DTSCS48
|
|
02454 MOVE WRK-TAX-WAIVED-AMT TO MAP-TAX-WAIVED-AMT-Z DTSCS48
|
|
02455 MOVE WRK-PEN-WAIVED-AMT TO MAP-PEN-WAIVED-AMT-Z DTSCS48
|
|
02456 MOVE WRK-INT-WAIVED-AMT TO MAP-INT-WAIVED-AMT-Z DTSCS48
|
|
02457 END-IF. DTSCS48
|
|
02458 DTSCS48
|
|
02459 S2900-EXIT. DTSCS48
|
|
02460 EXIT. DTSCS48
|
|
02461 EJECT DTSCS48
|
|
02462 * CHECK TO SEE WHAT WAS ENTERED ON THE SCREEN DTSCS48
|
|
02463 S2910-YRQ-LOOP. DTSCS48
|
|
02464 MOVE LOW-VALUE TO MAP-WAIVED-AMT (WRK-SUB) DTSCS48
|
|
02465 MAP-BALANCE-AMT (WRK-SUB). DTSCS48
|
|
02466 DTSCS48
|
|
02467 MOVE +0 TO MCMP-COVERED-YRQ (WRK-SUB). DTSCS48
|
|
02468 DTSCS48
|
|
02469 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS48
|
|
02470 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS48
|
|
02471 IF L029-NOT-VALID DTSCS48
|
|
02472 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48
|
|
02473 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48
|
|
02474 ELSE DTSCS48
|
|
02475 IF L029-NO-ENTRY DTSCS48
|
|
02476 PERFORM S2920-NO-ENTRY THRU S2920-EXIT DTSCS48
|
|
02477 ELSE DTSCS48
|
|
02478 PERFORM S2930-YRQ-ENTERED THRU S2930-EXIT. DTSCS48
|
|
02479 S2910-EXIT. DTSCS48
|
|
02480 EXIT. DTSCS48
|
|
02481 DTSCS48
|
|
02482 S2920-NO-ENTRY. DTSCS48
|
|
02483 ADD +1 TO WRK-NO-ENTRY-CTR. DTSCS48
|
|
02484 S2920-EXIT. DTSCS48
|
|
02485 EXIT. DTSCS48
|
|
02486 DTSCS48
|
|
02487 S2930-YRQ-ENTERED. DTSCS48
|
|
02488 MOVE L029-YRQ TO MCMP-COVERED-YRQ (WRK-SUB). DTSCS48
|
|
02489 * QTRS MUST BE ASCENDING SEQ DTSCS48
|
|
02490 IF WRK-SUB > +1 DTSCS48
|
|
02491 COMPUTE WRK-SUB-MINUS-ONE = WRK-SUB - 1 DTSCS48
|
|
02492 IF (MCMP-COVERED-YRQ (WRK-SUB-MINUS-ONE) = +0) DTSCS48
|
|
02493 OR DTSCS48
|
|
02494 (MCMP-COVERED-YRQ (WRK-SUB) DTSCS48
|
|
02495 NOT > MCMP-COVERED-YRQ (WRK-SUB-MINUS-ONE)) DTSCS48
|
|
02496 MOVE MSG-E481-AREA TO WRK-MSG-AREA DTSCS48
|
|
02497 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48
|
|
02498 GO TO S2930-EXIT. DTSCS48
|
|
02499 DTSCS48
|
|
02500 DTSCS48
|
|
02501 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS48
|
|
02502 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSCS48
|
|
02503 SET MQTR-QTR-88 TO TRUE. DTSCS48
|
|
02504 MOVE MCMP-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS48
|
|
02505 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS48
|
|
02506 DTSCS48
|
|
02507 PERFORM S810-READ THRU S810-EXIT. DTSCS48
|
|
02508 DTSCS48
|
|
02509 IF L810-NO-REC-88 DTSCS48
|
|
02510 IF MAP-STATUS-CD = 'F' OR 'P' DTSCS48
|
|
02511 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48
|
|
02512 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48
|
|
02513 GO TO S2930-EXIT DTSCS48
|
|
02514 ELSE DTSCS48
|
|
02515 GO TO S2930-EXIT. DTSCS48
|
|
02516 DTSCS48
|
|
02517 MOVE MSKL-REC TO MQTR-REC. DTSCS48
|
|
02518 DTSCS48
|
|
02519 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48
|
|
02520 WRK-YRQ-TAX-BAL-AMT DTSCS48
|
|
02521 WRK-YRQ-WAIVED-AMT DTSCS48
|
|
02522 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS48
|
|
02523 DTSCS48
|
|
02524 PERFORM S4000-AMOUNTS THRU S4000-EXIT. DTSCS48
|
|
02525 DTSCS48
|
|
02526 IF (WRK-YRQ-TAX-BAL-AMT = +0) DTSCS48
|
|
02527 AND DTSCS48
|
|
02528 (MAP-STATUS-CD = 'F' OR 'P') DTSCS48
|
|
02529 MOVE MSG-E482-AREA TO WRK-MSG-AREA DTSCS48
|
|
02530 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48
|
|
02531 GO TO S2930-EXIT. DTSCS48
|
|
02532 DTSCS48
|
|
02533 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS48
|
|
02534 MOVE ' WRITE OFF' TO MAP-WAIVED-AMT (WRK-SUB) DTSCS48
|
|
02535 ELSE DTSCS48
|
|
02536 MOVE WRK-YRQ-WAIVED-AMT TO MAP-WAIVED-AMT-Z (WRK-SUB) DTSCS48
|
|
02537 MOVE WRK-YRQ-BALANCE-AMT TO MAP-BALANCE-AMT-Z (WRK-SUB). DTSCS48
|
|
02538 DTSCS48
|
|
02539 DTSCS48
|
|
02540 S2930-EXIT. DTSCS48
|
|
02541 EXIT. DTSCS48
|
|
02542 DTSCS48
|
|
02543 S2999-ERROR. DTSCS48
|
|
02544 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS48
|
|
02545 TO MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS48
|
|
02546 MAP-COVERED-YRQ-Q-A(WRK-SUB) DTSCS48
|
|
02547 IF LCCM-NO-MSG DTSCS48
|
|
02548 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48
|
|
02549 MOVE CATB-CURSOR TO MAP-COVERED-YRQ-YR-L(WRK-SUB) DTSCS48
|
|
02550 SET CURSOR-SET-YES TO TRUE. DTSCS48
|
|
02551 S2999-EXIT. DTSCS48
|
|
02552 EXIT. DTSCS48
|
|
02553 /**************************************************************** DTSCS48
|
|
02554 * DTSCS48
|
|
02555 ***************************************************************** DTSCS48
|
|
02556 S4000-AMOUNTS. DTSCS48
|
|
02557 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48
|
|
02558 WRK-YRQ-TAX-BAL-AMT DTSCS48
|
|
02559 WRK-YRQ-WAIVED-AMT DTSCS48
|
|
02560 WRK-YRQ-WRITTEN-OFF-AMT DTSCS48
|
|
02561 L101-PAID-CHNG DTSCS48
|
|
02562 L101-INT-CHARGE-CHNG DTSCS48
|
|
02563 L101-INT-WAIVE-CHNG. DTSCS48
|
|
02564 DTSCS48
|
|
02565 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS48
|
|
02566 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS48
|
|
02567 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02568 TO WRK-YRQ-BALANCE-AMT DTSCS48
|
|
02569 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02570 TO WRK-YRQ-WRITTEN-OFF-AMT DTSCS48
|
|
02571 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02572 TO WRK-YRQ-WAIVED-AMT DTSCS48
|
|
02573 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS48
|
|
02574 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS48
|
|
02575 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02576 TO WRK-YRQ-TAX-BAL-AMT DTSCS48
|
|
02577 L101-PAID-CHNG DTSCS48
|
|
02578 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02579 TO WRK-TAX-WAIVED-AMT DTSCS48
|
|
02580 ELSE DTSCS48
|
|
02581 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS48
|
|
02582 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS48
|
|
02583 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02584 TO WRK-YRQ-TAX-BAL-AMT DTSCS48
|
|
02585 L101-PAID-CHNG DTSCS48
|
|
02586 ELSE DTSCS48
|
|
02587 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSCS48
|
|
02588 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02589 TO WRK-PEN-WAIVED-AMT DTSCS48
|
|
02590 ELSE DTSCS48
|
|
02591 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS48
|
|
02592 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48
|
|
02593 TO WRK-INT-WAIVED-AMT DTSCS48
|
|
02594 END-IF DTSCS48
|
|
02595 END-IF DTSCS48
|
|
02596 END-IF DTSCS48
|
|
02597 END-IF DTSCS48
|
|
02598 END-PERFORM. DTSCS48
|
|
02599 DTSCS48
|
|
02600 PERFORM S4010-INTEREST THRU S4010-EXIT. DTSCS48
|
|
02601 DTSCS48
|
|
02602 ADD L101-INT-CHARGE-CHNG TO WRK-YRQ-BALANCE-AMT. DTSCS48
|
|
02603 DTSCS48
|
|
02604 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-YRQ-BALANCE-AMT. DTSCS48
|
|
02605 DTSCS48
|
|
02606 S4000-EXIT. DTSCS48
|
|
02607 EXIT. DTSCS48
|
|
02608 DTSCS48
|
|
02609 S4010-INTEREST. DTSCS48
|
|
02610 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS48
|
|
02611 GO TO S4010-EXIT DTSCS48
|
|
02612 END-IF. DTSCS48
|
|
02613 DTSCS48
|
|
02614 IF L101-PAID-CHNG > +0 DTSCS48
|
|
02615 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE DTSCS48
|
|
02616 SET L101-WAIVE-INT-NO-88 TO TRUE DTSCS48
|
|
02617 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSCS48
|
|
02618 MOVE MQTR-INT-AREA TO L101-INT-AREA DTSCS48
|
|
02619 DTSCS48
|
|
02620 PERFORM S101-PER-MONTH-YES THRU S101-EXIT DTSCS48
|
|
02621 ELSE DTSCS48
|
|
02622 MOVE ZERO TO L101-INT-CHARGE-CHNG DTSCS48
|
|
02623 L101-INT-WAIVE-CHNG DTSCS48
|
|
02624 END-IF. DTSCS48
|
|
02625 DTSCS48
|
|
02626 S4010-EXIT. DTSCS48
|
|
02627 EXIT. DTSCS48
|
|
02628 /**************************************************************** DTSCS48
|
|
02629 * LOCK SCREEN FOR UPDATE CONFIRMATION DTSCS48
|
|
02630 ***************************************************************** DTSCS48
|
|
02631 S5100-SET-LOCK-ATTRB. DTSCS48
|
|
02632 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS48
|
|
02633 WRK-ATB-NUM. DTSCS48
|
|
02634 DTSCS48
|
|
02635 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS48
|
|
02636 DTSCS48
|
|
02637 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS48
|
|
02638 MAP-EMP-NO-2-A DTSCS48
|
|
02639 MAP-GOTO-A. DTSCS48
|
|
02640 S5100-EXIT. DTSCS48
|
|
02641 EXIT. DTSCS48
|
|
02642 DTSCS48
|
|
02643 ***************************************************************** DTSCS48
|
|
02644 * SET ATTIBUTE BYTES FOR UPDATE ACCESS DTSCS48
|
|
02645 ***************************************************************** DTSCS48
|
|
02646 S5200-SET-UPDATE-ATTRB. DTSCS48
|
|
02647 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS48
|
|
02648 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS48
|
|
02649 DTSCS48
|
|
02650 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS48
|
|
02651 DTSCS48
|
|
02652 DTSCS48
|
|
02653 S5200-EXIT. DTSCS48
|
|
02654 EXIT. DTSCS48
|
|
02655 DTSCS48
|
|
02656 ***************************************************************** DTSCS48
|
|
02657 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS DTSCS48
|
|
02658 ***************************************************************** DTSCS48
|
|
02659 S5300-SET-INQ-ATTRB. DTSCS48
|
|
02660 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS48
|
|
02661 WRK-ATB-NUM. DTSCS48
|
|
02662 DTSCS48
|
|
02663 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS48
|
|
02664 S5300-EXIT. DTSCS48
|
|
02665 EXIT. DTSCS48
|
|
02666 DTSCS48
|
|
02667 S5900-SET-ATTRB. DTSCS48
|
|
02668 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS48
|
|
02669 MAP-EMP-NO-2-A. DTSCS48
|
|
02670 DTSCS48
|
|
02671 IF LCCM-SCR-CLEAR DTSCS48
|
|
02672 MOVE CATB-ASKIP-BRT-MDTON DTSCS48
|
|
02673 TO MAP-STATUS-CD-A DTSCS48
|
|
02674 MOVE WRK-ATB-AN DTSCS48
|
|
02675 TO MAP-ADDR-TYPE-A DTSCS48
|
|
02676 MAP-MAILING-LINE-1-A DTSCS48
|
|
02677 MAP-MAILING-LINE-2-A DTSCS48
|
|
02678 MAP-MAILING-LINE-3-A DTSCS48
|
|
02679 MAP-MAILING-LINE-4-A DTSCS48
|
|
02680 MAP-MAILING-LINE-5-A DTSCS48
|
|
02681 MAP-AUTHORIZE-OP-ID-A DTSCS48
|
|
02682 MOVE WRK-ATB-NUM DTSCS48
|
|
02683 TO MAP-ADDR-ID-NO-A DTSCS48
|
|
02684 MAP-SETTLEMENT-DA-A DTSCS48
|
|
02685 MAP-SETTLEMENT-MO-A DTSCS48
|
|
02686 MAP-SETTLEMENT-YR-A DTSCS48
|
|
02687 MAP-INT-COMP-DA-A DTSCS48
|
|
02688 MAP-INT-COMP-MO-A DTSCS48
|
|
02689 MAP-INT-COMP-YR-A DTSCS48
|
|
02690 DTSCS48
|
|
02691 PERFORM VARYING WRK-SUB FROM 1 BY 1 DTSCS48
|
|
02692 UNTIL WRK-SUB > MMAX-CMP-COV-MAX DTSCS48
|
|
02693 MOVE WRK-ATB-AN DTSCS48
|
|
02694 TO MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS48
|
|
02695 MAP-COVERED-YRQ-YR-A (WRK-SUB) DTSCS48
|
|
02696 MOVE CATB-ASKIP-BRT-MDTON DTSCS48
|
|
02697 TO MAP-WAIVED-AMT-A (WRK-SUB) DTSCS48
|
|
02698 MAP-BALANCE-AMT-A (WRK-SUB) DTSCS48
|
|
02699 END-PERFORM DTSCS48
|
|
02700 ELSE DTSCS48
|
|
02701 MOVE WRK-ATB-AN DTSCS48
|
|
02702 TO MAP-STATUS-CD-A DTSCS48
|
|
02703 MOVE CATB-ASKIP-BRT-MDTON DTSCS48
|
|
02704 TO MAP-ADDR-ID-NO-A DTSCS48
|
|
02705 MAP-SETTLEMENT-DA-A DTSCS48
|
|
02706 MAP-SETTLEMENT-MO-A DTSCS48
|
|
02707 MAP-SETTLEMENT-YR-A DTSCS48
|
|
02708 MAP-INT-COMP-DA-A DTSCS48
|
|
02709 MAP-INT-COMP-MO-A DTSCS48
|
|
02710 MAP-INT-COMP-YR-A DTSCS48
|
|
02711 MAP-ADDR-TYPE-A DTSCS48
|
|
02712 MAP-MAILING-LINE-1-A DTSCS48
|
|
02713 MAP-MAILING-LINE-2-A DTSCS48
|
|
02714 MAP-MAILING-LINE-3-A DTSCS48
|
|
02715 MAP-MAILING-LINE-4-A DTSCS48
|
|
02716 MAP-MAILING-LINE-5-A DTSCS48
|
|
02717 MAP-AUTHORIZE-OP-ID-A DTSCS48
|
|
02718 DTSCS48
|
|
02719 PERFORM VARYING WRK-SUB FROM 1 BY 1 DTSCS48
|
|
02720 UNTIL WRK-SUB > MMAX-CMP-COV-MAX DTSCS48
|
|
02721 MOVE CATB-ASKIP-BRT-MDTON DTSCS48
|
|
02722 TO MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS48
|
|
02723 MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS48
|
|
02724 MAP-WAIVED-AMT-A(WRK-SUB) DTSCS48
|
|
02725 MAP-BALANCE-AMT-A(WRK-SUB) DTSCS48
|
|
02726 END-PERFORM DTSCS48
|
|
02727 END-IF. DTSCS48
|
|
02728 DTSCS48
|
|
02729 DTSCS48
|
|
02730 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS48
|
|
02731 MAP-TAX-WAIVED-AMT-A DTSCS48
|
|
02732 MAP-PEN-WAIVED-AMT-A DTSCS48
|
|
02733 MAP-INT-WAIVED-AMT-A DTSCS48
|
|
02734 MAP-TOT-BALANCE-AMT-A DTSCS48
|
|
02735 MAP-CURR-PAGE-A DTSCS48
|
|
02736 MAP-LAST-PAGE-A. DTSCS48
|
|
02737 DTSCS48
|
|
02738 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS48
|
|
02739 S5900-EXIT. DTSCS48
|
|
02740 EXIT. DTSCS48
|
|
02741 EJECT DTSCS48
|
|
02742 /**************************************************************** DTSCS48
|
|
02743 * MAP ROUTINES DTSCS48
|
|
02744 ***************************************************************** DTSCS48
|
|
02745 S9100-RECEIVE. DTSCS48
|
|
02746 SET L851-RECEIVE-88 TO TRUE. DTSCS48
|
|
02747 DTSCS48
|
|
02748 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS48
|
|
02749 DTSCS48
|
|
02750 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS48
|
|
02751 DTSCS48
|
|
02752 MOVE L851-AID TO LCCM-AID. DTSCS48
|
|
02753 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS48
|
|
02754 S9100-EXIT. DTSCS48
|
|
02755 EXIT. DTSCS48
|
|
02756 DTSCS48
|
|
02757 S9200-SEND-DATAONLY. DTSCS48
|
|
02758 MOVE LOW-VALUES TO MAP-AREA. DTSCS48
|
|
02759 DTSCS48
|
|
02760 IF LCCM-NO-MSG DTSCS48
|
|
02761 NEXT SENTENCE DTSCS48
|
|
02762 ELSE DTSCS48
|
|
02763 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS48
|
|
02764 DTSCS48
|
|
02765 IF CURSOR-SET-GOTO DTSCS48
|
|
02766 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS48
|
|
02767 ELSE DTSCS48
|
|
02768 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS48
|
|
02769 DTSCS48
|
|
02770 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS48
|
|
02771 DTSCS48
|
|
02772 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS48
|
|
02773 DTSCS48
|
|
02774 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS48
|
|
02775 S9200-EXIT. DTSCS48
|
|
02776 EXIT. DTSCS48
|
|
02777 DTSCS48
|
|
02778 S9300-SEND-MAP. DTSCS48
|
|
02779 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS48
|
|
02780 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS48
|
|
02781 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS48
|
|
02782 DTSCS48
|
|
02783 IF SCR-ACCESS-UPDATE DTSCS48
|
|
02784 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS48
|
|
02785 ELSE DTSCS48
|
|
02786 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS48
|
|
02787 DTSCS48
|
|
02788 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS48
|
|
02789 DTSCS48
|
|
02790 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS48
|
|
02791 DTSCS48
|
|
02792 IF CURSOR-SET-NO DTSCS48
|
|
02793 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS48
|
|
02794 DTSCS48
|
|
02795 SET L851-SEND-88 TO TRUE. DTSCS48
|
|
02796 DTSCS48
|
|
02797 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS48
|
|
02798 DTSCS48
|
|
02799 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS48
|
|
02800 S9300-EXIT. DTSCS48
|
|
02801 EXIT. DTSCS48
|
|
02802 DTSCS48
|
|
02803 S9310-UPDATE-FKEYS. DTSCS48
|
|
02804 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS48
|
|
02805 DTSCS48
|
|
02806 DTSCS48
|
|
02807 IF LCCM-SCR-CLEAR DTSCS48
|
|
02808 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS48
|
|
02809 ELSE DTSCS48
|
|
02810 IF LCCM-SCR-INQUIRE DTSCS48
|
|
02811 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS48
|
|
02812 ELSE DTSCS48
|
|
02813 IF LCCM-SCR-UPDATE-LOCKED DTSCS48
|
|
02814 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS48
|
|
02815 MAP-KEY-LAST DTSCS48
|
|
02816 MAP-KEY-BACK DTSCS48
|
|
02817 MAP-KEY-FWRD. DTSCS48
|
|
02818 S9310-EXIT. DTSCS48
|
|
02819 EXIT. DTSCS48
|
|
02820 DTSCS48
|
|
02821 S9320-INQUIRY-FKEYS. DTSCS48
|
|
02822 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS48
|
|
02823 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS48
|
|
02824 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS48
|
|
02825 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS48
|
|
02826 DTSCS48
|
|
02827 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS48
|
|
02828 MAP-KEY-MOD DTSCS48
|
|
02829 MAP-KEY-DEL. DTSCS48
|
|
02830 DTSCS48
|
|
02831 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS48
|
|
02832 S9320-EXIT. DTSCS48
|
|
02833 EXIT. DTSCS48
|
|
02834 DTSCS48
|
|
02835 *S9321-JUMP-KEYS. DTSCS48
|
|
02836 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS48
|
|
02837 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS48
|
|
02838 *S9321-EXIT. DTSCS48
|
|
02839 * EXIT. DTSCS48
|
|
02840 * DTSCS48
|
|
02841 S9330-DSCR-FIELDS. DTSCS48
|
|
02842 IF WRK-MPRF-YES-88 DTSCS48
|
|
02843 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS48
|
|
02844 END-IF. DTSCS48
|
|
02845 DTSCS48
|
|
02846 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS48
|
|
02847 MOVE LOW-VALUES TO MAP-STATUS-CD-DSCR DTSCS48
|
|
02848 ELSE DTSCS48
|
|
02849 MOVE MAP-STATUS-CD TO L034-CD DTSCS48
|
|
02850 PERFORM S034-MCMP-STATUS-CD THRU S034-EXIT DTSCS48
|
|
02851 MOVE L034-SHORT-DSCR TO MAP-STATUS-CD-DSCR. DTSCS48
|
|
02852 DTSCS48
|
|
02853 * IF MAP-AUTHORIZE-OP-ID = LCCM-OP-ID DTSCS48
|
|
02854 * MOVE LCCM-OP-NAME TO MAP-AUTHORIZE-OP-ID-DSCR DTSCS48
|
|
02855 * ELSE DTSCS48
|
|
02856 * IF MAP-AUTHORIZE-OP-ID = L082-NAME DTSCS48
|
|
02857 * MOVE L082-NAME TO MAP-AUTHORIZE-OP-ID-DSCR DTSCS48
|
|
02858 * ELSE DTSCS48
|
|
02859 * MOVE MAP-AUTHORIZE-OP-ID TO L082-OP-ID DTSCS48
|
|
02860 * PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS48
|
|
02861 * MOVE L082-NAME TO MAP-AUTHORIZE-OP-ID-DSCR. DTSCS48
|
|
02862 DTSCS48
|
|
02863 S9330-EXIT. EXIT. DTSCS48
|
|
02864 DTSCS48
|
|
02865 S9900-PREPARE-SEND. DTSCS48
|
|
02866 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS48
|
|
02867 LCCM-SCR-ID. DTSCS48
|
|
02868 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS48
|
|
02869 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS48
|
|
02870 S9900-EXIT. DTSCS48
|
|
02871 EXIT. DTSCS48
|