2139 lines
167 KiB
COBOL
2139 lines
167 KiB
COBOL
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
|