00001 IDENTIFICATION DIVISION. 05/19/08 00002 PROGRAM-ID. DTSCS68. DTSCS68 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV012 00004 DATE-WRITTEN. MAY 1994. DTSCS68 00005 DATE-COMPILED. DTSCS68 00006 SKIP3 DTSCS68 00007 ***** DTSCS68 00008 * DTSCS68 00009 * FUNCTION: DELINQUENT ACCOUNTS BY ZIP CODE SEARCH DTSCS68 00010 * SCREEN PROCESSOR. DTSCS68 00011 * DTSCS68 00012 * DTSCS68 00013 * MODIFICATION LOG: DTSCS68 00014 * DTSCS68 00015 * 04/20/1999 INITIAL DEVELOPMENT COPIED FROM MACCS68 DTSCS68 00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCS68 00017 * DTSCS68 00018 * 12/14/1998 LIMIT NUMBER OF ALT. INDEX RECORDS READ TO PREVENT DTSCS68 00019 * THE TRANSACTION FROM TIMING OUT. PROMPT USER TO DTSCS68 00020 * CONTINUE AFTER SEARCH LIMIT IS REACHED. DTSCS68 00021 * WORK ORDER: TECHSUP PROGRAMMER: KDN DTSCS68 00022 * DTSCS68 00023 * 12/31/1998 MODIFIED TO ACCOMODATE CHANGES TO MACIL101. DTSCS68 00024 * REFERENCE: LAW MOD 5.3 PROGRAMMER: EHH DTSCS68 00025 * DTSCS68 00026 * 04/25/2007 MODIFIED CODE TO EXCLUDE SUR TAX FROM INTEREST DTSCS68 00027 * CALC. DTSCS68 00028 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS68 00029 * DTSCS68 00030 * 08/15/2007 MODIFIED CODE TO DISPAY EMPLOYERS WITH MISSING REPODTSCS68 00031 * AND A BALANCE DUE. DTSCS68 00032 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS68 00033 * DTSCS68 00034 * DTSCS68 00035 * 02/12/2008 MODIFIED CODE TO INCLUDE SUR TAX FROM INTEREST DTSCS68 00036 * CALC. DTSCS68 00037 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS68 00038 * DTSCS68 00039 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS68 00040 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS68 00041 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS68 00042 * DTSCS68 00043 * DTSCS68 00044 * DTSCS68 00045 * DESCRIPTION: DTSCS68 00046 * DTSCS68 00047 * DTSCS68 00048 * CLEAR: DTSCS68 00049 * DTSCS68 00050 * FIELD DISPLAYED: NONE. UNPROTECT MAP-SRCH-ZIP. DTSCS68 00051 * DTSCS68 00052 * DTSCS68 00053 * JUMP: DTSCS68 00054 * DTSCS68 00055 * F17 REGISTRATION INQUIRY (11). DTSCS68 00056 * F19 QUARTER INQUIRY (31). DTSCS68 00057 * F20 COLLECTIONS INQUIRY (41). DTSCS68 00058 * DTSCS68 00059 * DTSCS68 00060 * INQUIRY: DTSCS68 00061 * DTSCS68 00062 * CONTROL FIELDS: MAP-SRCH-ZIP, MAP-SRCH-FIELD-REP-ID, DTSCS68 00063 * MAP-SRCH-*-IND. DTSCS68 00064 * DTSCS68 00065 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR68-HOLD-AREA EMP-NO DTSCS68 00066 * START A SEARCH AT THE IZIP RECORD WHOSE DTSCS68 00067 * KEY IS LCCM-SCR68-HOLD-AREA DTSCS68 00068 * ELSE DTSCS68 00069 * CLEAR. DTSCS68 00070 * DTSCS68 00071 * ENTER: IF A SEARCH IS NOT IN PROGRESS, THEN START A SEARCHDTSCS68 00072 * USING MAP-SRCH-ZIP AS THE STARTING POINT. DTSCS68 00073 * DTSCS68 00074 * IF A SEARCH IS IN PROGRESS, THEN REDISPLAY THE DTSCS68 00075 * SAME STUFF. DTSCS68 00076 * DTSCS68 00077 * F07, F08: DO NOT BOTHER TO 'WRAP' PAGING. BREAK SEARCH DTSCS68 00078 * AT BREAK IN IZIP-REC-TYPE. DTSCS68 00079 * DTSCS68 00080 * JUMP OUT: IF A LINE NO IS BEING SELECTED: DTSCS68 00081 * UPDATE LCCM-EMP-NO DTSCS68 00082 * STORE KEY OF THE IZIP RECORD SELECTED IN DTSCS68 00083 * LCCM-SCR68-HOLD-AREA. DTSCS68 00084 * DTSCS68 00085 * STORE SEARCH CRITERIA IN LCCM-SCR68-HOLD-AREA. DTSCS68 00086 * USE THIS INFORMATION ON A JUMP IN TO HELP THE DTSCS68 00087 * USER OUT WITH SEARCH CRITERIA. DTSCS68 00088 * DTSCS68 00089 * DTSCS68 00090 * PROTECT MAP-SRCH-* DURING A SEARCH - DTSCS68 00091 * LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED. DTSCS68 00092 * THE USER MUST PRESS THE CLEAR KEY BEFORE STARTING A DTSCS68 00093 * NEW SEARCH (SUPPLYING A NEW SET OF SEARCH CRITERIA). DTSCS68 00094 * DTSCS68 00095 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCS68 00096 * LCCM-SCR-HOLD-AREA TO HOLD THE KEY'S OF THE FROM 1 TO 12 DTSCS68 00097 * IZIP RECORDS FROM WHICH THE 1 TO 12 LINES OF DISPLAY WERE DTSCS68 00098 * CONSTRUCTED. WHEN THE USER SELECTS A 'LINE NO', THIS DTSCS68 00099 * INFORMATION IS USED TO DETERMINE WHICH ASSIGNMENT DTSCS68 00100 * WAS SELECTED. DTSCS68 00101 * DTSCS68 00102 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCS68 00103 * LCCM-SCR-HOLD-AREA TO CONTROL PAGING. DTSCS68 00104 * DTSCS68 00105 * DTSCS68 00106 * UPDATE: DTSCS68 00107 * DTSCS68 00108 * NONE. DTSCS68 00109 * DTSCS68 00110 * DTSCS68 00111 * RECORDS READ: DTSCS68 00112 * DTSCS68 00113 * MASTER: DTSCS68 00114 * DTSCS68 00115 * MPRF DTSCS68 00116 * MTAD DTSCS68 00117 * MFAS DTSCS68 00118 * MQTR DTSCS68 00119 * DTSCS68 00120 * DTSCS68 00121 * ALTERNATE INDEX: DTSCS68 00122 * DTSCS68 00123 * IZIP DTSCS68 00124 * DTSCS68 00125 * DTSCS68 00126 * REFERENCE: DTSCS68 00127 * DTSCS68 00128 * NONE. DTSCS68 00129 * DTSCS68 00130 * DTSCS68 00131 * ACCOUNTING TRANSACTION COLLECTION: DTSCS68 00132 * DTSCS68 00133 * NONE. DTSCS68 00134 * DTSCS68 00135 * DTSCS68 00136 * RECORDS UPDATED: DTSCS68 00137 * DTSCS68 00138 * MASTER: DTSCS68 00139 * DTSCS68 00140 * NONE. DTSCS68 00141 * DTSCS68 00142 * DTSCS68 00143 * REFERENCE: DTSCS68 00144 * DTSCS68 00145 * NONE. DTSCS68 00146 * DTSCS68 00147 * DTSCS68 00148 * ACCOUNTING TRANSACTION COLLECTION: DTSCS68 00149 * DTSCS68 00150 * NONE. DTSCS68 00151 * DTSCS68 00152 * DTSCS68 00153 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS68 00154 * DTSCS68 00155 * NONE. DTSCS68 00156 * DTSCS68 00157 * DTSCS68 00158 * TEMPORARY STORAGE USAGE: DTSCS68 00159 * DTSCS68 00160 * NONE DTSCS68 00161 * DTSCS68 00162 * DTSCS68 00163 * MODULES LINKED TO: DTSCS68 00164 * DTSCS68 00165 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. DTSCS68 00166 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS68 00167 * DTSCU061 ZIP/FIELD REP ID LOOKUP. DTSCS68 00168 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS68 00169 * DTSCU101 INTEREST AND PENALTY CHARGE/ABATEMENT COMPUTATIONDTSCS68 00170 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS68 00171 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCS68 00172 * DTSCS68 00173 * DTSCS68 00174 * DTSCS68 00175 * NOTES TO JEFF: DTSCS68 00176 * DTSCS68 00177 * . OBVIOUSLY, THIS MODULE WILL BE SIMILAR TO THE OTHER DTSCS68 00178 * SEARCH MODULES YOU HAVE WRITTEN FOR MONTANA. DTSCS68 00179 * DTSCS68 00180 * DTSCS68 00181 * . THE SPECS CALL FOR AN ENTRY IN SELECT LINE NO AND DTSCS68 00182 * PRESSING THE ENTER KEY TO JUMP TO SCREEN 41. SCREEN DTSCS68 00183 * 41 IS NOT WRITTEN. FOR TEST PURPOSES, JUMP TO SCREEN DTSCS68 00184 * 11 IN THIS CIRCUMSTANCE. I WILL CHANGE LATER. DTSCS68 00185 * DTSCS68 00186 * DTSCS68 00187 * . IN MONTANA, THERE ARE SOME ADDITIONAL SELECTION CRITERIA. DTSCS68 00188 * DTSCS68 00189 * AN ENTRY IS "SEARCH FIELD REP" LIMITS THE SEARCH TO THOSE DTSCS68 00190 * EMPLOYERS BELONGING TO THE SPECIFIED FIELD REP. DTSCS68 00191 * DTSCS68 00192 * YOU CAN DETERMINE AN EMPLOYERS FIELD REP FROM THE DTSCS68 00193 * INFORMATION IN THE IZIP RECORD. DTSCS68 00194 * DTSCS68 00195 * MOVE IZIP-FLD-ZIP TO L061-FLD-ZIP. DTSCS68 00196 * MOVE IZIP-EMP-NO TO L061-EMP-NO. DTSCS68 00197 * CALL 'MACCU061' USING L061-COMM-AREA. DTSCS68 00198 * DTSCS68 00199 * BY USING THIS TECHNIQUE WE WILL BE ABLE TO DETERMINE DTSCS68 00200 * WHETHER OR NOT AN IZIP RECORD MEETS THE SELECTION DTSCS68 00201 * CRITERIA WITHOUT READING MPRF RECORDS - AN OBVIOUS DTSCS68 00202 * EFFICIENCY ADVANTAGE. DTSCS68 00203 * DTSCS68 00204 * THE LOGIC FOR FIELD ACTIVE?, SUSPEND?, AND BANKRUPT? DTSCS68 00205 * SELECTION CRITERIA SHOULD GO SOMETHING LIKE THIS: DTSCS68 00206 * JLB: AND IT DOES DTSCS68 00207 * IF IZIP-BANKRUPTCY-OPEN-88 DTSCS68 00208 * IF MAP-BANKRUPT = 'Y' DTSCS68 00209 * SELECT FOR DISPLAY DTSCS68 00210 * ELSE DTSCS68 00211 * EXCLUDE FROM DISPLAY DTSCS68 00212 * ELSE DTSCS68 00213 * IF IZIP-FLD-LIST-REMOVE-88 DTSCS68 00214 * IF MAP-FIELD-SUSPEND = 'Y' DTSCS68 00215 * SELECT FOR DISPLAY DTSCS68 00216 * ELSE DTSCS68 00217 * EXCLUDE FROM DISPLAY DTSCS68 00218 * ELSE DTSCS68 00219 * IF MAP-FIELD-ACTIVE = 'Y' DTSCS68 00220 * SELECT FOR DISPLAY DTSCS68 00221 * ELSE DTSCS68 00222 * EXCLUDE FROM DISPLAY. DTSCS68 00223 * DTSCS68 00224 * NOTE "FIELD ACTIVE?", "SUSPEND?", AND "BANKRUPT?" DTSCS68 00225 * DEFAULTS. AS WITH THE OTHER SCREENS, A VALUE OF 'N' DTSCS68 00226 * IN ALL THREE FIELDS IS AN ERROR. DTSCS68 00227 * JLB: AND IT IS DTSCS68 00228 * DTSCS68 00229 * . AS WITH THE OTHER MONTANA SEARCH SCREENS, PLEASE TRY DTSCS68 00230 * TO MAKE THE SELECTION CRITERIA "STICKY". IF THEY DTSCS68 00231 * HAVE SOME SELECTION CRITERIA SPECIFIED AND JUMP AWAY DTSCS68 00232 * FROM SCREEN 68, THEN REDISPLAY THE SELECTION CRITERIA DTSCS68 00233 * ON RETURN TO SCREEN 68. DTSCS68 00234 * DTSCS68 00235 * DTSCS68 00236 * . IN MONTANA, WE MUST PROJECT PENALTY AND INTEREST THRU DTSCS68 00237 * "COMP DATE". DISPLAY "COMP DATE" ON THE SCREEN FROM DTSCS68 00238 * LCCM-COMP-DATE. ACCEPT AN ENTRY OF ALL NINES IN COMP DTSCS68 00239 * DATE (AND STORE ALL NINES IN LCCM-COMP-DATE). ALL NINES DTSCS68 00240 * IN LCCM-COMP-DATE MEANS "DO NOT PROJECT PENALTY AND DTSCS68 00241 * INTEREST". IF INQUIRY IS REQUESTED AND A VALID VALUE DTSCS68 00242 * IS ENTERED IN "COMP DATE", THEN STORE THE VALUE ENTERED DTSCS68 00243 * IN MAP "COMP DATE" IN LCCM-COMP-DATE. DTSCS68 00244 * DTSCS68 00245 * DTSCS68 00246 * IN MONTANA, LOGIC FOR PROJECTING INTEREST AND PENALTY DTSCS68 00247 * IS UGLIER THAN WAS THE VERMONT INTEREST PROJECTION LOGIC. DTSCS68 00248 * DTSCS68 00249 * DTSCS68 00250 * LOGIC SHOULD LOOK SOMETHING LIKE THIS: DTSCS68 00251 * DTSCS68 00252 * MOVE MPRF-PURSUED-RPT-CNT TO MAP-PURSUED-RPT-CNT. DTSCS68 00253 * IF (MPRF-TOT-BALANCE-AMT = +0) DTSCS68 00254 * OR DTSCS68 00255 * (LCCM-COMP-DATE = ALL-NINES-DATE) DTSCS68 00256 * MOVE MPRF-TOT-BALANCE-AMT TO MAP-TOT-BALANCE-AMT DTSCS68 00257 * ELSE DTSCS68 00258 * MOVE +0 TO WRK-TOT-BALANCE-AMT DTSCS68 00259 * MOVE LOW-VALUES TO MQTR-KEY-AREA DTSCS68 00260 * MOVE WRK-EMP-NO TO MQTR-EMP-NO DTSCS68 00261 * SET MQTR-QTR-88 TO TRUE DTSCS68 00262 * MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCS68 00263 * PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS68 00264 * PERFORM P6910-MQTR-SCAN THRU P6910-EXIT DTSCS68 00265 * UNTIL L810-NO-REC-88 DTSCS68 00266 * MOVE WRK-TOT-BALANCE-AMT TO MAP-TOT-BALANCE-AMT. DTSCS68 00267 * DTSCS68 00268 * DTSCS68 00269 * P6910-MQTR-SCAN. DTSCS68 00270 * MOVE MSKL-REC TO MQTR-REC. DTSCS68 00271 * DTSCS68 00272 * MOVE +0 TO L101-PAID-CHNG DTSCS68 00273 * L101-PEN-CHARGED-AMT. DTSCS68 00274 * DTSCS68 00275 * PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS68 00276 * UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS68 00277 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS68 00278 * TO WRK-TOT-BALANCE-AMT DTSCS68 00279 * IF MQTR-ACCT-TAX-88 DTSCS68 00280 * ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS68 00281 * TO L101-PAID-CHNG DTSCS68 00282 * END-IF DTSCS68 00283 * IF MQTR-ACCT-PEN-88 DTSCS68 00284 * ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS68 00285 * TO L101-PEN-CHARGED-AMT DTSCS68 00286 * END-IF DTSCS68 00287 * END-PERFORM. DTSCS68 00288 * DTSCS68 00289 * IF L101-PAID-CHNG > +0 DTSCS68 00290 * MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE DTSCS68 00291 * SET L101-ABATE-INT-NO-88 TO TRUE DTSCS68 00292 * SET L101-ABATE-PEN-NO-88 TO TRUE DTSCS68 00293 * MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSCS68 00294 * MOVE MQTR-INT-PEN-AREA TO L101-INT-PEN-AREA DTSCS68 00295 * DTSCS68 00296 * PERFORM S101-PER-MONTH-NO THRU S101-EXIT DTSCS68 00297 * DTSCS68 00298 * ADD L101-INT-CHARGE-CHNG DTSCS68 00299 * TO WRK-TOT-BALANCE-AMT DTSCS68 00300 * SUBTRACT L101-INT-ABATE-CHNG DTSCS68 00301 * FROM WRK-TOT-BALANCE-AMT DTSCS68 00302 * ADD L101-PEN-CHARGE-CHNG DTSCS68 00303 * TO WRK-TOT-BALANCE-AMT DTSCS68 00304 * SUBTRACT L101-PEN-ABATE-CHNG DTSCS68 00305 * FROM WRK-TOT-BALANCE-AMT. DTSCS68 00306 * DTSCS68 00307 * PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS68 00308 * P6910-EXIT. DTSCS68 00309 * DTSCS68 00310 * DTSCS68 00311 * S101-PER-MONTH-NO. DTSCS68 00312 * SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS68 00313 * GO TO S101-INT-PEN-COMP. DTSCS68 00314 * DTSCS68 00315 * S101-INT-PEN-COMP. DTSCS68 00316 * EXEC CICS DTSCS68 00317 * LINK . . . .. . DTSCS68 00318 * S101-EXIT. DTSCS68 00319 * EXIT. DTSCS68 00320 * DTSCS68 00321 * DTSCS68 00322 * . THE LOGIC FOR DETERMINING WHAT TO DISPLAY IN "CITY" DTSCS68 00323 * AND "ST" MIGHT LOOK SOMETHING LIKE THIS: DTSCS68 00324 * DTSCS68 00325 * MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS68 00326 * MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS68 00327 * SET MSKL-TAD-88 TO TRUE. DTSCS68 00328 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS68 00329 * PERFORM P6920-SCAN-MTAD THRU P6920-EXIT DTSCS68 00330 * UNTIL L810-NO-REC-88. DTSCS68 00331 * DTSCS68 00332 * DTSCS68 00333 * P6920-SCAN-MTAD. DTSCS68 00334 * MOVE MSKL-REC TO MTAD-REC. DTSCS68 00335 * DTSCS68 00336 * IF MPRF-FLD-ZIP (1:5) = MTAD-ZIP (1:5) DTSCS68 00337 * MOVE MTAD-CITY TO MAP-CITY DTSCS68 00338 * MOVE MTAD-ZIP TO MAP-ZIP DTSCS68 00339 * PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS68 00340 * SET L810-NO-REC-88 TO TRUE DTSCS68 00341 * GO TO P6920-EXIT. DTSCS68 00342 * DTSCS68 00343 * PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS68 00344 * P6920-EXIT. DTSCS68 00345 * DTSCS68 00346 ***** DTSCS68 00347 DTSCS68 00348 ENVIRONMENT DIVISION. DTSCS68 00349 DTSCS68 00350 DATA DIVISION. DTSCS68 00351 DTSCS68 00352 WORKING-STORAGE SECTION. DTSCS68 003525 77 PAN-VALET PICTURE X(24) VALUE '012DTSCS68 05/19/08'. DTSCS68 00353 DTSCS68 00354 01 WRK-TS-AREA. DTSCS68 00355 05 WRK-TS-SCREEN-68-IND PIC X(02). DTSCS68 00356 88 WRK-TS-SCREEN-68-YES VALUE '68'. DTSCS68 00357 05 WRK-TS-KEY-AREA PIC X(796). DTSCS68 00358 05 FILLER REDEFINES WRK-TS-KEY-AREA. DTSCS68 00359 10 WRK-TS-KEY OCCURS 12 TIMES. DTSCS68 00360 15 FILLER PIC X(64). DTSCS68 00361 05 WRK-SCR-FIRST-ADDL PIC X(04). DTSCS68 00362 05 WRK-ADDL-CTR REDEFINES WRK-SCR-FIRST-ADDL PIC S9(04). DTSCS68 00363 DTSCS68 00364 01 WRK-AREA. DTSCS68 00365 05 WRK-ABEND-CD PIC X(04) VALUE 'S68 '. DTSCS68 00366 DTSCS68 00367 05 WRK-SCR-ID. DTSCS68 00368 10 WRK-SCR-ID-N PIC 9(02) VALUE 68. DTSCS68 00369 DTSCS68 00370 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS68 00371 DTSCS68 00372 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS68 00373 VALUE +999999999. DTSCS68 00374 DTSCS68 00375 05 SCR-ACCESS-IND PIC X(01). DTSCS68 00376 88 SCR-ACCESS-INQ VALUE '1'. DTSCS68 00377 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS68 00378 DTSCS68 00379 05 CURSOR-SET-IND PIC X(01). DTSCS68 00380 88 CURSOR-SET-YES VALUE 'Y'. DTSCS68 00381 88 CURSOR-SET-NO VALUE 'N'. DTSCS68 00382 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS68 00383 DTSCS68 00384 05 REQ-IND PIC X(01). DTSCS68 00385 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS68 00386 88 REQ-ERROR VALUE 'O'. DTSCS68 00387 88 REQ-JUMP VALUE 'J'. DTSCS68 00388 88 REQ-UPDATE VALUE 'U'. DTSCS68 00389 88 REQ-INQUIRE VALUE 'I'. DTSCS68 00390 88 REQ-CLEAR VALUE 'C'. DTSCS68 00391 88 REQ-EDIT VALUE 'E'. DTSCS68 00392 DTSCS68 00393 05 RESP-IND PIC X(01). DTSCS68 00394 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS68 00395 88 RESP-SEND-MAP VALUE 'M'. DTSCS68 00396 88 RESP-JUMP VALUE 'J'. DTSCS68 00397 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS68 00398 DTSCS68 00399 05 WRK-MSG-AREA PIC X(64). DTSCS68 00400 DTSCS68 00401 05 WRK-ATB-AN PIC X(01). DTSCS68 00402 05 WRK-ATB-NUM PIC X(01). DTSCS68 00403 DTSCS68 00404 05 WRK-TOT-BALANCE-AMT PIC S9(7)V99 COMP-3. DTSCS68 00405 DTSCS68 00406 05 INQUIRY-CONTROL-AREA. DTSCS68 00407 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS68 00408 10 WS-REC-NUM PIC S9(08) COMP. DTSCS68 00409 DTSCS68 00410 10 SCR-REC-KEY-AREA PIC X(96). DTSCS68 00411 10 WRK-SCR-KEY-AREA. DTSCS68 00412 15 WRK-SCR-ZIP-KEY PIC X(64). DTSCS68 00413 15 WRK-FLD-ZIP PIC X(05). DTSCS68 00414 15 WRK-FLD-REP-ID PIC X(02). DTSCS68 00415 88 WRK-FLD-REP-ID-NONE VALUE SPACES. DTSCS68 00416 15 WRK-ACTIVE-IND PIC X(01). DTSCS68 00417 15 WRK-SUSPEND-IND PIC X(01). DTSCS68 00418 15 WRK-BANKRUPT-IND PIC X(01). DTSCS68 00419 15 WRK-BLANK-SCREEN-IND PIC X(01). DTSCS68 00420 88 WRK-BLANK-SCREEN-88 VALUE 'Y'. DTSCS68 00421 DTSCS68 00422 05 WRK-TS-FOUND-IND PIC X(01). DTSCS68 00423 88 WRK-TS-FOUND-YES VALUE 'Y'. DTSCS68 00424 88 WRK-TS-FOUND-NO VALUE 'N'. DTSCS68 00425 DTSCS68 00426 05 WRK-CTR PIC S9(04) COMP. DTSCS68 00427 DTSCS68 00428 05 WRK-CTR2 PIC S9(04) COMP. DTSCS68 00429 DTSCS68 00430 05 WRK-SUB PIC S9(04) COMP. DTSCS68 00431 DTSCS68 00432 05 WRK-S821-RECS-READ PIC S9(05) COMP-3. DTSCS68 00433 DTSCS68 00434 05 WRK-S821-SEARCH-LIMIT PIC S9(05) COMP-3 VALUE +200.DTSCS68 00435 DTSCS68 00436 05 WRK-REALLY-WANT-IND PIC X(01). DTSCS68 00437 88 WRK-REALLY-WANT-IT VALUE 'Y'. DTSCS68 00438 88 WRK-REALLY-DO-NOT-WANT-IT VALUE 'N'. DTSCS68 00439 DTSCS68 00440 05 WRK-DISPLAY PIC 9(11). DTSCS68 00441 DTSCS68 00442 05 FILLER REDEFINES WRK-DISPLAY. DTSCS68 00443 10 FILLER PIC X(05). DTSCS68 00444 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS68 00445 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS68 00446 DTSCS68 00447 05 FILLER REDEFINES WRK-DISPLAY. DTSCS68 00448 10 FILLER PIC X(05). DTSCS68 00449 10 WRK-DISPLAY-DATE. DTSCS68 00450 15 WRK-DISPLAY-YR PIC X(02). DTSCS68 00451 15 WRK-DISPLAY-MO PIC X(02). DTSCS68 00452 15 WRK-DISPLAY-DA PIC X(02). DTSCS68 00453 DTSCS68 00454 01 MSG-LITERALS. DTSCS68 00455 05 MSG-E681-AREA. DTSCS68 00456 10 FILLER PIC X(04) VALUE 'E681'. DTSCS68 00457 10 FILLER PIC X(30) DTSCS68 00458 VALUE 'ENTRY OF (N)O IN ALL FIELDS RE'. DTSCS68 00459 10 FILLER PIC X(30) DTSCS68 00460 VALUE 'SULTS IN A NULL SEARCH. '. DTSCS68 00461 DTSCS68 00462 05 MSG-E682-AREA. DTSCS68 00463 10 FILLER PIC X(04) VALUE 'E682'. DTSCS68 00464 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS68 00465 10 MSG-E682-MSG PIC X(50) VALUE DTSCS68 00466 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS68 00467 DTSCS68 00468 05 MSG-P683-AREA. DTSCS68 00469 10 FILLER PIC X(04) VALUE 'P683'. DTSCS68 00470 10 FILLER PIC X(25) DTSCS68 00471 VALUE 'RECORDS SEARCHED TO ZIP: '. DTSCS68 00472 10 MSG-P683-ZIP PIC X(05). DTSCS68 00473 10 FILLER PIC X(09) DTSCS68 00474 VALUE ' - PRESS '. DTSCS68 00475 10 MSG-P683-PFKEY PIC X(02). DTSCS68 00476 10 FILLER PIC X(13) DTSCS68 00477 VALUE ' TO CONTINUE '. DTSCS68 00478 EJECT DTSCS68 00479 DTSCS68 00480 01 L001-COMM-AREA. DTSCS68 00481 ++INCLUDE DTSIL001 DTSCS68 00482 EJECT DTSCS68 00483 01 L013-COMM-AREA. DTSCS68 00484 ++INCLUDE DTSIL013 DTSCS68 00485 EJECT DTSCS68 00486 01 L015-COMM-AREA. DTSCS68 00487 ++INCLUDE DTSIL015 DTSCS68 00488 EJECT DTSCS68 00489 01 L061-COMM-AREA. DTSCS68 00490 ++INCLUDE DTSIL061 DTSCS68 00491 EJECT DTSCS68 00492 01 L062-COMM-AREA. DTSCS68 00493 ++INCLUDE DTSIL062 DTSCS68 00494 EJECT DTSCS68 00495 01 L101-COMM-AREA. DTSCS68 00496 ++INCLUDE DTSIL101 DTSCS68 00497 EJECT DTSCS68 00498 01 L109-COMM-AREA. DTSCS68 00499 ++INCLUDE DTSIL109 DTSCS68 00500 EJECT DTSCS68 00501 01 L805-COMM-AREA. DTSCS68 00502 ++INCLUDE DTSIL805 DTSCS68 00503 EJECT DTSCS68 00504 01 L810-COMM-AREA. DTSCS68 00505 05 L810-CONTROL-BLOCK. DTSCS68 00506 ++INCLUDE DTSIL810 DTSCS68 00507 EJECT DTSCS68 00508 05 MSKL-REC. DTSCS68 00509 ++INCLUDE DTSIMSKL DTSCS68 00510 EJECT DTSCS68 00511 01 MPRF-REC. DTSCS68 00512 ++INCLUDE DTSIMPRF DTSCS68 00513 EJECT DTSCS68 00514 01 MTAD-REC. DTSCS68 00515 ++INCLUDE DTSIMTAD DTSCS68 00516 EJECT DTSCS68 00517 01 MFAS-REC. DTSCS68 00518 ++INCLUDE DTSIMFAS DTSCS68 00519 EJECT DTSCS68 00520 01 MQTR-REC. DTSCS68 00521 ++INCLUDE DTSIMQTR DTSCS68 00522 EJECT DTSCS68 00523 01 L821-COMM-AREA. DTSCS68 00524 05 L821-CONTROL-BLOCK. DTSCS68 00525 ++INCLUDE DTSIL821 DTSCS68 00526 DTSCS68 00527 05 ISKL-REC. DTSCS68 00528 ++INCLUDE DTSIISKL DTSCS68 00529 05 FILLER REDEFINES ISKL-REC. DTSCS68 00530 ++INCLUDE DTSIIZIP DTSCS68 00531 DTSCS68 00532 01 L851-COMM-AREA. DTSCS68 00533 ++INCLUDE DTSIL851 DTSCS68 00534 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS68 00535 ++INCLUDE DTSIS68 DTSCS68 00536 EJECT DTSCS68 00537 01 CATB-LITERALS. DTSCS68 00538 ++INCLUDE DTSICATB DTSCS68 00539 DTSCS68 00540 01 CFKD-LITERALS. DTSCS68 00541 ++INCLUDE DTSICFKD DTSCS68 00542 DTSCS68 00543 01 CECD-LITERALS. DTSCS68 00544 ++INCLUDE DTSICECD DTSCS68 00545 DTSCS68 00546 01 CPCD-LITERALS. DTSCS68 00547 ++INCLUDE DTSICPCD DTSCS68 00548 EJECT DTSCS68 00549 LINKAGE SECTION. DTSCS68 00550 DTSCS68 00551 01 DFHCOMMAREA. DTSCS68 00552 ++INCLUDE DTSILCCM DTSCS68 00553 EJECT DTSCS68 00554 ******************************************************************DTSCS68 00555 * *DTSCS68 00556 ******************************************************************DTSCS68 00557 DTSCS68 00558 PROCEDURE DIVISION. DTSCS68 00559 DTSCS68 00560 MOVE LOW-VALUES TO MAP-AREA. DTSCS68 00561 SET CURSOR-SET-NO TO TRUE. DTSCS68 00562 DTSCS68 00563 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS68 00564 TO SCR-ACCESS-IND. DTSCS68 00565 DTSCS68 00566 MOVE +0 TO WRK-CTR DTSCS68 00567 WRK-CTR2 DTSCS68 00568 WRK-SUB DTSCS68 00569 WRK-S821-RECS-READ. DTSCS68 00570 DTSCS68 00571 *----------------------------------------------------- DTSCS68 00572 * DETERMINE IF THERE IS INFORMATION HELD FROM THE PREVIOUS DTSCS68 00573 * TASK AND SET THE APPROPRIATE INDICATORS/COUNTERS DTSCS68 00574 *----------------------------------------------------- DTSCS68 00575 MOVE LCCM-SCR-HOLD-AREA TO WRK-TS-AREA. DTSCS68 00576 MOVE LCCM-SCR68-HOLD-AREA TO WRK-SCR-KEY-AREA. DTSCS68 00577 DTSCS68 00578 IF WRK-TS-SCREEN-68-YES DTSCS68 00579 SET WRK-TS-FOUND-YES TO TRUE DTSCS68 00580 ELSE DTSCS68 00581 MOVE +0 TO WRK-ADDL-CTR DTSCS68 00582 SET WRK-TS-FOUND-NO TO TRUE. DTSCS68 00583 DTSCS68 00584 MOVE SPACE TO REQ-IND. DTSCS68 00585 DTSCS68 00586 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS68 00587 DTSCS68 00588 *----------------------------------------------------- DTSCS68 00589 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS68 00590 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS68 00591 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS68 00592 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS68 00593 * DTSCS68 00594 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS68 00595 * PROCESSED. DTSCS68 00596 * DTSCS68 00597 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS68 00598 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS68 00599 * WORK STATION OPERATOR. DTSCS68 00600 *----------------------------------------------------- DTSCS68 00601 DTSCS68 00602 MOVE SPACE TO RESP-IND. DTSCS68 00603 DTSCS68 00604 IF REQ-ERROR DTSCS68 00605 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS68 00606 ELSE DTSCS68 00607 IF REQ-JUMP DTSCS68 00608 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS68 00609 ELSE DTSCS68 00610 IF REQ-CLEAR DTSCS68 00611 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS68 00612 ELSE DTSCS68 00613 IF REQ-CURSOR-TO-GOTO DTSCS68 00614 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS68 00615 ELSE DTSCS68 00616 IF REQ-INQUIRE DTSCS68 00617 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS68 00618 ELSE DTSCS68 00619 GO TO S899-ABEND. DTSCS68 00620 DTSCS68 00621 *----------------------------------------------------- DTSCS68 00622 * SAVE THE SCREEN INFORMATION THAT HAS BEEN BUILT DTSCS68 00623 * FOR LATER IF THE USER RETURNS TO THIS SCREEN DTSCS68 00624 *----------------------------------------------------- DTSCS68 00625 MOVE WRK-SCR-KEY-AREA TO LCCM-SCR68-HOLD-AREA. DTSCS68 00626 DTSCS68 00627 *----------------------------------------------------- DTSCS68 00628 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS68 00629 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS68 00630 *----------------------------------------------------- DTSCS68 00631 IF RESP-SEND-MAP DTSCS68 00632 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS68 00633 SET LCCM-END-TASK-88 TO TRUE DTSCS68 00634 ELSE DTSCS68 00635 IF RESP-SEND-MSGONLY DTSCS68 00636 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS68 00637 SET LCCM-END-TASK-88 TO TRUE DTSCS68 00638 ELSE DTSCS68 00639 IF RESP-JUMP DTSCS68 00640 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS68 00641 ELSE DTSCS68 00642 IF RESP-CURSOR-TO-GOTO DTSCS68 00643 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS68 00644 SET LCCM-END-TASK-88 TO TRUE DTSCS68 00645 ELSE DTSCS68 00646 GO TO S899-ABEND. DTSCS68 00647 DTSCS68 00648 MAINLINE-EXIT. DTSCS68 00649 DTSCS68 00650 EXEC CICS DTSCS68 00651 RETURN DTSCS68 00652 END-EXEC. DTSCS68 00653 DTSCS68 00654 GOBACK. DTSCS68 00655 EJECT DTSCS68 00656 /*****************************************************************DTSCS68 00657 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS68 00658 ******************************************************************DTSCS68 00659 P1000-ANALYZE-REQUEST. DTSCS68 00660 *----------------------------------------------------- DTSCS68 00661 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS68 00662 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS68 00663 * REPLACED WITH ENTER) DTSCS68 00664 *----------------------------------------------------- DTSCS68 00665 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS68 00666 SET LCCM-ENTER-88 TO TRUE DTSCS68 00667 PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT DTSCS68 00668 SET REQ-INQUIRE TO TRUE DTSCS68 00669 GO TO P1000-EXIT. DTSCS68 00670 DTSCS68 00671 *----------------------------------------------------- DTSCS68 00672 * MAP IS RECEIVED DTSCS68 00673 *----------------------------------------------------- DTSCS68 00674 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS68 00675 DTSCS68 00676 *----------------------------------------------------- DTSCS68 00677 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS68 00678 * WORK STATION DTSCS68 00679 *----------------------------------------------------- DTSCS68 00680 IF LCCM-CLEAR-88 DTSCS68 00681 SET REQ-CLEAR TO TRUE DTSCS68 00682 GO TO P1000-EXIT. DTSCS68 00683 DTSCS68 00684 *----------------------------------------------------- DTSCS68 00685 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS68 00686 *----------------------------------------------------- DTSCS68 00687 IF LCCM-PA2-88 DTSCS68 00688 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS68 00689 GO TO P1000-EXIT. DTSCS68 00690 DTSCS68 00691 *----------------------------------------------------- DTSCS68 00692 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS68 00693 *----------------------------------------------------- DTSCS68 00694 IF LCCM-PA-88 DTSCS68 00695 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS68 00696 SET REQ-ERROR TO TRUE DTSCS68 00697 GO TO P1000-EXIT. DTSCS68 00698 DTSCS68 00699 *----------------------------------------------------- DTSCS68 00700 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS68 00701 * CLEAR SCREEN DTSCS68 00702 *----------------------------------------------------- DTSCS68 00703 IF LCCM-F12-88 DTSCS68 00704 MOVE LOW-VALUES TO MAP-AREA DTSCS68 00705 SET REQ-CLEAR TO TRUE DTSCS68 00706 GO TO P1000-EXIT. DTSCS68 00707 DTSCS68 00708 *----------------------------------------------------- DTSCS68 00709 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS68 00710 *----------------------------------------------------- DTSCS68 00711 IF LCCM-F03-88 DTSCS68 00712 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS68 00713 SET REQ-JUMP TO TRUE DTSCS68 00714 GO TO P1000-EXIT. DTSCS68 00715 DTSCS68 00716 *----------------------------------------------------- DTSCS68 00717 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS68 00718 *----------------------------------------------------- DTSCS68 00719 IF LCCM-F04-88 DTSCS68 00720 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS68 00721 SET REQ-JUMP TO TRUE DTSCS68 00722 GO TO P1000-EXIT. DTSCS68 00723 DTSCS68 00724 *--------------------------------------------------------- DTSCS68 00725 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS68 00726 * CORRESPONDENCE SCREEN. DTSCS68 00727 *--------------------------------------------------------- DTSCS68 00728 DTSCS68 00729 IF LCCM-F14-88 DTSCS68 00730 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS68 00731 SET REQ-JUMP TO TRUE DTSCS68 00732 GO TO P1000-EXIT. DTSCS68 00733 DTSCS68 00734 *----------------------------------------------------- DTSCS68 00735 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS68 00736 * REQUESTED SCREEN TYPE DTSCS68 00737 *----------------------------------------------------- DTSCS68 00738 * IF LCCM-F17-88 DTSCS68 00739 * OR LCCM-F19-88 DTSCS68 00740 * OR LCCM-F20-88 DTSCS68 00741 * SET REQ-JUMP TO TRUE DTSCS68 00742 * GO TO P1000-EXIT DTSCS68 00743 * ELSE DTSCS68 00744 IF (MAP-SELECT-SCREEN-ID = LOW-VALUES OR SPACES) DTSCS68 00745 AND (MAP-SELECT-LINE-NO = LOW-VALUES OR SPACES) DTSCS68 00746 NEXT SENTENCE DTSCS68 00747 ELSE DTSCS68 00748 SET REQ-JUMP TO TRUE DTSCS68 00749 GO TO P1000-EXIT. DTSCS68 00750 DTSCS68 00751 *----------------------------------------------------- DTSCS68 00752 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS68 00753 * REQUESTED SCREEN TYPE DTSCS68 00754 *----------------------------------------------------- DTSCS68 00755 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS68 00756 NEXT SENTENCE DTSCS68 00757 ELSE DTSCS68 00758 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS68 00759 SET REQ-JUMP TO TRUE DTSCS68 00760 GO TO P1000-EXIT. DTSCS68 00761 DTSCS68 00762 *----------------------------------------------------- DTSCS68 00763 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS68 00764 * OR F8), INDICATE INQUIRY REQUEST DTSCS68 00765 *----------------------------------------------------- DTSCS68 00766 IF LCCM-F07-88 DTSCS68 00767 OR LCCM-F08-88 DTSCS68 00768 OR LCCM-ENTER-88 DTSCS68 00769 SET REQ-INQUIRE TO TRUE DTSCS68 00770 GO TO P1000-EXIT. DTSCS68 00771 DTSCS68 00772 *----------------------------------------------------- DTSCS68 00773 * ANY OTHER KEY IS INVALID DTSCS68 00774 *----------------------------------------------------- DTSCS68 00775 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS68 00776 SET REQ-ERROR TO TRUE. DTSCS68 00777 P1000-EXIT. DTSCS68 00778 EXIT. DTSCS68 00779 DTSCS68 00780 ******************************************************************DTSCS68 00781 * DTSCS68 00782 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR68-HOLD-AREA DTSCS68 00783 * EMP-NO DTSCS68 00784 * START A SEARCH AT THE IZIP RECORD WHOSE DTSCS68 00785 * KEY IS IN LCCM-SCR68-HOLD-AREA DTSCS68 00786 * ELSE DTSCS68 00787 * CLEAR (BUT LEAVE THE REQUESTED KEY FIELDS) DTSCS68 00788 ******************************************************************DTSCS68 00789 DTSCS68 00790 P1200-CHECK-HOLD-AREA. DTSCS68 00791 MOVE +0 TO WRK-ADDL-CTR. DTSCS68 00792 DTSCS68 00793 MOVE WRK-SCR-ZIP-KEY TO IZIP-KEY-AREA. DTSCS68 00794 DTSCS68 00795 IF IZIP-ZIP-88 DTSCS68 00796 PERFORM P1201-REQUEST-FIELDS THRU P1201-EXIT DTSCS68 00797 IF IZIP-EMP-NO = LCCM-EMP-NO DTSCS68 00798 SET WRK-TS-FOUND-YES TO TRUE DTSCS68 00799 ELSE DTSCS68 00800 SET WRK-TS-FOUND-NO TO TRUE DTSCS68 00801 ELSE DTSCS68 00802 SET WRK-TS-FOUND-NO TO TRUE. DTSCS68 00803 DTSCS68 00804 DTSCS68 00805 IF WRK-TS-FOUND-YES DTSCS68 00806 SET WRK-TS-SCREEN-68-YES TO TRUE DTSCS68 00807 MOVE WRK-SCR-ZIP-KEY TO WRK-TS-KEY(1) DTSCS68 00808 MOVE +1 TO WRK-ADDL-CTR DTSCS68 00809 ELSE DTSCS68 00810 MOVE +0 TO WRK-ADDL-CTR DTSCS68 00811 END-IF. DTSCS68 00812 P1200-EXIT. DTSCS68 00813 EXIT. DTSCS68 00814 DTSCS68 00815 P1201-REQUEST-FIELDS. DTSCS68 00816 MOVE WRK-FLD-ZIP TO MAP-FLD-ZIP. DTSCS68 00817 MOVE WRK-ACTIVE-IND TO MAP-ACTIVE-IND. DTSCS68 00818 MOVE WRK-SUSPEND-IND TO MAP-SUSPEND-IND. DTSCS68 00819 MOVE WRK-BANKRUPT-IND TO MAP-BANKRUPT-IND. DTSCS68 00820 MOVE WRK-FLD-REP-ID TO MAP-FLD-REP-ID. DTSCS68 00821 DTSCS68 00822 IF LCCM-COMP-DATE > 0 DTSCS68 00823 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS68 00824 MOVE WRK-DISPLAY-MO TO MAP-COMP-DATE-MO DTSCS68 00825 MOVE WRK-DISPLAY-DA TO MAP-COMP-DATE-DA DTSCS68 00826 MOVE WRK-DISPLAY-YR TO MAP-COMP-DATE-YR DTSCS68 00827 END-IF. DTSCS68 00828 DTSCS68 00829 P1201-EXIT. DTSCS68 00830 EXIT. DTSCS68 00831 /*****************************************************************DTSCS68 00832 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS68 00833 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS68 00834 ******************************************************************DTSCS68 00835 DTSCS68 00836 P2000-REQUEST-ERROR. DTSCS68 00837 IF LCCM-MSG DTSCS68 00838 SET RESP-SEND-MSGONLY TO TRUE DTSCS68 00839 ELSE DTSCS68 00840 GO TO S899-ABEND. DTSCS68 00841 P2000-EXIT. DTSCS68 00842 EXIT. DTSCS68 00843 /*****************************************************************DTSCS68 00844 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS68 00845 ******************************************************************DTSCS68 00846 DTSCS68 00847 P3000-REQUEST-JUMP. DTSCS68 00848 PERFORM P3001-SELECTION-LINE-EDIT THRU P3001-EXIT. DTSCS68 00849 DTSCS68 00850 IF NOT LCCM-MSG DTSCS68 00851 PERFORM P3500-BUILD-TS-AREAS THRU P3500-EXIT. DTSCS68 00852 DTSCS68 00853 *----------------------------------------------------- DTSCS68 00854 * IF ERROR DETECTED AND DATA ON SCREEN THEN SAVE IT DTSCS68 00855 *----------------------------------------------------- DTSCS68 00856 DTSCS68 00857 IF LCCM-MSG DTSCS68 00858 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS68 00859 SET RESP-SEND-MAP TO TRUE DTSCS68 00860 GO TO P3000-EXIT. DTSCS68 00861 DTSCS68 00862 *----------------------------------------------------- DTSCS68 00863 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS68 00864 *----------------------------------------------------- DTSCS68 00865 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS68 00866 LCCM-SCR-HOLD-AREA. DTSCS68 00867 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS68 00868 SET RESP-JUMP TO TRUE. DTSCS68 00869 P3000-EXIT. DTSCS68 00870 EXIT. DTSCS68 00871 DTSCS68 00872 ******************************************************************DTSCS68 00873 * IF A JUMP-KEY WAS PRESSED OK DTSCS68 00874 * IF A SCREEN ID ENTERED (NOT GOTO) THEN LINE NUMBER REQUIRED DTSCS68 00875 * IF A LINE NUMBER WAS ENTERED IT MUST EXIST ON THE SCREEN DTSCS68 00876 ******************************************************************DTSCS68 00877 P3001-SELECTION-LINE-EDIT. DTSCS68 00878 IF MAP-SELECT-LINE-NO EQUAL LOW-VALUES OR SPACES DTSCS68 00879 IF MAP-SELECT-SCREEN-ID EQUAL LOW-VALUES OR SPACES DTSCS68 00880 NEXT SENTENCE DTSCS68 00881 ELSE DTSCS68 00882 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS68 00883 PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT DTSCS68 00884 ELSE DTSCS68 00885 IF WRK-BLANK-SCREEN-88 DTSCS68 00886 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 00887 PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT DTSCS68 00888 GO TO P3001-EXIT DTSCS68 00889 END-IF DTSCS68 00890 IF WRK-TS-FOUND-YES DTSCS68 00891 PERFORM P3002-SELECT-LINE-NO THRU P3002-EXIT DTSCS68 00892 IF (NOT MAP-SELECT-LINE-NO-VALID) DTSCS68 00893 OR (MAP-SELECT-LINE-NO-N > WRK-ADDL-CTR) DTSCS68 00894 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 00895 PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT. DTSCS68 00896 P3001-EXIT. DTSCS68 00897 EXIT. DTSCS68 00898 DTSCS68 00899 P3002-SELECT-LINE-NO. DTSCS68 00900 MOVE MAP-SELECT-LINE-NO-AREA TO L013-S-CNT-AREA. DTSCS68 00901 DTSCS68 00902 PERFORM S013-SELECT-LINE-NO THRU S013-EXIT. DTSCS68 00903 DTSCS68 00904 IF L013-VALID DTSCS68 00905 MOVE L013-CNT TO MAP-SELECT-LINE-NO-N. DTSCS68 00906 P3002-EXIT. DTSCS68 00907 EXIT. DTSCS68 00908 DTSCS68 00909 P3500-BUILD-TS-AREAS. DTSCS68 00910 IF WRK-TS-FOUND-YES DTSCS68 00911 IF MAP-SELECT-LINE-NO = LOW-VALUES OR SPACES DTSCS68 00912 NEXT SENTENCE DTSCS68 00913 ELSE DTSCS68 00914 MOVE WRK-TS-KEY(MAP-SELECT-LINE-NO-N) TO IZIP-KEY-AREA DTSCS68 00915 MOVE IZIP-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 00916 PERFORM P3501-FIND-EMP-NO THRU P3501-EXIT. DTSCS68 00917 DTSCS68 00918 PERFORM P3502-REQ-SCR-ID THRU P3502-EXIT. DTSCS68 00919 DTSCS68 00920 *----------------------------------------------------- DTSCS68 00921 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS68 00922 * BY USER DTSCS68 00923 *----------------------------------------------------- DTSCS68 00924 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS68 00925 *----------------------------------------------------- DTSCS68 00926 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS68 00927 *----------------------------------------------------- DTSCS68 00928 IF LCCM-MSG DTSCS68 00929 SET CURSOR-SET-YES TO TRUE DTSCS68 00930 IF MAP-GOTO EQUAL SPACES DTSCS68 00931 OR LOW-VALUES DTSCS68 00932 OR WRK-SCR-ID DTSCS68 00933 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS68 00934 TO MAP-SELECT-SCREEN-ID-A DTSCS68 00935 MOVE CATB-CURSOR TO MAP-SELECT-SCREEN-ID-L DTSCS68 00936 ELSE DTSCS68 00937 MOVE CATB-CURSOR TO MAP-GOTO-L. DTSCS68 00938 P3500-EXIT. EXIT. DTSCS68 00939 DTSCS68 00940 /*****************************************************************DTSCS68 00941 * EMPLOYER NUMBER IS AT A DIFFERENT DISPLACEMENT FOR EACH TYPE DTSCS68 00942 ******************************************************************DTSCS68 00943 P3501-FIND-EMP-NO. DTSCS68 00944 MOVE IZIP-EMP-NO TO LCCM-EMP-NO. DTSCS68 00945 P3501-EXIT. DTSCS68 00946 EXIT. DTSCS68 00947 DTSCS68 00948 /*****************************************************************DTSCS68 00949 * DETERMINE WHICH SCREEN WILL BE JUMPED TO BASED ON DTSCS68 00950 * FUNCTION KEY DTSCS68 00951 * SELECTED SCREEN DTSCS68 00952 * GOTO OPTION (OVERRIDES FUNCTION OR SELECTED) DTSCS68 00953 ******************************************************************DTSCS68 00954 P3502-REQ-SCR-ID. DTSCS68 00955 MOVE LOW-VALUES TO LCCM-REQ-SCR-ID. DTSCS68 00956 DTSCS68 00957 IF LCCM-F03-88 DTSCS68 00958 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS68 00959 ELSE DTSCS68 00960 IF LCCM-F04-88 DTSCS68 00961 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS68 00962 ELSE DTSCS68 00963 IF LCCM-F14-88 DTSCS68 00964 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS68 00965 * ELSE DTSCS68 00966 * IF LCCM-F17-88 DTSCS68 00967 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS68 00968 * ELSE DTSCS68 00969 * IF LCCM-F19-88 DTSCS68 00970 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS68 00971 * ELSE DTSCS68 00972 * IF LCCM-F20-88 DTSCS68 00973 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS68 00974 ELSE DTSCS68 00975 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS68 00976 IF MAP-SELECT-SCREEN-ID = LOW-VALUES OR SPACES DTSCS68 00977 IF MAP-SELECT-LINE-NO = LOW-VALUES OR SPACES DTSCS68 00978 NEXT SENTENCE DTSCS68 00979 ELSE DTSCS68 00980 IF WRK-TS-FOUND-YES DTSCS68 00981 MOVE '41' TO LCCM-REQ-SCR-ID DTSCS68 00982 ELSE DTSCS68 00983 NEXT SENTENCE DTSCS68 00984 ELSE DTSCS68 00985 MOVE MAP-SELECT-SCREEN-ID TO LCCM-REQ-SCR-ID DTSCS68 00986 ELSE DTSCS68 00987 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID. DTSCS68 00988 DTSCS68 00989 IF LCCM-REQ-SCR-ID = LOW-VALUES OR SPACES OR WRK-SCR-ID DTSCS68 00990 MOVE EMSG-INVALID-TRANS-ID TO WRK-MSG-AREA DTSCS68 00991 PERFORM S2001-SELECT-SCREEN-ERROR THRU S2001-EXIT. DTSCS68 00992 P3502-EXIT. DTSCS68 00993 EXIT. DTSCS68 00994 DTSCS68 00995 /*****************************************************************DTSCS68 00996 * CLEAR KEY WAS PRESSED *DTSCS68 00997 ******************************************************************DTSCS68 00998 DTSCS68 00999 P4000-REQUEST-CLEAR. DTSCS68 01000 DTSCS68 01001 PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT. DTSCS68 01002 DTSCS68 01003 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS68 01004 DTSCS68 01005 MOVE CATB-CURSOR TO MAP-FLD-ZIP-L. DTSCS68 01006 DTSCS68 01007 SET CURSOR-SET-YES TO TRUE. DTSCS68 01008 MOVE 'N' TO WRK-TS-FOUND-IND. DTSCS68 01009 *----------------------------------------------------- DTSCS68 01010 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS68 01011 * FIELDS FROM EARLIER REQUESTS DTSCS68 01012 *----------------------------------------------------- DTSCS68 01013 DTSCS68 01014 *****MOVE ZERO TO LCCM-EMP-NO. DTSCS68 01015 DTSCS68 01016 MOVE LOW-VALUES TO WRK-SCR-KEY-AREA DTSCS68 01017 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS68 01018 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS68 01019 DTSCS68 01020 SET LCCM-SCR-CLEAR TO TRUE. DTSCS68 01021 DTSCS68 01022 SET RESP-SEND-MAP TO TRUE. DTSCS68 01023 P4000-EXIT. DTSCS68 01024 EXIT. DTSCS68 01025 /*****************************************************************DTSCS68 01026 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS68 01027 ******************************************************************DTSCS68 01028 DTSCS68 01029 P5000-CURSOR-TO-GOTO. DTSCS68 01030 SET CURSOR-SET-GOTO TO TRUE. DTSCS68 01031 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS68 01032 P5000-EXIT. DTSCS68 01033 EXIT. DTSCS68 01034 /*****************************************************************DTSCS68 01035 * INQUIRY WAS REQUESTED *DTSCS68 01036 ******************************************************************DTSCS68 01037 DTSCS68 01038 P6000-REQUEST-INQUIRE. DTSCS68 01039 SET RESP-SEND-MAP TO TRUE. DTSCS68 01040 DTSCS68 01041 MOVE SPACES TO MAP-TABLE. DTSCS68 01042 DTSCS68 01043 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS68 01044 DTSCS68 01045 IF WRK-TS-FOUND-NO DTSCS68 01046 SET LCCM-ENTER-88 TO TRUE. DTSCS68 01047 DTSCS68 01048 IF LCCM-SCR-CLEAR DTSCS68 01049 OR WRK-ADDL-CTR = 0 DTSCS68 01050 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS68 01051 DTSCS68 01052 MOVE 'I' TO LCCM-SCR-STATUS. DTSCS68 01053 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS68 01054 IF LCCM-MSG DTSCS68 01055 GO TO P6000-EXIT. DTSCS68 01056 DTSCS68 01057 IF WRK-BLANK-SCREEN-88 DTSCS68 01058 MOVE WRK-SCR-ZIP-KEY TO IZIP-KEY-AREA DTSCS68 01059 IF LCCM-ENTER-88 DTSCS68 01060 SET LCCM-F08-88 TO TRUE DTSCS68 01061 END-IF DTSCS68 01062 ELSE DTSCS68 01063 IF LCCM-F08-88 DTSCS68 01064 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO IZIP-KEY-AREA DTSCS68 01065 ELSE DTSCS68 01066 MOVE WRK-TS-KEY(1) TO IZIP-KEY-AREA DTSCS68 01067 WRK-SCR-ZIP-KEY DTSCS68 01068 END-IF. DTSCS68 01069 DTSCS68 01070 MOVE IZIP-FLD-ZIP TO WRK-FLD-ZIP. DTSCS68 01071 DTSCS68 01072 MOVE +0 TO WRK-ADDL-CTR DTSCS68 01073 WRK-CTR. DTSCS68 01074 DTSCS68 01075 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS68 01076 IF L821-NO-REC-88 DTSCS68 01077 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID DTSCS68 01078 MOVE LOW-VALUES TO WRK-SCR-KEY-AREA. DTSCS68 01079 DTSCS68 01080 *-NOTE ----------------------------------------------- DTSCS68 01081 * AT THIS POINT EITHER THE KEY IS OK TO PROCESS OR IN ERROR DTSCS68 01082 *----------------------------------------------------- DTSCS68 01083 DTSCS68 01084 IF LCCM-MSG DTSCS68 01085 GO TO P6000-EXIT DTSCS68 01086 ELSE DTSCS68 01087 IF LCCM-ENTER-88 DTSCS68 01088 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS68 01089 ELSE DTSCS68 01090 IF LCCM-F07-88 DTSCS68 01091 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS68 01092 ELSE DTSCS68 01093 IF LCCM-F08-88 DTSCS68 01094 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS68 01095 ELSE DTSCS68 01096 GO TO S899-ABEND. DTSCS68 01097 DTSCS68 01098 IF L821-OK-88 DTSCS68 01099 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS68 01100 END-IF. DTSCS68 01101 DTSCS68 01102 IF WRK-CTR > 0 DTSCS68 01103 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L DTSCS68 01104 SET CURSOR-SET-YES TO TRUE DTSCS68 01105 SET WRK-TS-SCREEN-68-YES TO TRUE DTSCS68 01106 MOVE WRK-TS-AREA TO LCCM-SCR-HOLD-AREA DTSCS68 01107 SET WRK-TS-FOUND-YES TO TRUE DTSCS68 01108 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SELECT-SCREEN-ID-A DTSCS68 01109 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS68 01110 TO MAP-SELECT-LINE-NO-A DTSCS68 01111 ELSE DTSCS68 01112 IF WRK-BLANK-SCREEN-88 DTSCS68 01113 MOVE IZIP-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 01114 GO TO P6000-EXIT DTSCS68 01115 ELSE DTSCS68 01116 SET WRK-TS-FOUND-NO TO TRUE DTSCS68 01117 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS68 01118 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID. DTSCS68 01119 P6000-EXIT. DTSCS68 01120 EXIT. DTSCS68 01121 DTSCS68 01122 /*****************************************************************DTSCS68 01123 * ENTER KEY WAS PRESSED *DTSCS68 01124 ******************************************************************DTSCS68 01125 P6100-NO-PAGE. DTSCS68 01126 DTSCS68 01127 MOVE IZIP-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 01128 WRK-TS-KEY(1). DTSCS68 01129 DTSCS68 01130 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01131 VARYING WRK-SUB FROM 1 BY 1 DTSCS68 01132 UNTIL WRK-SUB > 12 DTSCS68 01133 OR L821-NO-REC-88. DTSCS68 01134 P6100-EXIT. DTSCS68 01135 EXIT. DTSCS68 01136 /*****************************************************************DTSCS68 01137 * //// *DTSCS68 01138 ******************************************************************DTSCS68 01139 P6200-PAGE-BACK. DTSCS68 01140 DTSCS68 01141 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCS68 01142 DTSCS68 01143 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCS68 01144 DTSCS68 01145 IF L821-NO-REC-88 DTSCS68 01146 IF NOT WRK-BLANK-SCREEN-88 DTSCS68 01147 MOVE WRK-TS-KEY(1) TO IZIP-KEY-AREA DTSCS68 01148 MOVE IZIP-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 01149 MOVE 1 TO WRK-SUB DTSCS68 01150 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS68 01151 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01152 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS68 01153 MOVE 2 TO WRK-SUB DTSCS68 01154 SET L821-NO-REC-88 TO TRUE DTSCS68 01155 END-IF DTSCS68 01156 ELSE DTSCS68 01157 MOVE IZIP-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 01158 MOVE IZIP-KEY-AREA TO WRK-TS-KEY(1) DTSCS68 01159 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01160 VARYING WRK-SUB FROM 1 BY 1 DTSCS68 01161 UNTIL WRK-SUB > 12 DTSCS68 01162 OR L821-NO-REC-88. DTSCS68 01163 DTSCS68 01164 IF L821-NO-REC-88 DTSCS68 01165 AND WRK-ADDL-CTR < 12 DTSCS68 01166 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS68 01167 IF WRK-ADDL-CTR = 0 DTSCS68 01168 IF WRK-BLANK-SCREEN-88 DTSCS68 01169 MOVE WRK-SCR-ZIP-KEY TO IZIP-KEY-AREA DTSCS68 01170 GO TO P6200-EXIT DTSCS68 01171 ELSE DTSCS68 01172 MOVE WRK-TS-KEY(1) TO IZIP-KEY-AREA DTSCS68 01173 END-IF DTSCS68 01174 ELSE DTSCS68 01175 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO IZIP-KEY-AREA DTSCS68 01176 END-IF DTSCS68 01177 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS68 01178 IF L821-OK-88 DTSCS68 01179 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS68 01180 SET LCCM-F08-88 TO TRUE DTSCS68 01181 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01182 VARYING WRK-SUB FROM WRK-SUB BY 1 DTSCS68 01183 UNTIL WRK-SUB > 12 DTSCS68 01184 OR L821-NO-REC-88. DTSCS68 01185 P6200-EXIT. DTSCS68 01186 EXIT. DTSCS68 01187 DTSCS68 01188 /*****************************************************************DTSCS68 01189 * *DTSCS68 01190 ******************************************************************DTSCS68 01191 P6300-PAGE-NEXT. DTSCS68 01192 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCS68 01193 DTSCS68 01194 IF L821-NO-REC-88 DTSCS68 01195 IF WRK-BLANK-SCREEN-88 DTSCS68 01196 MOVE WRK-SCR-ZIP-KEY TO IZIP-KEY-AREA DTSCS68 01197 ELSE DTSCS68 01198 MOVE WRK-TS-KEY(1) TO IZIP-KEY-AREA DTSCS68 01199 END-IF DTSCS68 01200 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS68 01201 IF L821-NO-REC-88 DTSCS68 01202 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS68 01203 ELSE DTSCS68 01204 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS68 01205 MOVE ISKL-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 01206 MOVE ISKL-KEY-AREA TO WRK-TS-KEY(1) DTSCS68 01207 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01208 VARYING WRK-SUB FROM 1 BY 1 DTSCS68 01209 UNTIL WRK-SUB > 12 DTSCS68 01210 OR L821-NO-REC-88 DTSCS68 01211 ELSE DTSCS68 01212 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01213 VARYING WRK-SUB FROM 1 BY 1 DTSCS68 01214 UNTIL WRK-SUB > 12 DTSCS68 01215 OR L821-NO-REC-88. DTSCS68 01216 DTSCS68 01217 * THIS CORRECTS A PROBLEM WITH THE LAST PAGE BEING BLANK DTSCS68 01218 * ON A PGDN - PROBLEM IS I NEED TO READ THRU X # OF RECORDS DTSCS68 01219 * LOOKING FOR THE NEXT ONE THAT MEETS THE CRITERIA DTSCS68 01220 * SO IF I DIDN'T FIND ANY I WANT TO REBUILD THE SCREEN AS IT WAS DTSCS68 01221 IF WRK-ADDL-CTR = 0 DTSCS68 01222 IF WRK-BLANK-SCREEN-88 DTSCS68 01223 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS68 01224 GO TO P6300-EXIT DTSCS68 01225 ELSE DTSCS68 01226 MOVE WRK-TS-KEY(1) TO ISKL-KEY-AREA DTSCS68 01227 END-IF DTSCS68 01228 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS68 01229 IF L821-NO-REC-88 DTSCS68 01230 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS68 01231 ELSE DTSCS68 01232 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS68 01233 MOVE ISKL-KEY-AREA TO WRK-SCR-ZIP-KEY DTSCS68 01234 MOVE ISKL-KEY-AREA TO WRK-TS-KEY(1) DTSCS68 01235 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS68 01236 VARYING WRK-SUB FROM 1 BY 1 DTSCS68 01237 UNTIL WRK-SUB > 12 DTSCS68 01238 OR L821-NO-REC-88. DTSCS68 01239 P6300-EXIT. DTSCS68 01240 EXIT. DTSCS68 01241 DTSCS68 01242 /*****************************************************************DTSCS68 01243 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS68 01244 ******************************************************************DTSCS68 01245 P6900-CONSTRUCT-SCREEN. DTSCS68 01246 DTSCS68 01247 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS68 01248 SET WRK-REALLY-WANT-IT TO TRUE. DTSCS68 01249 DTSCS68 01250 PERFORM P6910-DO-WE-WANT-IT THRU P6910-EXIT. DTSCS68 01251 DTSCS68 01252 ADD +1 TO WRK-S821-RECS-READ. DTSCS68 01253 DTSCS68 01254 IF WRK-REALLY-DO-NOT-WANT-IT DTSCS68 01255 **** IF REP ID WAS ENTERED, PREVENT TRANSACTION FROM TIMING DTSCS68 01256 **** OUT BY READING THE ALTERNATE INDEX FILE A LIMITED NBR OF DTSCS68 01257 **** TIMES, THEN PROMPTING TO CONTINUE SEARCH IF THAT LIMIT DTSCS68 01258 **** IS REACHED. DTSCS68 01259 IF NOT WRK-FLD-REP-ID-NONE DTSCS68 01260 IF WRK-S821-RECS-READ > WRK-S821-SEARCH-LIMIT DTSCS68 01261 PERFORM P7000-PREVENT-TIME-OUT THRU P7000-EXIT DTSCS68 01262 MOVE 13 TO WRK-SUB DTSCS68 01263 GO TO P6900-EXIT DTSCS68 01264 END-IF DTSCS68 01265 END-IF DTSCS68 01266 SUBTRACT 1 FROM WRK-SUB DTSCS68 01267 IF LCCM-F07-88 DTSCS68 01268 PERFORM S821-READ-PREV THRU S821-EXIT DTSCS68 01269 ELSE DTSCS68 01270 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS68 01271 END-IF DTSCS68 01272 GO TO P6900-EXIT DTSCS68 01273 END-IF. DTSCS68 01274 DTSCS68 01275 ADD 1 TO WRK-ADDL-CTR. DTSCS68 01276 DTSCS68 01277 MOVE SPACE TO WRK-BLANK-SCREEN-IND. DTSCS68 01278 DTSCS68 01279 IF LCCM-F07-88 DTSCS68 01280 PERFORM P6920-PUSH-STACK THRU P6920-EXIT DTSCS68 01281 VARYING WRK-CTR FROM WRK-SUB BY -1 DTSCS68 01282 UNTIL WRK-CTR < 2. DTSCS68 01283 DTSCS68 01284 IF LCCM-F07-88 DTSCS68 01285 COMPUTE WRK-CTR = 1 DTSCS68 01286 ELSE DTSCS68 01287 COMPUTE WRK-CTR = WRK-SUB. DTSCS68 01288 DTSCS68 01289 MOVE IZIP-KEY-AREA TO WRK-TS-KEY(WRK-CTR). DTSCS68 01290 DTSCS68 01291 PERFORM P6930-FORMAT-LINE THRU P6930-EXIT. DTSCS68 01292 DTSCS68 01293 MOVE WRK-CTR TO MAP-LINE-NO(WRK-CTR). DTSCS68 01294 DTSCS68 01295 IF L821-NO-REC-88 DTSCS68 01296 GO TO P6900-EXIT. DTSCS68 01297 DTSCS68 01298 IF LCCM-F07-88 DTSCS68 01299 MOVE IZIP-KEY-AREA TO WRK-TS-KEY(1) DTSCS68 01300 PERFORM S821-READ-PREV THRU S821-EXIT DTSCS68 01301 ELSE DTSCS68 01302 MOVE IZIP-KEY-AREA TO WRK-TS-KEY(WRK-ADDL-CTR)DTSCS68 01303 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCS68 01304 P6900-EXIT. EXIT. DTSCS68 01305 DTSCS68 01306 P6910-DO-WE-WANT-IT. DTSCS68 01307 IF NOT WRK-FLD-REP-ID-NONE DTSCS68 01308 MOVE IZIP-FLD-ZIP TO L061-FLD-ZIP DTSCS68 01309 MOVE IZIP-EMP-NO TO L061-EMP-NO DTSCS68 01310 PERFORM S061-ZIP-FIELD-LOOKUP THRU S061-EXIT DTSCS68 01311 IF L061-FLD-REP-ID NOT = WRK-FLD-REP-ID DTSCS68 01312 SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE DTSCS68 01313 GO TO P6910-EXIT. DTSCS68 01314 DTSCS68 01315 PERFORM P6931-READ-MPRF THRU P6931-EXIT. DTSCS68 01316 DTSCS68 01317 IF MPRF-PURSUED-RPT-CNT = +0 DTSCS68 01318 IF MPRF-TOT-BALANCE-AMT = +0 DTSCS68 01319 SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE DTSCS68 01320 GO TO P6910-EXIT DTSCS68 01321 END-IF DTSCS68 01322 END-IF. DTSCS68 01323 DTSCS68 01324 *****IF IZIP-FLD-ZIP NOT = WRK-FLD-ZIP DTSCS68 01325 ********SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE DTSCS68 01326 ********GO TO P6910-EXIT. DTSCS68 01327 DTSCS68 01328 IF IZIP-BANKRUPTCY-OPEN-YES-88 DTSCS68 01329 IF MAP-BANKRUPT-IND-YES DTSCS68 01330 GO TO P6910-EXIT DTSCS68 01331 ELSE DTSCS68 01332 NEXT SENTENCE DTSCS68 01333 ELSE DTSCS68 01334 IF IZIP-SUSPEND-COLL-YES-88 DTSCS68 01335 IF MAP-SUSPEND-IND-YES DTSCS68 01336 GO TO P6910-EXIT DTSCS68 01337 ELSE DTSCS68 01338 NEXT SENTENCE DTSCS68 01339 ELSE DTSCS68 01340 IF MAP-ACTIVE-IND-YES DTSCS68 01341 GO TO P6910-EXIT DTSCS68 01342 ELSE DTSCS68 01343 NEXT SENTENCE. DTSCS68 01344 DTSCS68 01345 SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE. DTSCS68 01346 P6910-EXIT. DTSCS68 01347 EXIT. DTSCS68 01348 DTSCS68 01349 P6920-PUSH-STACK. DTSCS68 01350 COMPUTE WRK-CTR2 = WRK-CTR - 1 DTSCS68 01351 MOVE MAP-LINE-DATA(WRK-CTR2) TO MAP-LINE-DATA(WRK-CTR) DTSCS68 01352 MOVE WRK-TS-KEY(WRK-CTR2) TO WRK-TS-KEY(WRK-CTR) DTSCS68 01353 MOVE WRK-CTR TO MAP-LINE-NO(WRK-CTR). DTSCS68 01354 P6920-EXIT. EXIT. DTSCS68 01355 DTSCS68 01356 P6930-FORMAT-LINE. DTSCS68 01357 MOVE SPACES TO MAP-LINE-DATA(WRK-CTR). DTSCS68 01358 DTSCS68 01359 PERFORM P6931-READ-MPRF THRU P6931-EXIT. DTSCS68 01360 DTSCS68 01361 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME(WRK-CTR). DTSCS68 01362 DTSCS68 01363 MOVE MPRF-FLD-ZIP TO MAP-ZIP(WRK-CTR). DTSCS68 01364 PERFORM P6933-READ-MTAD THRU P6933-EXIT. DTSCS68 01365 DTSCS68 01366 MOVE MPRF-PURSUED-RPT-CNT TO MAP-RPT-DUE-CNT(WRK-CTR). DTSCS68 01367 DTSCS68 01368 IF MPRF-MFAS-EXISTS-88 DTSCS68 01369 PERFORM P6935-READ-MFAS THRU P6935-EXIT. DTSCS68 01370 DTSCS68 01371 IF (MPRF-TOT-BALANCE-AMT = +0) DTSCS68 01372 OR DTSCS68 01373 (LCCM-COMP-DATE = ALL-NINES-DATE) DTSCS68 01374 MOVE MPRF-TOT-BALANCE-AMT TO MAP-TOT-BALANCE-AMT(WRK-CTR)DTSCS68 01375 ELSE DTSCS68 01376 PERFORM P6937-READ-MQTR THRU P6937-EXIT. DTSCS68 01377 DTSCS68 01378 MOVE IZIP-EMP-NO TO MAP-EMP-NO(WRK-CTR). DTSCS68 01379 DTSCS68 01380 P6930-EXIT. EXIT. DTSCS68 01381 DTSCS68 01382 DTSCS68 01383 P6931-READ-MPRF. DTSCS68 01384 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS68 01385 MOVE IZIP-EMP-NO TO MPRF-EMP-NO. DTSCS68 01386 SET MPRF-PRF-88 TO TRUE. DTSCS68 01387 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS68 01388 DTSCS68 01389 PERFORM S810-READ THRU S810-EXIT. DTSCS68 01390 DTSCS68 01391 IF L810-NO-REC-88 DTSCS68 01392 MOVE MPRF-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS68 01393 MOVE MSG-E682-AREA TO LCCM-MSG-AREA DTSCS68 01394 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS68 01395 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS68 01396 GO TO MAINLINE-EXIT. DTSCS68 01397 DTSCS68 01398 MOVE MSKL-REC TO MPRF-REC. DTSCS68 01399 P6931-EXIT. EXIT. DTSCS68 01400 DTSCS68 01401 P6933-READ-MTAD. DTSCS68 01402 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS68 01403 MOVE IZIP-EMP-NO TO MSKL-EMP-NO. DTSCS68 01404 SET MSKL-TAD-88 TO TRUE. DTSCS68 01405 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS68 01406 PERFORM UNTIL L810-NO-REC-88 DTSCS68 01407 MOVE MSKL-REC TO MTAD-REC DTSCS68 01408 DTSCS68 01409 IF MPRF-FLD-ZIP (1:5) = MTAD-ZIP (1:5) DTSCS68 01410 MOVE MTAD-CITY TO MAP-CITY(WRK-CTR) DTSCS68 01411 MOVE MTAD-ST TO MAP-STATE(WRK-CTR) DTSCS68 01412 MOVE MTAD-ZIP TO MAP-ZIP(WRK-CTR) DTSCS68 01413 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS68 01414 SET L810-NO-REC-88 TO TRUE DTSCS68 01415 ELSE DTSCS68 01416 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS68 01417 END-IF DTSCS68 01418 DTSCS68 01419 END-PERFORM. DTSCS68 01420 DTSCS68 01421 P6933-EXIT. EXIT. DTSCS68 01422 DTSCS68 01423 P6935-READ-MFAS. DTSCS68 01424 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS68 01425 MOVE IZIP-EMP-NO TO MSKL-EMP-NO. DTSCS68 01426 SET MSKL-FAS-88 TO TRUE. DTSCS68 01427 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS68 01428 PERFORM UNTIL L810-NO-REC-88 DTSCS68 01429 MOVE MSKL-REC TO MFAS-REC DTSCS68 01430 DTSCS68 01431 IF MFAS-STATUS-ACTIVE-88 DTSCS68 01432 OR MFAS-STATUS-HELD-88 DTSCS68 01433 MOVE '*' TO MAP-FLD-ASSI(WRK-CTR) DTSCS68 01434 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS68 01435 SET L810-NO-REC-88 TO TRUE DTSCS68 01436 ELSE DTSCS68 01437 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS68 01438 END-IF DTSCS68 01439 DTSCS68 01440 END-PERFORM. DTSCS68 01441 DTSCS68 01442 P6935-EXIT. EXIT. DTSCS68 01443 DTSCS68 01444 P6937-READ-MQTR. DTSCS68 01445 DTSCS68 01446 MOVE +0 TO WRK-TOT-BALANCE-AMT. DTSCS68 01447 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS68 01448 MOVE IZIP-EMP-NO TO MQTR-EMP-NO. DTSCS68 01449 SET MQTR-QTR-88 TO TRUE. DTSCS68 01450 DTSCS68 01451 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS68 01452 DTSCS68 01453 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS68 01454 DTSCS68 01455 PERFORM P6938-MQTR-SCAN THRU P6938-EXIT DTSCS68 01456 UNTIL L810-NO-REC-88. DTSCS68 01457 DTSCS68 01458 MOVE WRK-TOT-BALANCE-AMT TO MAP-TOT-BALANCE-AMT(WRK-CTR). DTSCS68 01459 DTSCS68 01460 P6937-EXIT. EXIT. DTSCS68 01461 DTSCS68 01462 DTSCS68 01463 DTSCS68 01464 P6938-MQTR-SCAN. DTSCS68 01465 MOVE MSKL-REC TO MQTR-REC. DTSCS68 01466 DTSCS68 01467 MOVE +0 TO L101-PAID-CHNG. DTSCS68 01468 DTSCS68 01469 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS68 01470 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS68 01471 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS68 01472 TO WRK-TOT-BALANCE-AMT DTSCS68 01473 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS68 01474 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS68 01475 TO L101-PAID-CHNG DTSCS68 01476 END-IF DTSCS68 01477 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS68 01478 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS68 01479 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS68 01480 TO L101-PAID-CHNG DTSCS68 01481 END-IF DTSCS68 01482 END-PERFORM. DTSCS68 01483 DTSCS68 01484 IF L101-PAID-CHNG > +0 DTSCS68 01485 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE DTSCS68 01486 SET L101-WAIVE-INT-NO-88 TO TRUE DTSCS68 01487 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSCS68 01488 MOVE MQTR-INT-AREA TO L101-INT-AREA DTSCS68 01489 DTSCS68 01490 PERFORM S101-PER-MONTH-NO THRU S101-EXIT DTSCS68 01491 DTSCS68 01492 ADD L101-INT-CHARGE-CHNG DTSCS68 01493 TO WRK-TOT-BALANCE-AMT DTSCS68 01494 SUBTRACT L101-INT-WAIVE-CHNG DTSCS68 01495 FROM WRK-TOT-BALANCE-AMT. DTSCS68 01496 DTSCS68 01497 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS68 01498 P6938-EXIT. DTSCS68 01499 EXIT. DTSCS68 01500 SKIP3 DTSCS68 01501 ******************************************************************DTSCS68 01502 * NORMALLY, PAGING IS CONTROLLED BY READING BACKWARD/FORWARD *DTSCS68 01503 * BASED ON THE FIRST/LAST RECORDS DISPLAYED ON THE SCREEN. *DTSCS68 01504 * ON A BLANK SCREEN, SINCE THERE MAY HAVE BEEN NO RECORDS FOUND *DTSCS68 01505 * WHEN THE SEARCH LIMIT IS REACHED, KEEP TRACK OF THE MOST RECENT*DTSCS68 01506 * RECORD READ IN WRK-SCR-ZIP-KEY AND CONTROL PAGING FROM *DTSCS68 01507 * THAT POINT. *DTSCS68 01508 ******************************************************************DTSCS68 01509 P7000-PREVENT-TIME-OUT. DTSCS68 01510 DTSCS68 01511 MOVE IZIP-FLD-ZIP TO MSG-P683-ZIP. DTSCS68 01512 DTSCS68 01513 IF LCCM-F07-88 DTSCS68 01514 MOVE 'F7' TO MSG-P683-PFKEY DTSCS68 01515 ELSE DTSCS68 01516 MOVE 'F8' TO MSG-P683-PFKEY. DTSCS68 01517 DTSCS68 01518 IF LCCM-NO-MSG DTSCS68 01519 MOVE MSG-P683-AREA TO WRK-MSG-AREA DTSCS68 01520 LCCM-MSG-AREA. DTSCS68 01521 DTSCS68 01522 MOVE IZIP-KEY-AREA TO WRK-SCR-ZIP-KEY. DTSCS68 01523 DTSCS68 01524 IF WRK-ADDL-CTR = 0 DTSCS68 01525 SET WRK-BLANK-SCREEN-88 TO TRUE. DTSCS68 01526 DTSCS68 01527 P7000-EXIT. DTSCS68 01528 EXIT. DTSCS68 01529 /*****************************************************************DTSCS68 01530 * LINKS TO UTILITY MODULES DTSCS68 01531 ******************************************************************DTSCS68 01532 DTSCS68 01533 *S001-FROM-FED-8. DTSCS68 01534 *****SET L001-FROM-FED-8 TO TRUE. DTSCS68 01535 *****GO TO S001-DATE. DTSCS68 01536 ***** DTSCS68 01537 *S001-DATE. DTSCS68 01538 *****EXEC CICS LINK DTSCS68 01539 ***** PROGRAM('MACCU001') DTSCS68 01540 ***** COMMAREA(L001-COMM-AREA) DTSCS68 01541 ***** LENGTH(L001-LENGTH) DTSCS68 01542 *****END-EXEC. DTSCS68 01543 *S001-EXIT. DTSCS68 01544 *****EXIT. DTSCS68 01545 DTSCS68 01546 S013-SELECT-LINE-NO. DTSCS68 01547 MOVE +1 TO L013-MIN-CNT. DTSCS68 01548 MOVE +12 TO L013-MAX-CNT. DTSCS68 01549 GO TO S013-CNT-FROM-SCREEN. DTSCS68 01550 DTSCS68 01551 S013-CNT-FROM-SCREEN. DTSCS68 01552 EXEC CICS DTSCS68 01553 LINK DTSCS68 01554 PROGRAM ('DTSCU013') DTSCS68 01555 COMMAREA (L013-COMM-AREA) DTSCS68 01556 END-EXEC. DTSCS68 01557 S013-EXIT. DTSCS68 01558 EXIT. DTSCS68 01559 DTSCS68 01560 S015-DATE-FROM-SCREEN. DTSCS68 01561 EXEC CICS LINK DTSCS68 01562 PROGRAM('DTSCU015') DTSCS68 01563 COMMAREA(L015-COMM-AREA) DTSCS68 01564 END-EXEC. DTSCS68 01565 S015-EXIT. DTSCS68 01566 EXIT. DTSCS68 01567 DTSCS68 01568 S061-ZIP-FIELD-LOOKUP. DTSCS68 01569 EXEC CICS LINK DTSCS68 01570 PROGRAM('DTSCU061') DTSCS68 01571 COMMAREA(L061-COMM-AREA) DTSCS68 01572 END-EXEC. DTSCS68 01573 DTSCS68 01574 IF L061-FILE-CLOSED DTSCS68 01575 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01576 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS68 01577 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS68 01578 GO TO MAINLINE-EXIT. DTSCS68 01579 S061-EXIT. DTSCS68 01580 EXIT. DTSCS68 01581 DTSCS68 01582 S062-FLD-REP-EDIT. DTSCS68 01583 EXEC CICS LINK DTSCS68 01584 PROGRAM('DTSCU062') DTSCS68 01585 COMMAREA(L062-COMM-AREA) DTSCS68 01586 END-EXEC. DTSCS68 01587 DTSCS68 01588 IF L062-FILE-CLOSED DTSCS68 01589 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01590 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS68 01591 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS68 01592 GO TO MAINLINE-EXIT. DTSCS68 01593 S062-EXIT. DTSCS68 01594 EXIT. DTSCS68 01595 DTSCS68 01596 S101-PER-MONTH-NO. DTSCS68 01597 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS68 01598 GO TO S101-INT-PEN-COMP. DTSCS68 01599 DTSCS68 01600 S101-INT-PEN-COMP. DTSCS68 01601 EXEC CICS LINK DTSCS68 01602 PROGRAM ('DTSCU101') DTSCS68 01603 COMMAREA (L101-COMM-AREA) DTSCS68 01604 END-EXEC. DTSCS68 01605 S101-EXIT. DTSCS68 01606 EXIT. DTSCS68 01607 DTSCS68 01608 S109-SUR-TAX-QTR. DTSCS68 01609 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS68 01610 EXEC CICS LINK DTSCS68 01611 PROGRAM ('DTSCU109') DTSCS68 01612 COMMAREA (L109-COMM-AREA) DTSCS68 01613 END-EXEC. DTSCS68 01614 S109-EXIT. DTSCS68 01615 EXIT. DTSCS68 01616 DTSCS68 01617 S803-REQ-SCR-ID-EDIT. DTSCS68 01618 EXEC CICS LINK DTSCS68 01619 PROGRAM ('DTSCU803') DTSCS68 01620 COMMAREA (DFHCOMMAREA) DTSCS68 01621 END-EXEC. DTSCS68 01622 S803-EXIT. DTSCS68 01623 EXIT. DTSCS68 01624 DTSCS68 01625 S804-INVALID-KEY. DTSCS68 01626 EXEC CICS LINK DTSCS68 01627 PROGRAM ('DTSCU804') DTSCS68 01628 COMMAREA (DFHCOMMAREA) DTSCS68 01629 END-EXEC. DTSCS68 01630 S804-EXIT. DTSCS68 01631 EXIT. DTSCS68 01632 DTSCS68 01633 S805-MSG-AREA. DTSCS68 01634 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS68 01635 DTSCS68 01636 EXEC CICS LINK DTSCS68 01637 PROGRAM ('DTSCU805') DTSCS68 01638 COMMAREA (L805-COMM-AREA) DTSCS68 01639 END-EXEC. DTSCS68 01640 DTSCS68 01641 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS68 01642 S805-EXIT. DTSCS68 01643 EXIT. DTSCS68 01644 EJECT DTSCS68 01645 S810-READ. DTSCS68 01646 SET L810-READ-88 TO TRUE. DTSCS68 01647 GO TO S810-IO. DTSCS68 01648 DTSCS68 01649 S810-START-BROWSE. DTSCS68 01650 SET L810-START-BROWSE-88 TO TRUE. DTSCS68 01651 GO TO S810-IO. DTSCS68 01652 DTSCS68 01653 S810-READ-NEXT. DTSCS68 01654 SET L810-READ-NEXT-88 TO TRUE. DTSCS68 01655 GO TO S810-IO. DTSCS68 01656 DTSCS68 01657 *S810-READ-PREV. DTSCS68 01658 *****SET L810-READ-PREV-88 TO TRUE. DTSCS68 01659 *****GO TO S810-IO. DTSCS68 01660 DTSCS68 01661 S810-END-BROWSE. DTSCS68 01662 SET L810-END-BROWSE-88 TO TRUE. DTSCS68 01663 GO TO S810-IO. DTSCS68 01664 DTSCS68 01665 *S810-COUNT. DTSCS68 01666 *****SET L810-COUNT-88 TO TRUE. DTSCS68 01667 *****GO TO S810-IO. DTSCS68 01668 ***** DTSCS68 01669 *S810-REWRITE. DTSCS68 01670 *****SET L810-REWRITE-88 TO TRUE. DTSCS68 01671 *****GO TO S810-IO. DTSCS68 01672 ***** DTSCS68 01673 *S810-WRITE. DTSCS68 01674 *****SET L810-WRITE-88 TO TRUE. DTSCS68 01675 *****GO TO S810-IO. DTSCS68 01676 ***** DTSCS68 01677 *S810-DELETE. DTSCS68 01678 *****SET L810-DELETE-88 TO TRUE. DTSCS68 01679 *****GO TO S810-IO. DTSCS68 01680 DTSCS68 01681 S810-IO. DTSCS68 01682 DTSCS68 01683 EXEC CICS LINK DTSCS68 01684 PROGRAM ('DTSCU810') DTSCS68 01685 COMMAREA (L810-COMM-AREA) DTSCS68 01686 END-EXEC. DTSCS68 01687 DTSCS68 01688 IF L810-FILE-CLOSED-88 DTSCS68 01689 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01690 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS68 01691 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS68 01692 GO TO MAINLINE-EXIT. DTSCS68 01693 S810-EXIT. DTSCS68 01694 EXIT. DTSCS68 01695 EJECT DTSCS68 01696 S821-START-BROWSE. DTSCS68 01697 SET L821-START-BROWSE-88 TO TRUE. DTSCS68 01698 GO TO S821-MASTER-IO. DTSCS68 01699 DTSCS68 01700 S821-END-BROWSE. DTSCS68 01701 SET L821-END-BROWSE-88 TO TRUE. DTSCS68 01702 GO TO S821-MASTER-IO. DTSCS68 01703 DTSCS68 01704 S821-READ-PREV. DTSCS68 01705 SET L821-READ-PREV-88 TO TRUE. DTSCS68 01706 GO TO S821-MASTER-IO. DTSCS68 01707 DTSCS68 01708 S821-READ-NEXT. DTSCS68 01709 SET L821-READ-NEXT-88 TO TRUE. DTSCS68 01710 GO TO S821-MASTER-IO. DTSCS68 01711 DTSCS68 01712 S821-MASTER-IO. DTSCS68 01713 EXEC CICS LINK DTSCS68 01714 PROGRAM ('DTSCU821') DTSCS68 01715 COMMAREA (L821-COMM-AREA) DTSCS68 01716 END-EXEC. DTSCS68 01717 IF L821-FILE-CLOSED-88 DTSCS68 01718 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01719 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS68 01720 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS68 01721 GO TO MAINLINE-EXIT. DTSCS68 01722 S821-EXIT. EXIT. DTSCS68 01723 DTSCS68 01724 *S891-WRITE-TS. DTSCS68 01725 *****MOVE WRK-TS-AREA TO LCCM-SCR-HOLD-AREA. DTSCS68 01726 *S891-EXIT. EXIT. DTSCS68 01727 DTSCS68 01728 S851-SCREEN-PROCESSING. DTSCS68 01729 EXEC CICS LINK DTSCS68 01730 PROGRAM ('DTSCU851') DTSCS68 01731 COMMAREA (L851-COMM-AREA) DTSCS68 01732 END-EXEC. DTSCS68 01733 S851-EXIT. DTSCS68 01734 EXIT. DTSCS68 01735 DTSCS68 01736 S899-ABEND. DTSCS68 01737 EXEC CICS ABEND DTSCS68 01738 ABCODE(WRK-ABEND-CD) DTSCS68 01739 END-EXEC. DTSCS68 01740 S899-EXIT. DTSCS68 01741 EXIT. DTSCS68 01742 /*****************************************************************DTSCS68 01743 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS68 01744 ******************************************************************DTSCS68 01745 DTSCS68 01746 S1000-SCREEN-EDITS. DTSCS68 01747 DTSCS68 01748 MOVE +0 TO WRK-CTR DTSCS68 01749 PERFORM S1100-FLD-ZIP THRU S1100-EXIT. DTSCS68 01750 PERFORM S1200-FLD-REP-ID THRU S1200-EXIT. DTSCS68 01751 PERFORM S1300-ACTIVE-IND THRU S1300-EXIT. DTSCS68 01752 PERFORM S1400-SUSPEND-IND THRU S1400-EXIT. DTSCS68 01753 PERFORM S1500-BANKRUPT-IND THRU S1500-EXIT. DTSCS68 01754 PERFORM S1700-COMP-DATE THRU S1700-EXIT. DTSCS68 01755 DTSCS68 01756 IF MAP-ACTIVE-IND-NO DTSCS68 01757 AND MAP-SUSPEND-IND-NO DTSCS68 01758 AND MAP-BANKRUPT-IND-NO DTSCS68 01759 MOVE MSG-E681-AREA TO WRK-MSG-AREA DTSCS68 01760 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS68 01761 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS68 01762 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS68 01763 END-IF. DTSCS68 01764 S1000-EXIT. EXIT. DTSCS68 01765 EJECT DTSCS68 01766 /**************************************************************** DTSCS68 01767 * EDIT FLD-ZIP DTSCS68 01768 ***************************************************************** DTSCS68 01769 S1100-FLD-ZIP. DTSCS68 01770 INSPECT MAP-FLD-ZIP CONVERTING LOW-VALUES TO SPACES DTSCS68 01771 IF MAP-FLD-ZIP = SPACES DTSCS68 01772 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS68 01773 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS68 01774 GO TO S1100-EXIT DTSCS68 01775 END-IF. DTSCS68 01776 DTSCS68 01777 MOVE LOW-VALUES TO IZIP-KEY-AREA. DTSCS68 01778 MOVE MAP-FLD-ZIP TO IZIP-FLD-ZIP. DTSCS68 01779 MOVE MAP-FLD-ZIP TO WRK-FLD-ZIP. DTSCS68 01780 SET IZIP-ZIP-88 TO TRUE. DTSCS68 01781 MOVE IZIP-KEY-AREA TO WRK-TS-KEY(1). DTSCS68 01782 S1100-EXIT. EXIT. DTSCS68 01783 DTSCS68 01784 S1101-ERROR. DTSCS68 01785 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-ZIP-A. DTSCS68 01786 SET CURSOR-SET-YES TO TRUE. DTSCS68 01787 IF LCCM-NO-MSG DTSCS68 01788 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01789 MOVE CATB-CURSOR TO MAP-FLD-ZIP-L. DTSCS68 01790 S1101-EXIT. EXIT. DTSCS68 01791 DTSCS68 01792 /**************************************************************** DTSCS68 01793 * DTSCS68 01794 ***************************************************************** DTSCS68 01795 S1200-FLD-REP-ID. DTSCS68 01796 INSPECT MAP-FLD-REP-ID CONVERTING LOW-VALUES TO SPACES DTSCS68 01797 IF MAP-FLD-REP-ID = SPACES DTSCS68 01798 SET WRK-FLD-REP-ID-NONE TO TRUE DTSCS68 01799 ELSE DTSCS68 01800 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID DTSCS68 01801 PERFORM S062-FLD-REP-EDIT THRU S062-EXIT DTSCS68 01802 IF L062-VALID DTSCS68 01803 MOVE MAP-FLD-REP-ID TO WRK-FLD-REP-ID DTSCS68 01804 ELSE DTSCS68 01805 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 01806 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS68 01807 END-IF. DTSCS68 01808 S1200-EXIT. EXIT. DTSCS68 01809 DTSCS68 01810 S1201-ERROR. DTSCS68 01811 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-A. DTSCS68 01812 SET CURSOR-SET-YES TO TRUE. DTSCS68 01813 IF LCCM-NO-MSG DTSCS68 01814 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01815 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-L. DTSCS68 01816 S1201-EXIT. EXIT. DTSCS68 01817 /**************************************************************** DTSCS68 01818 * DTSCS68 01819 ***************************************************************** DTSCS68 01820 S1300-ACTIVE-IND. DTSCS68 01821 IF MAP-ACTIVE-IND = LOW-VALUES OR SPACES DTSCS68 01822 SET MAP-ACTIVE-IND-YES TO TRUE DTSCS68 01823 ELSE DTSCS68 01824 IF MAP-ACTIVE-IND-VALID DTSCS68 01825 NEXT SENTENCE DTSCS68 01826 ELSE DTSCS68 01827 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 01828 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS68 01829 END-IF. DTSCS68 01830 MOVE MAP-ACTIVE-IND TO WRK-ACTIVE-IND. DTSCS68 01831 S1300-EXIT. EXIT. DTSCS68 01832 DTSCS68 01833 S1301-ERROR. DTSCS68 01834 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACTIVE-IND-A. DTSCS68 01835 SET CURSOR-SET-YES TO TRUE. DTSCS68 01836 IF LCCM-NO-MSG DTSCS68 01837 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01838 MOVE CATB-CURSOR TO MAP-ACTIVE-IND-L. DTSCS68 01839 S1301-EXIT. EXIT. DTSCS68 01840 DTSCS68 01841 /**************************************************************** DTSCS68 01842 * DTSCS68 01843 ***************************************************************** DTSCS68 01844 S1400-SUSPEND-IND. DTSCS68 01845 IF MAP-SUSPEND-IND = LOW-VALUES OR SPACES DTSCS68 01846 SET MAP-SUSPEND-IND-NO TO TRUE DTSCS68 01847 ELSE DTSCS68 01848 IF MAP-SUSPEND-IND-VALID DTSCS68 01849 NEXT SENTENCE DTSCS68 01850 ELSE DTSCS68 01851 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 01852 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS68 01853 END-IF. DTSCS68 01854 MOVE MAP-SUSPEND-IND TO WRK-SUSPEND-IND. DTSCS68 01855 S1400-EXIT. EXIT. DTSCS68 01856 DTSCS68 01857 DTSCS68 01858 S1401-ERROR. DTSCS68 01859 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SUSPEND-IND-A. DTSCS68 01860 SET CURSOR-SET-YES TO TRUE. DTSCS68 01861 IF LCCM-NO-MSG DTSCS68 01862 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01863 MOVE CATB-CURSOR TO MAP-SUSPEND-IND-L. DTSCS68 01864 S1401-EXIT. EXIT. DTSCS68 01865 DTSCS68 01866 /**************************************************************** DTSCS68 01867 * DTSCS68 01868 ***************************************************************** DTSCS68 01869 S1500-BANKRUPT-IND. DTSCS68 01870 IF MAP-BANKRUPT-IND = LOW-VALUES OR SPACES DTSCS68 01871 SET MAP-BANKRUPT-IND-NO TO TRUE DTSCS68 01872 ELSE DTSCS68 01873 IF MAP-BANKRUPT-IND-VALID DTSCS68 01874 NEXT SENTENCE DTSCS68 01875 ELSE DTSCS68 01876 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 01877 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS68 01878 END-IF. DTSCS68 01879 MOVE MAP-BANKRUPT-IND TO WRK-BANKRUPT-IND. DTSCS68 01880 S1500-EXIT. EXIT. DTSCS68 01881 DTSCS68 01882 S1501-ERROR. DTSCS68 01883 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-BANKRUPT-IND-A. DTSCS68 01884 SET CURSOR-SET-YES TO TRUE. DTSCS68 01885 IF LCCM-NO-MSG DTSCS68 01886 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01887 MOVE CATB-CURSOR TO MAP-BANKRUPT-IND-L. DTSCS68 01888 S1501-EXIT. EXIT. DTSCS68 01889 DTSCS68 01890 /**************************************************************** DTSCS68 01891 * DTSCS68 01892 ***************************************************************** DTSCS68 01893 S1700-COMP-DATE. DTSCS68 01894 DTSCS68 01895 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS68 01896 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS68 01897 DTSCS68 01898 IF L015-NO-ENTRY DTSCS68 01899 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS68 01900 MOVE WRK-DISPLAY-MO TO MAP-COMP-DATE-MO DTSCS68 01901 MOVE WRK-DISPLAY-DA TO MAP-COMP-DATE-DA DTSCS68 01902 MOVE WRK-DISPLAY-YR TO MAP-COMP-DATE-YR DTSCS68 01903 ELSE DTSCS68 01904 IF L015-NOT-VALID DTSCS68 01905 IF MAP-COMP-DATE-MO = '99' DTSCS68 01906 AND MAP-COMP-DATE-DA = '99' DTSCS68 01907 AND MAP-COMP-DATE-YR = '99' DTSCS68 01908 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS68 01909 ELSE DTSCS68 01910 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS68 01911 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS68 01912 ELSE DTSCS68 01913 MOVE L015-DATE TO LCCM-COMP-DATE DTSCS68 01914 END-IF. DTSCS68 01915 DTSCS68 01916 S1700-EXIT. EXIT. DTSCS68 01917 DTSCS68 01918 S1701-ERROR. DTSCS68 01919 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COMP-DATE-YR-A DTSCS68 01920 MAP-COMP-DATE-MO-A DTSCS68 01921 MAP-COMP-DATE-DA-A. DTSCS68 01922 SET CURSOR-SET-YES TO TRUE. DTSCS68 01923 IF LCCM-NO-MSG DTSCS68 01924 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01925 MOVE CATB-CURSOR TO MAP-COMP-DATE-MO-L. DTSCS68 01926 S1701-EXIT. EXIT. DTSCS68 01927 DTSCS68 01928 /**************************************************************** DTSCS68 01929 * SCREEN SELECT AND LINE NUMBER ERROR ROUTINES DTSCS68 01930 ***************************************************************** DTSCS68 01931 S1901-MAP-LINE-ERROR. DTSCS68 01932 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELECT-LINE-NO-A. DTSCS68 01933 SET CURSOR-SET-YES TO TRUE. DTSCS68 01934 IF LCCM-NO-MSG DTSCS68 01935 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01936 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L. DTSCS68 01937 S1901-EXIT. EXIT. DTSCS68 01938 DTSCS68 01939 S2001-SELECT-SCREEN-ERROR. DTSCS68 01940 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SELECT-SCREEN-ID-A. DTSCS68 01941 SET CURSOR-SET-YES TO TRUE. DTSCS68 01942 IF LCCM-NO-MSG DTSCS68 01943 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS68 01944 MOVE CATB-CURSOR TO MAP-SELECT-SCREEN-ID-L. DTSCS68 01945 S2001-EXIT. EXIT. DTSCS68 01946 ******************************************************************DTSCS68 01947 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS68 01948 ******************************************************************DTSCS68 01949 S5300-SET-INQ-ATTRB. DTSCS68 01950 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS68 01951 WRK-ATB-NUM. DTSCS68 01952 DTSCS68 01953 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS68 01954 S5300-EXIT. DTSCS68 01955 EXIT. DTSCS68 01956 DTSCS68 01957 S5900-SET-ATTRB. DTSCS68 01958 MOVE LOW-VALUES TO MAP-FLD-ZIP-A DTSCS68 01959 DTSCS68 01960 MAP-ACTIVE-IND-A DTSCS68 01961 MAP-SUSPEND-IND-A DTSCS68 01962 MAP-BANKRUPT-IND-A DTSCS68 01963 MAP-COMP-DATE-YR-A DTSCS68 01964 MAP-COMP-DATE-MO-A DTSCS68 01965 MAP-COMP-DATE-DA-A DTSCS68 01966 MAP-FLD-REP-ID-A DTSCS68 01967 PERFORM S5910-TABLE THRU S5910-EXIT DTSCS68 01968 VARYING WRK-CTR FROM 1 BY 1 DTSCS68 01969 UNTIL WRK-CTR > 12. DTSCS68 01970 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS68 01971 S5900-EXIT. EXIT. DTSCS68 01972 DTSCS68 01973 S5910-TABLE. DTSCS68 01974 MOVE CATB-ASKIP-BRT-MDTON TO MAP-LINE-A(WRK-CTR). DTSCS68 01975 S5910-EXIT. EXIT. DTSCS68 01976 /*************************************************************** DTSCS68 01977 * THESE ATTRIBUTES ARE BUILT PRIOR TO THE SEND BASED ON THE DTSCS68 01978 * SEARCH RESULTS AND SCREEN STATUS DTSCS68 01979 **************************************************************** DTSCS68 01980 S5920-ATTRIBUTES. DTSCS68 01981 IF WRK-TS-FOUND-YES DTSCS68 01982 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SELECT-SCREEN-ID-A DTSCS68 01983 ELSE DTSCS68 01984 IF WRK-TS-FOUND-NO DTSCS68 01985 MOVE CATB-ASKIP-NORM-MDTON TO MAP-SELECT-SCREEN-ID-A. DTSCS68 01986 DTSCS68 01987 IF WRK-TS-FOUND-YES DTSCS68 01988 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SELECT-LINE-NO-A DTSCS68 01989 ELSE DTSCS68 01990 IF WRK-TS-FOUND-NO DTSCS68 01991 MOVE CATB-ASKIP-NORM-MDTON TO MAP-SELECT-LINE-NO-A. DTSCS68 01992 DTSCS68 01993 IF WRK-TS-FOUND-NO AND MAP-FLD-ZIP-A = LOW-VALUES DTSCS68 01994 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-FLD-ZIP-A DTSCS68 01995 ELSE DTSCS68 01996 IF WRK-TS-FOUND-YES DTSCS68 01997 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FLD-ZIP-A. DTSCS68 01998 DTSCS68 01999 IF WRK-TS-FOUND-NO AND MAP-FLD-REP-ID-A = LOW-VALUES DTSCS68 02000 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-FLD-REP-ID-A DTSCS68 02001 ELSE DTSCS68 02002 IF WRK-TS-FOUND-YES DTSCS68 02003 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FLD-REP-ID-A. DTSCS68 02004 DTSCS68 02005 IF WRK-TS-FOUND-NO AND MAP-ACTIVE-IND-A = LOW-VALUES DTSCS68 02006 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-ACTIVE-IND-A DTSCS68 02007 ELSE DTSCS68 02008 IF WRK-TS-FOUND-YES DTSCS68 02009 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ACTIVE-IND-A. DTSCS68 02010 DTSCS68 02011 IF WRK-TS-FOUND-NO AND MAP-SUSPEND-IND-A = LOW-VALUES DTSCS68 02012 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SUSPEND-IND-A DTSCS68 02013 ELSE DTSCS68 02014 IF WRK-TS-FOUND-YES DTSCS68 02015 MOVE CATB-ASKIP-NORM-MDTON TO MAP-SUSPEND-IND-A. DTSCS68 02016 DTSCS68 02017 IF WRK-TS-FOUND-NO AND MAP-BANKRUPT-IND-A = LOW-VALUES DTSCS68 02018 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-BANKRUPT-IND-A DTSCS68 02019 ELSE DTSCS68 02020 IF WRK-TS-FOUND-YES DTSCS68 02021 MOVE CATB-ASKIP-NORM-MDTON TO MAP-BANKRUPT-IND-A. DTSCS68 02022 DTSCS68 02023 IF WRK-TS-FOUND-NO AND MAP-COMP-DATE-MO-A = LOW-VALUES DTSCS68 02024 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-COMP-DATE-MO-A DTSCS68 02025 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-COMP-DATE-DA-A DTSCS68 02026 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-COMP-DATE-YR-A DTSCS68 02027 ELSE DTSCS68 02028 IF WRK-TS-FOUND-YES DTSCS68 02029 MOVE CATB-ASKIP-NORM-MDTON TO MAP-COMP-DATE-MO-A DTSCS68 02030 MOVE CATB-ASKIP-NORM-MDTON TO MAP-COMP-DATE-DA-A DTSCS68 02031 MOVE CATB-ASKIP-NORM-MDTON TO MAP-COMP-DATE-YR-A. DTSCS68 02032 DTSCS68 02033 S5920-EXIT. EXIT. DTSCS68 02034 EJECT DTSCS68 02035 /*****************************************************************DTSCS68 02036 * MAP ROUTINES *DTSCS68 02037 ******************************************************************DTSCS68 02038 S9100-RECEIVE. DTSCS68 02039 SET L851-RECEIVE-88 TO TRUE. DTSCS68 02040 DTSCS68 02041 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS68 02042 DTSCS68 02043 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS68 02044 DTSCS68 02045 MOVE L851-AID TO LCCM-AID. DTSCS68 02046 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS68 02047 S9100-EXIT. DTSCS68 02048 EXIT. DTSCS68 02049 DTSCS68 02050 S9200-SEND-DATAONLY. DTSCS68 02051 MOVE LOW-VALUES TO MAP-AREA. DTSCS68 02052 DTSCS68 02053 IF LCCM-NO-MSG DTSCS68 02054 NEXT SENTENCE DTSCS68 02055 ELSE DTSCS68 02056 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS68 02057 DTSCS68 02058 IF CURSOR-SET-GOTO DTSCS68 02059 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS68 02060 ELSE DTSCS68 02061 IF CURSOR-SET-NO DTSCS68 02062 MOVE CATB-CURSOR TO MAP-FLD-ZIP-L. DTSCS68 02063 DTSCS68 02064 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS68 02065 DTSCS68 02066 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS68 02067 DTSCS68 02068 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS68 02069 S9200-EXIT. DTSCS68 02070 EXIT. DTSCS68 02071 DTSCS68 02072 S9300-SEND-MAP. DTSCS68 02073 PERFORM S5920-ATTRIBUTES THRU S5920-EXIT. DTSCS68 02074 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS68 02075 MOVE SPACES TO MAP-SYS-TIME. DTSCS68 02076 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS68 02077 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS68 02078 DTSCS68 02079 IF SCR-ACCESS-UPDATE DTSCS68 02080 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS68 02081 ELSE DTSCS68 02082 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS68 02083 DTSCS68 02084 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS68 02085 DTSCS68 02086 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS68 02087 DTSCS68 02088 IF CURSOR-SET-NO DTSCS68 02089 MOVE CATB-CURSOR TO MAP-FLD-ZIP-L. DTSCS68 02090 DTSCS68 02091 SET L851-SEND-88 TO TRUE. DTSCS68 02092 DTSCS68 02093 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS68 02094 DTSCS68 02095 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS68 02096 S9300-EXIT. DTSCS68 02097 EXIT. DTSCS68 02098 DTSCS68 02099 S9310-UPDATE-FKEYS. DTSCS68 02100 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS68 02101 DTSCS68 02102 S9310-EXIT. DTSCS68 02103 EXIT. DTSCS68 02104 DTSCS68 02105 S9320-INQUIRY-FKEYS. DTSCS68 02106 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS68 02107 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS68 02108 MOVE CFKD-NEW-SEARCH TO MAP-KEY-NEW-SEARCH. DTSCS68 02109 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS68 02110 S9320-EXIT. DTSCS68 02111 EXIT. DTSCS68 02112 DTSCS68 02113 *S9321-JUMP-KEYS. DTSCS68 02114 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS68 02115 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS68 02116 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS68 02117 *S9321-EXIT. DTSCS68 02118 * EXIT. DTSCS68 02119 DTSCS68 02120 S9330-DSCR-FIELDS. DTSCS68 02121 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID. DTSCS68 02122 PERFORM S062-FLD-REP-EDIT THRU S062-EXIT. DTSCS68 02123 IF L062-VALID DTSCS68 02124 MOVE L062-NAME TO MAP-FLD-REP-ID-DSCR DTSCS68 02125 ELSE DTSCS68 02126 MOVE SPACES TO MAP-FLD-REP-ID-DSCR DTSCS68 02127 END-IF. DTSCS68 02128 S9330-EXIT. EXIT. DTSCS68 02129 DTSCS68 02130 DTSCS68 02131 S9900-PREPARE-SEND. DTSCS68 02132 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS68 02133 LCCM-SCR-ID. DTSCS68 02134 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS68 02135 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS68 02136 S9900-EXIT. DTSCS68 02137 EXIT. DTSCS68