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