1526 lines
119 KiB
COBOL
1526 lines
119 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/29/09
|
|
00002 PROGRAM-ID. DTSCS11. DTSCS11
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV027
|
|
00004 DATE-WRITTEN. JULY 1994. DTSCS11
|
|
00005 DATE-COMPILED. DTSCS11
|
|
00006 SKIP3 DTSCS11
|
|
00007 ***** DTSCS11
|
|
00008 * DTSCS11
|
|
00009 * FUNCTION: REGISTRATION INQUIRY DTSCS11
|
|
00010 * SCREEN PROCESSOR. DTSCS11
|
|
00011 * DTSCS11
|
|
00012 * DTSCS11
|
|
00013 * MODIFICATION LOG: DTSCS11
|
|
00014 * DTSCS11
|
|
00015 * 07/01/94 INITIAL DEVELOPMENT. DTSCS11
|
|
00016 * WORK ORDER: PROGRAMMER: RHC DTSCS11
|
|
00017 * DTSCS11
|
|
00018 * 01/12/95 CHANGE DPC FROM A NUMBER TO 'Y' FOR YES. DTSCS11
|
|
00019 * WORK ORDER: CR032 PROGRAMMER: RHC DTSCS11
|
|
00020 * DTSCS11
|
|
00021 * 05/21/95 DON'T DEFAULT TO THE WITHDRAWN QUARTER IF THERE DTSCS11
|
|
00022 * IS A QUARTER THAT ISN'T WITHDRAWN. DTSCS11
|
|
00023 * WORK ORDER: CR093 PROGRAMMER: RHC DTSCS11
|
|
00024 * DTSCS11
|
|
00025 * 10/03/95 IF NOT MPRF-WH-OFLT-NO-CONNECT-88, THEN DISPLAY DTSCS11
|
|
00026 * MPRF-WH-OFLT-SEIN ON THE SCREEN. DTSCS11
|
|
00027 * WORK ORDER: JR PROGRAMMER: EHH DTSCS11
|
|
00028 * DTSCS11
|
|
00029 * 05/13/1999 ADDED MAP-PKUP-DUE RELATED PROCESSING. DTSCS11
|
|
00030 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS11
|
|
00031 * DTSCS11
|
|
00032 * 10/28/2004 MODIFIED TO INCLUDE LAST AUDIT YEAR DTSCS11
|
|
00033 * REFERENCE: DC MAINT PROGRAMMER: ZL1 DTSCS11
|
|
00034 * DTSCS11
|
|
00035 * 05/29/2009 CORRECTED PROBLEM WITH LAST AUDIT YEAR. DTSCS11
|
|
00036 * P6909 WAS ONLY EXECUTED IF THERE WAS AN OPEN DTSCS11
|
|
00037 * FIELD ASSIGNMENT, SO IT DID NOT SEE DTSCS11
|
|
00038 * PROCESSED AUDITS. DTSCS11
|
|
00039 * REFERENCE: DC MAINT PROGRAMMER: GD DTSCS11
|
|
00040 * DTSCS11
|
|
00041 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS11
|
|
00042 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS11
|
|
00043 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS11
|
|
00044 * DTSCS11
|
|
00045 * DTSCS11
|
|
00046 * DESCRIPTION: DTSCS11
|
|
00047 * DTSCS11
|
|
00048 * DTSCS11
|
|
00049 * CLEAR: DTSCS11
|
|
00050 * DTSCS11
|
|
00051 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS11
|
|
00052 * DTSCS11
|
|
00053 * DTSCS11
|
|
00054 * JUMP: DTSCS11
|
|
00055 * DTSCS11
|
|
00056 * DTSCS11
|
|
00057 * INQUIRY: DTSCS11
|
|
00058 * DTSCS11
|
|
00059 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS11
|
|
00060 * DTSCS11
|
|
00061 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS11
|
|
00062 * DTSCS11
|
|
00063 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS11
|
|
00064 * DTSCS11
|
|
00065 * F19: DISPLAY DATA ASSOCIATED WITH MAP-PRED-EMP-NO. DTSCS11
|
|
00066 * DTSCS11
|
|
00067 * F20: DISPLAY DATA ASSOCIATED WITH MAP-SUC-EMP-NO. DTSCS11
|
|
00068 * DTSCS11
|
|
00069 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS11
|
|
00070 * DTSCS11
|
|
00071 * DTSCS11
|
|
00072 * UPDATE: DTSCS11
|
|
00073 * DTSCS11
|
|
00074 * N/A. DTSCS11
|
|
00075 * DTSCS11
|
|
00076 * DTSCS11
|
|
00077 * RECORDS READ: DTSCS11
|
|
00078 * DTSCS11
|
|
00079 * MASTER: DTSCS11
|
|
00080 * DTSCS11
|
|
00081 * MPRF DTSCS11
|
|
00082 * MTAD DTSCS11
|
|
00083 * MSOL DTSCS11
|
|
00084 * MREL DTSCS11
|
|
00085 * MAPL DTSCS11
|
|
00086 * MLIN DTSCS11
|
|
00087 * MDPC DTSCS11
|
|
00088 * MFAS DTSCS11
|
|
00089 * MNTE DTSCS11
|
|
00090 * MTAA DTSCS11
|
|
00091 * MOPO DTSCS11
|
|
00092 * MRTE. DTSCS11
|
|
00093 * DTSCS11
|
|
00094 * ALTERNATE INDEX: DTSCS11
|
|
00095 * DTSCS11
|
|
00096 * IPES. DTSCS11
|
|
00097 * DTSCS11
|
|
00098 * REFERENCE: DTSCS11
|
|
00099 * DTSCS11
|
|
00100 * N/A. DTSCS11
|
|
00101 * DTSCS11
|
|
00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCS11
|
|
00103 * DTSCS11
|
|
00104 * N/A. DTSCS11
|
|
00105 * DTSCS11
|
|
00106 * DTSCS11
|
|
00107 * RECORDS UPDATED: DTSCS11
|
|
00108 * DTSCS11
|
|
00109 * MASTER: DTSCS11
|
|
00110 * DTSCS11
|
|
00111 * N/A. DTSCS11
|
|
00112 * DTSCS11
|
|
00113 * REFERENCE: DTSCS11
|
|
00114 * DTSCS11
|
|
00115 * N/A. DTSCS11
|
|
00116 * DTSCS11
|
|
00117 * ACCOUNTING TRANSACTION COLLECTION: DTSCS11
|
|
00118 * DTSCS11
|
|
00119 * N/A. DTSCS11
|
|
00120 * DTSCS11
|
|
00121 * DTSCS11
|
|
00122 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS11
|
|
00123 * DTSCS11
|
|
00124 * N/A. DTSCS11
|
|
00125 * DTSCS11
|
|
00126 * DTSCS11
|
|
00127 * TEMPORARY STORAGE USAGE: DTSCS11
|
|
00128 * DTSCS11
|
|
00129 * N/A. DTSCS11
|
|
00130 * DTSCS11
|
|
00131 * DTSCS11
|
|
00132 * MODULES LINKED TO: DTSCS11
|
|
00133 * DTSCS11
|
|
00134 * DTSCU001 DATE EDIT/CONVERSION. DTSCS11
|
|
00135 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS11
|
|
00136 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS11
|
|
00137 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS11
|
|
00138 * DTSCU038 R&A CODES EDIT/DESCRIPTION. DTSCS11
|
|
00139 * DTSCU039 R&A SIC CODE EDIT/DESCRIPTION. DTSCS11
|
|
00140 * DTSCU056 RATE DISPLAY. DTSCS11
|
|
00141 * DTSCU061 FIELD ZIP / FIELD REP ID. DTSCS11
|
|
00142 * DTSCU062 FIELD ID EDIT/DESCRIPTION. DTSCS11
|
|
00143 * DTSCU810 MASTER FILE I/O DRIVER. DTSCS11
|
|
00144 * DTSCU821 AIX FILE I/O DRIVER. DTSCS11
|
|
00145 * DTSCS11
|
|
00146 * DTSCS11
|
|
00147 * MAINTENANCE NOTES: DTSCS11
|
|
00148 * DTSCS11
|
|
00149 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS11
|
|
00150 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS11
|
|
00151 * ALTER PARAGRAPH S5000, DTSCS11
|
|
00152 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN P6900, DTSCS11
|
|
00153 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS11), DTSCS11
|
|
00154 * ALTER THE MAP (DTSM11) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS11
|
|
00155 * DTSCS11
|
|
00156 * DTSCS11
|
|
00157 * VERMONT REFERENCE: DTSCS11
|
|
00158 * DTSCS11
|
|
00159 * TXC330C. DTSCS11
|
|
00160 * DTSCS11
|
|
00161 ***** DTSCS11
|
|
00162 ENVIRONMENT DIVISION. DTSCS11
|
|
00163 DATA DIVISION. DTSCS11
|
|
00164 EJECT DTSCS11
|
|
00165 WORKING-STORAGE SECTION. DTSCS11
|
|
001655 77 PAN-VALET PICTURE X(24) VALUE '027DTSCS11 05/29/09'. DTSCS11
|
|
00166 DTSCS11
|
|
00167 01 WRK-AREA. DTSCS11
|
|
00168 05 WRK-ABEND-CD PIC X(04) VALUE 'S11 '. DTSCS11
|
|
00169 DTSCS11
|
|
00170 05 WRK-SCR-ID. DTSCS11
|
|
00171 10 WRK-SCR-ID-N PIC 9(02) VALUE 11. DTSCS11
|
|
00172 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS11
|
|
00173 DTSCS11
|
|
00174 05 WRK-SUBSCRIPTS. DTSCS11
|
|
00175 10 HOLD-COUNT PIC S9(04) COMP. DTSCS11
|
|
00176 DTSCS11
|
|
00177 05 HOLD-KEY-AREA PIC X(16). DTSCS11
|
|
00178 DTSCS11
|
|
00179 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS11
|
|
00180 DTSCS11
|
|
00181 05 WRK-MSG-AREA PIC X(62). DTSCS11
|
|
00182 SKIP3 DTSCS11
|
|
00183 05 WRK-LEFT-IN PIC 9(03). DTSCS11
|
|
00184 05 THREE-DIGITS REDEFINES WRK-LEFT-IN. DTSCS11
|
|
00185 10 FILLER PIC X(01). DTSCS11
|
|
00186 88 NOT-TAKE-THREE VALUE '0'. DTSCS11
|
|
00187 10 TWO-DIGITS. DTSCS11
|
|
00188 15 FILLER PIC X(01). DTSCS11
|
|
00189 88 NOT-TAKE-TWO VALUE '0'. DTSCS11
|
|
00190 15 ONE-DIGIT PIC X(01). DTSCS11
|
|
00191 88 NOT-TAKE-ONE VALUE '0'. DTSCS11
|
|
00192 05 WRK-LEFT-OUT PIC X(03). DTSCS11
|
|
00193 DTSCS11
|
|
00194 05 WRK-LAST-AUDIT-YRQ PIC 9(05). DTSCS11
|
|
00195 05 FILLER REDEFINES WRK-LAST-AUDIT-YRQ. DTSCS11
|
|
00196 10 WRK-LAST-AUDIT-CCYY PIC 9(04). DTSCS11
|
|
00197 10 WRK-LAST-AUDIT-Q PIC 9(01). DTSCS11
|
|
00198 SKIP3 DTSCS11
|
|
00199 05 WRK-DISPLAY PIC 9(11). DTSCS11
|
|
00200 05 FILLER REDEFINES WRK-DISPLAY. DTSCS11
|
|
00201 10 FILLER PIC X(05). DTSCS11
|
|
00202 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS11
|
|
00203 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS11
|
|
00204 05 FILLER REDEFINES WRK-DISPLAY. DTSCS11
|
|
00205 10 FILLER PIC X(02). DTSCS11
|
|
00206 10 WRK-DISPLAY-FEIN-1 PIC X(02). DTSCS11
|
|
00207 10 WRK-DISPLAY-FEIN-2 PIC X(07). DTSCS11
|
|
00208 EJECT DTSCS11
|
|
00209 01 SCREEN-CONTROL. DTSCS11
|
|
00210 05 CURSOR-SET-IND PIC X(01). DTSCS11
|
|
00211 88 CURSOR-SET-NO VALUE 'N'. DTSCS11
|
|
00212 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS11
|
|
00213 DTSCS11
|
|
00214 05 REQ-IND PIC X(01). DTSCS11
|
|
00215 88 REQ-ERROR VALUE 'O'. DTSCS11
|
|
00216 88 REQ-JUMP VALUE 'J'. DTSCS11
|
|
00217 88 REQ-CLEAR VALUE 'C'. DTSCS11
|
|
00218 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS11
|
|
00219 88 REQ-INQUIRE VALUE 'I'. DTSCS11
|
|
00220 DTSCS11
|
|
00221 05 RESP-IND PIC X(01). DTSCS11
|
|
00222 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS11
|
|
00223 88 RESP-SEND-MAP VALUE 'M'. DTSCS11
|
|
00224 88 RESP-JUMP VALUE 'J'. DTSCS11
|
|
00225 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS11
|
|
00226 EJECT DTSCS11
|
|
00227 01 L001-COMM-AREA. DTSCS11
|
|
00228 ++INCLUDE DTSIL001 DTSCS11
|
|
00229 EJECT DTSCS11
|
|
00230 01 L004-COMM-AREA. DTSCS11
|
|
00231 ++INCLUDE DTSIL004 DTSCS11
|
|
00232 EJECT DTSCS11
|
|
00233 01 L018-COMM-AREA. DTSCS11
|
|
00234 ++INCLUDE DTSIL018 DTSCS11
|
|
00235 EJECT DTSCS11
|
|
00236 01 L031-COMM-AREA. DTSCS11
|
|
00237 ++INCLUDE DTSIL031 DTSCS11
|
|
00238 EJECT DTSCS11
|
|
00239 01 L056-COMM-AREA. DTSCS11
|
|
00240 ++INCLUDE DTSIL056 DTSCS11
|
|
00241 EJECT DTSCS11
|
|
00242 01 L061-COMM-AREA. DTSCS11
|
|
00243 ++INCLUDE DTSIL061 DTSCS11
|
|
00244 EJECT DTSCS11
|
|
00245 01 L062-COMM-AREA. DTSCS11
|
|
00246 ++INCLUDE DTSIL062 DTSCS11
|
|
00247 EJECT DTSCS11
|
|
00248 01 L410-COMM-AREA. DTSCS11
|
|
00249 ++INCLUDE DTSIL410 DTSCS11
|
|
00250 EJECT DTSCS11
|
|
00251 01 L805-COMM-AREA. DTSCS11
|
|
00252 ++INCLUDE DTSIL805 DTSCS11
|
|
00253 EJECT DTSCS11
|
|
00254 01 L810-COMM-AREA. DTSCS11
|
|
00255 05 L810-CONTROL-BLOCK. DTSCS11
|
|
00256 ++INCLUDE DTSIL810 DTSCS11
|
|
00257 EJECT DTSCS11
|
|
00258 05 MSKL-REC. DTSCS11
|
|
00259 ++INCLUDE DTSIMSKL DTSCS11
|
|
00260 EJECT DTSCS11
|
|
00261 01 MPRF-REC. DTSCS11
|
|
00262 ++INCLUDE DTSIMPRF DTSCS11
|
|
00263 EJECT DTSCS11
|
|
00264 01 MTAD-REC. DTSCS11
|
|
00265 ++INCLUDE DTSIMTAD DTSCS11
|
|
00266 EJECT DTSCS11
|
|
00267 01 MSOL-REC. DTSCS11
|
|
00268 ++INCLUDE DTSIMSOL DTSCS11
|
|
00269 EJECT DTSCS11
|
|
00270 01 MREL-REC. DTSCS11
|
|
00271 ++INCLUDE DTSIMREL DTSCS11
|
|
00272 EJECT DTSCS11
|
|
00273 01 MAPL-REC. DTSCS11
|
|
00274 ++INCLUDE DTSIMAPL DTSCS11
|
|
00275 EJECT DTSCS11
|
|
00276 01 MLIN-REC. DTSCS11
|
|
00277 ++INCLUDE DTSIMLIN DTSCS11
|
|
00278 EJECT DTSCS11
|
|
00279 01 MDPC-REC. DTSCS11
|
|
00280 ++INCLUDE DTSIMDPC DTSCS11
|
|
00281 EJECT DTSCS11
|
|
00282 01 MFAS-REC. DTSCS11
|
|
00283 ++INCLUDE DTSIMFAS DTSCS11
|
|
00284 EJECT DTSCS11
|
|
00285 01 MNTE-REC. DTSCS11
|
|
00286 ++INCLUDE DTSIMNTE DTSCS11
|
|
00287 EJECT DTSCS11
|
|
00288 01 MTAA-REC. DTSCS11
|
|
00289 ++INCLUDE DTSIMTAA DTSCS11
|
|
00290 EJECT DTSCS11
|
|
00291 01 MOPO-REC. DTSCS11
|
|
00292 ++INCLUDE DTSIMOPO DTSCS11
|
|
00293 EJECT DTSCS11
|
|
00294 01 MRTE-REC. DTSCS11
|
|
00295 ++INCLUDE DTSIMRTE DTSCS11
|
|
00296 EJECT DTSCS11
|
|
00297 EJECT DTSCS11
|
|
00298 01 MQTR-REC. DTSCS11
|
|
00299 ++INCLUDE DTSIMQTR DTSCS11
|
|
00300 EJECT DTSCS11
|
|
00301 01 L821-COMM-AREA. DTSCS11
|
|
00302 05 L821-CONTROL-BLOCK. DTSCS11
|
|
00303 ++INCLUDE DTSIL821 DTSCS11
|
|
00304 SKIP3 DTSCS11
|
|
00305 05 ISKL-REC. DTSCS11
|
|
00306 ++INCLUDE DTSIISKL DTSCS11
|
|
00307 SKIP3 DTSCS11
|
|
00308 01 IPES-REC. DTSCS11
|
|
00309 ++INCLUDE DTSIIPES DTSCS11
|
|
00310 EJECT DTSCS11
|
|
00311 01 L851-COMM-AREA. DTSCS11
|
|
00312 ++INCLUDE DTSIL851 DTSCS11
|
|
00313 SKIP3 DTSCS11
|
|
00314 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS11
|
|
00315 ++INCLUDE DTSIS11 DTSCS11
|
|
00316 EJECT DTSCS11
|
|
00317 01 CATB-LITERALS. DTSCS11
|
|
00318 ++INCLUDE DTSICATB DTSCS11
|
|
00319 SKIP3 DTSCS11
|
|
00320 01 CFKD-LITERALS. DTSCS11
|
|
00321 ++INCLUDE DTSICFKD DTSCS11
|
|
00322 EJECT DTSCS11
|
|
00323 01 CECD-LITERALS. DTSCS11
|
|
00324 ++INCLUDE DTSICECD DTSCS11
|
|
00325 EJECT DTSCS11
|
|
00326 LINKAGE SECTION. DTSCS11
|
|
00327 SKIP3 DTSCS11
|
|
00328 01 DFHCOMMAREA. DTSCS11
|
|
00329 ++INCLUDE DTSILCCM DTSCS11
|
|
00330 EJECT DTSCS11
|
|
00331 ******************************************************************DTSCS11
|
|
00332 * *DTSCS11
|
|
00333 ******************************************************************DTSCS11
|
|
00334 DTSCS11
|
|
00335 PROCEDURE DIVISION. DTSCS11
|
|
00336 DTSCS11
|
|
00337 MOVE +0 TO WRK-EMP-NO. DTSCS11
|
|
00338 DTSCS11
|
|
00339 MOVE LOW-VALUES TO MAP-AREA. DTSCS11
|
|
00340 SET CURSOR-SET-NO TO TRUE. DTSCS11
|
|
00341 DTSCS11
|
|
00342 MOVE SPACE TO REQ-IND. DTSCS11
|
|
00343 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS11
|
|
00344 DTSCS11
|
|
00345 *----------------------------------------------------- DTSCS11
|
|
00346 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS11
|
|
00347 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS11
|
|
00348 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS11
|
|
00349 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS11
|
|
00350 * DTSCS11
|
|
00351 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS11
|
|
00352 * PROCESSED. DTSCS11
|
|
00353 * DTSCS11
|
|
00354 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS11
|
|
00355 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS11
|
|
00356 * WORK STATION OPERATOR. DTSCS11
|
|
00357 *----------------------------------------------------- DTSCS11
|
|
00358 DTSCS11
|
|
00359 MOVE SPACE TO RESP-IND. DTSCS11
|
|
00360 DTSCS11
|
|
00361 IF REQ-ERROR DTSCS11
|
|
00362 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS11
|
|
00363 ELSE DTSCS11
|
|
00364 IF REQ-JUMP DTSCS11
|
|
00365 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS11
|
|
00366 ELSE DTSCS11
|
|
00367 IF REQ-CLEAR DTSCS11
|
|
00368 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS11
|
|
00369 ELSE DTSCS11
|
|
00370 IF REQ-CURSOR-TO-GOTO DTSCS11
|
|
00371 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS11
|
|
00372 ELSE DTSCS11
|
|
00373 IF REQ-INQUIRE DTSCS11
|
|
00374 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS11
|
|
00375 ELSE DTSCS11
|
|
00376 GO TO S899-ABEND. DTSCS11
|
|
00377 SKIP3 DTSCS11
|
|
00378 *----------------------------------------------------- DTSCS11
|
|
00379 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS11
|
|
00380 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS11
|
|
00381 *----------------------------------------------------- DTSCS11
|
|
00382 DTSCS11
|
|
00383 IF RESP-SEND-MAP DTSCS11
|
|
00384 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS11
|
|
00385 SET LCCM-END-TASK-88 TO TRUE DTSCS11
|
|
00386 ELSE DTSCS11
|
|
00387 IF RESP-SEND-MSGONLY DTSCS11
|
|
00388 OR RESP-CURSOR-TO-GOTO DTSCS11
|
|
00389 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS11
|
|
00390 SET LCCM-END-TASK-88 TO TRUE DTSCS11
|
|
00391 ELSE DTSCS11
|
|
00392 IF RESP-JUMP DTSCS11
|
|
00393 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS11
|
|
00394 ELSE DTSCS11
|
|
00395 GO TO S899-ABEND. DTSCS11
|
|
00396 SKIP3 DTSCS11
|
|
00397 MAINLINE-EXIT. DTSCS11
|
|
00398 DTSCS11
|
|
00399 EXEC CICS DTSCS11
|
|
00400 RETURN DTSCS11
|
|
00401 END-EXEC. DTSCS11
|
|
00402 DTSCS11
|
|
00403 * GOBACK. DTSCS11
|
|
00404 /*****************************************************************DTSCS11
|
|
00405 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS11
|
|
00406 ******************************************************************DTSCS11
|
|
00407 P1000-ANALYZE-REQUEST. DTSCS11
|
|
00408 DTSCS11
|
|
00409 *----------------------------------------------------- DTSCS11
|
|
00410 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS11
|
|
00411 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS11
|
|
00412 * REPLACED WITH ENTER) DTSCS11
|
|
00413 *----------------------------------------------------- DTSCS11
|
|
00414 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS11
|
|
00415 SET LCCM-ENTER-88 TO TRUE DTSCS11
|
|
00416 IF LCCM-EMP-NO > ZERO DTSCS11
|
|
00417 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS11
|
|
00418 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS11
|
|
00419 END-IF DTSCS11
|
|
00420 SET REQ-INQUIRE TO TRUE DTSCS11
|
|
00421 GO TO P1000-EXIT. DTSCS11
|
|
00422 SKIP3 DTSCS11
|
|
00423 *----------------------------------------------------- DTSCS11
|
|
00424 * MAP IS RECEIVED DTSCS11
|
|
00425 *----------------------------------------------------- DTSCS11
|
|
00426 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS11
|
|
00427 SKIP3 DTSCS11
|
|
00428 *----------------------------------------------------- DTSCS11
|
|
00429 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS11
|
|
00430 * WORK STATION DTSCS11
|
|
00431 *----------------------------------------------------- DTSCS11
|
|
00432 IF LCCM-CLEAR-88 DTSCS11
|
|
00433 SET REQ-CLEAR TO TRUE DTSCS11
|
|
00434 GO TO P1000-EXIT. DTSCS11
|
|
00435 SKIP3 DTSCS11
|
|
00436 *----------------------------------------------------- DTSCS11
|
|
00437 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS11
|
|
00438 *----------------------------------------------------- DTSCS11
|
|
00439 IF LCCM-PA2-88 DTSCS11
|
|
00440 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS11
|
|
00441 GO TO P1000-EXIT. DTSCS11
|
|
00442 SKIP3 DTSCS11
|
|
00443 *----------------------------------------------------- DTSCS11
|
|
00444 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS11
|
|
00445 *----------------------------------------------------- DTSCS11
|
|
00446 IF LCCM-PA-88 DTSCS11
|
|
00447 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS11
|
|
00448 SET REQ-ERROR TO TRUE DTSCS11
|
|
00449 GO TO P1000-EXIT. DTSCS11
|
|
00450 SKIP3 DTSCS11
|
|
00451 *----------------------------------------------------- DTSCS11
|
|
00452 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS11
|
|
00453 * REQUEST TO CLEAR THE SCREEN. DTSCS11
|
|
00454 *----------------------------------------------------- DTSCS11
|
|
00455 IF LCCM-F12-88 DTSCS11
|
|
00456 MOVE LOW-VALUES TO MAP-AREA DTSCS11
|
|
00457 SET REQ-CLEAR TO TRUE DTSCS11
|
|
00458 GO TO P1000-EXIT. DTSCS11
|
|
00459 SKIP3 DTSCS11
|
|
00460 *----------------------------------------------------- DTSCS11
|
|
00461 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS11
|
|
00462 *----------------------------------------------------- DTSCS11
|
|
00463 IF LCCM-F03-88 DTSCS11
|
|
00464 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS11
|
|
00465 SET REQ-JUMP TO TRUE DTSCS11
|
|
00466 GO TO P1000-EXIT. DTSCS11
|
|
00467 SKIP3 DTSCS11
|
|
00468 *----------------------------------------------------- DTSCS11
|
|
00469 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS11
|
|
00470 *----------------------------------------------------- DTSCS11
|
|
00471 IF LCCM-F04-88 DTSCS11
|
|
00472 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS11
|
|
00473 SET REQ-JUMP TO TRUE DTSCS11
|
|
00474 GO TO P1000-EXIT. DTSCS11
|
|
00475 SKIP3 DTSCS11
|
|
00476 *----------------------------------------------------- DTSCS11
|
|
00477 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS11
|
|
00478 * CORRESPONDENCE SCREEN DTSCS11
|
|
00479 *----------------------------------------------------- DTSCS11
|
|
00480 IF LCCM-F14-88 DTSCS11
|
|
00481 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS11
|
|
00482 SET REQ-JUMP TO TRUE DTSCS11
|
|
00483 GO TO P1000-EXIT. DTSCS11
|
|
00484 SKIP3 DTSCS11
|
|
00485 *----------------------------------------------------- DTSCS11
|
|
00486 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS11
|
|
00487 * REQUESTED SCREEN TYPE DTSCS11
|
|
00488 *----------------------------------------------------- DTSCS11
|
|
00489 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS11
|
|
00490 NEXT SENTENCE DTSCS11
|
|
00491 ELSE DTSCS11
|
|
00492 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS11
|
|
00493 SET REQ-JUMP TO TRUE DTSCS11
|
|
00494 GO TO P1000-EXIT. DTSCS11
|
|
00495 SKIP3 DTSCS11
|
|
00496 *----------------------------------------------------- DTSCS11
|
|
00497 * IF INQUIRY TYPE KEY PRESSED (ENTER, F19, OR F20) DTSCS11
|
|
00498 * INDICATE INQUIRY REQUEST DTSCS11
|
|
00499 *----------------------------------------------------- DTSCS11
|
|
00500 IF LCCM-ENTER-88 OR LCCM-F19-88 OR LCCM-F20-88 DTSCS11
|
|
00501 SET REQ-INQUIRE TO TRUE DTSCS11
|
|
00502 GO TO P1000-EXIT. DTSCS11
|
|
00503 SKIP3 DTSCS11
|
|
00504 *----------------------------------------------------- DTSCS11
|
|
00505 * ANY OTHER KEY IS INVALID DTSCS11
|
|
00506 *----------------------------------------------------- DTSCS11
|
|
00507 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS11
|
|
00508 SET REQ-ERROR TO TRUE. DTSCS11
|
|
00509 P1000-EXIT. EXIT. DTSCS11
|
|
00510 /*****************************************************************DTSCS11
|
|
00511 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS11
|
|
00512 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS11
|
|
00513 ******************************************************************DTSCS11
|
|
00514 DTSCS11
|
|
00515 P2000-REQUEST-ERROR. DTSCS11
|
|
00516 IF LCCM-MSG DTSCS11
|
|
00517 SET RESP-SEND-MSGONLY TO TRUE DTSCS11
|
|
00518 ELSE DTSCS11
|
|
00519 GO TO S899-ABEND. DTSCS11
|
|
00520 P2000-EXIT. EXIT. DTSCS11
|
|
00521 /*****************************************************************DTSCS11
|
|
00522 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS11
|
|
00523 ******************************************************************DTSCS11
|
|
00524 DTSCS11
|
|
00525 P3000-REQUEST-JUMP. DTSCS11
|
|
00526 *----------------------------------------------------- DTSCS11
|
|
00527 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS11
|
|
00528 * BY USER DTSCS11
|
|
00529 *----------------------------------------------------- DTSCS11
|
|
00530 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS11
|
|
00531 SKIP3 DTSCS11
|
|
00532 *----------------------------------------------------- DTSCS11
|
|
00533 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS11
|
|
00534 *----------------------------------------------------- DTSCS11
|
|
00535 IF LCCM-MSG DTSCS11
|
|
00536 SET CURSOR-SET-GOTO TO TRUE DTSCS11
|
|
00537 SET RESP-SEND-MSGONLY TO TRUE DTSCS11
|
|
00538 GO TO P3000-EXIT. DTSCS11
|
|
00539 SKIP3 DTSCS11
|
|
00540 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS11
|
|
00541 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT. DTSCS11
|
|
00542 IF L018-VALID DTSCS11
|
|
00543 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS11
|
|
00544 SKIP3 DTSCS11
|
|
00545 *----------------------------------------------------- DTSCS11
|
|
00546 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS11
|
|
00547 *----------------------------------------------------- DTSCS11
|
|
00548 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS11
|
|
00549 LCCM-SCR-HOLD-AREA. DTSCS11
|
|
00550 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS11
|
|
00551 SET RESP-JUMP TO TRUE. DTSCS11
|
|
00552 P3000-EXIT. EXIT. DTSCS11
|
|
00553 /*****************************************************************DTSCS11
|
|
00554 * CLEAR KEY WAS PRESSED *DTSCS11
|
|
00555 ******************************************************************DTSCS11
|
|
00556 DTSCS11
|
|
00557 P4000-REQUEST-CLEAR. DTSCS11
|
|
00558 SET LCCM-SCR-CLEAR TO TRUE. DTSCS11
|
|
00559 DTSCS11
|
|
00560 PERFORM S5000-SET-INQ-ATTRB THRU S5000-EXIT. DTSCS11
|
|
00561 SKIP3 DTSCS11
|
|
00562 *----------------------------------------------------- DTSCS11
|
|
00563 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS11
|
|
00564 * FIELDS FROM EARLIER REQUESTS DTSCS11
|
|
00565 *----------------------------------------------------- DTSCS11
|
|
00566 IF LCCM-EMP-NO > ZERO DTSCS11
|
|
00567 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS11
|
|
00568 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS11
|
|
00569 MOVE ZERO TO LCCM-EMP-NO. DTSCS11
|
|
00570 DTSCS11
|
|
00571 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS11
|
|
00572 SET RESP-SEND-MAP TO TRUE. DTSCS11
|
|
00573 P4000-EXIT. EXIT. DTSCS11
|
|
00574 /*****************************************************************DTSCS11
|
|
00575 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS11
|
|
00576 ******************************************************************DTSCS11
|
|
00577 DTSCS11
|
|
00578 P5000-CURSOR-TO-GOTO. DTSCS11
|
|
00579 SET CURSOR-SET-GOTO TO TRUE. DTSCS11
|
|
00580 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS11
|
|
00581 P5000-EXIT. EXIT. DTSCS11
|
|
00582 /*****************************************************************DTSCS11
|
|
00583 * INQUIRY WAS REQUESTED *DTSCS11
|
|
00584 * F19 IS A REQUEST TO DISPLAY THE PREDECESSOR DTSCS11
|
|
00585 * F20 IS A REQUEST TO DISPLAY THE SUCCESSOR DTSCS11
|
|
00586 ******************************************************************DTSCS11
|
|
00587 DTSCS11
|
|
00588 P6000-REQUEST-INQUIRE. DTSCS11
|
|
00589 IF LCCM-F19-88 DTSCS11
|
|
00590 SET LCCM-ENTER-88 TO TRUE DTSCS11
|
|
00591 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS11
|
|
00592 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT DTSCS11
|
|
00593 IF L018-VALID DTSCS11
|
|
00594 MOVE MAP-PRED-EMP-NO-AREA TO MAP-EMP-NO-AREA DTSCS11
|
|
00595 END-IF DTSCS11
|
|
00596 ELSE DTSCS11
|
|
00597 IF LCCM-F20-88 DTSCS11
|
|
00598 SET LCCM-ENTER-88 TO TRUE DTSCS11
|
|
00599 MOVE MAP-SUC-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS11
|
|
00600 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT DTSCS11
|
|
00601 IF L018-VALID DTSCS11
|
|
00602 MOVE MAP-SUC-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS11
|
|
00603 DTSCS11
|
|
00604 SET RESP-SEND-MAP TO TRUE. DTSCS11
|
|
00605 DTSCS11
|
|
00606 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS11
|
|
00607 MOVE LOW-VALUES TO MAP-AREA. DTSCS11
|
|
00608 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS11
|
|
00609 DTSCS11
|
|
00610 PERFORM S5000-SET-INQ-ATTRB THRU S5000-EXIT. DTSCS11
|
|
00611 DTSCS11
|
|
00612 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS11
|
|
00613 DTSCS11
|
|
00614 SET LCCM-SCR-CLEAR TO TRUE. DTSCS11
|
|
00615 DTSCS11
|
|
00616 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS11
|
|
00617 IF LCCM-MSG DTSCS11
|
|
00618 GO TO P6000-EXIT. DTSCS11
|
|
00619 DTSCS11
|
|
00620 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS11
|
|
00621 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00622 SET MSKL-PRF-88 TO TRUE. DTSCS11
|
|
00623 PERFORM S810-READ THRU S810-EXIT. DTSCS11
|
|
00624 IF L810-OK-88 DTSCS11
|
|
00625 MOVE MSKL-REC TO MPRF-REC DTSCS11
|
|
00626 ELSE DTSCS11
|
|
00627 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS11
|
|
00628 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS11
|
|
00629 GO TO P6000-EXIT. DTSCS11
|
|
00630 DTSCS11
|
|
00631 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS11
|
|
00632 DTSCS11
|
|
00633 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS11
|
|
00634 DTSCS11
|
|
00635 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS11
|
|
00636 P6000-EXIT. EXIT. DTSCS11
|
|
00637 /*****************************************************************DTSCS11
|
|
00638 * THE MPRF RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS11
|
|
00639 ******************************************************************DTSCS11
|
|
00640 DTSCS11
|
|
00641 P6900-CONSTRUCT-SCREEN. DTSCS11
|
|
00642 PERFORM P6901-FROM-MPRF THRU P6901-EXIT. DTSCS11
|
|
00643 PERFORM P6902-FROM-MTAD THRU P6902-EXIT. DTSCS11
|
|
00644 PERFORM P6903-FROM-MSOL THRU P6903-EXIT. DTSCS11
|
|
00645 PERFORM P6904-FROM-MREL THRU P6904-EXIT. DTSCS11
|
|
00646 PERFORM P6905-FROM-IPES THRU P6905-EXIT. DTSCS11
|
|
00647 DTSCS11
|
|
00648 IF MPRF-MAPL-EXISTS-88 DTSCS11
|
|
00649 PERFORM P6906-FROM-MAPL THRU P6906-EXIT. DTSCS11
|
|
00650 DTSCS11
|
|
00651 IF MPRF-MLIN-EXISTS-88 DTSCS11
|
|
00652 PERFORM P6907-FROM-MLIN THRU P6907-EXIT. DTSCS11
|
|
00653 DTSCS11
|
|
00654 IF MPRF-MDPC-EXISTS-88 DTSCS11
|
|
00655 PERFORM P6908-FROM-MDPC THRU P6908-EXIT. DTSCS11
|
|
00656 DTSCS11
|
|
00657 *** IF MPRF-MFAS-EXISTS-88 DTSCS11
|
|
00658 PERFORM P6909-FROM-MFAS THRU P6909-EXIT. DTSCS11
|
|
00659 DTSCS11
|
|
00660 PERFORM P6910-FROM-MNTE THRU P6910-EXIT. DTSCS11
|
|
00661 PERFORM P6911-FROM-MTAA THRU P6911-EXIT. DTSCS11
|
|
00662 PERFORM P6912-FROM-MOPO THRU P6912-EXIT. DTSCS11
|
|
00663 PERFORM P6913-FROM-MRTE THRU P6913-EXIT. DTSCS11
|
|
00664 PERFORM P6914-FROM-MQTR THRU P6914-EXIT. DTSCS11
|
|
00665 P6900-EXIT. EXIT. DTSCS11
|
|
00666 SKIP3 DTSCS11
|
|
00667 P6901-FROM-MPRF. DTSCS11
|
|
00668 MOVE MPRF-EMP-CLASS TO L031-CD. DTSCS11
|
|
00669 SET L031-MPRF-EMP-CLASS TO TRUE. DTSCS11
|
|
00670 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11
|
|
00671 MOVE L031-SHORT-DSCR TO MAP-CLASS. DTSCS11
|
|
00672 DTSCS11
|
|
00673 MOVE MPRF-EMP-STATUS TO L031-CD. DTSCS11
|
|
00674 SET L031-MPRF-EMP-STATUS TO TRUE. DTSCS11
|
|
00675 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11
|
|
00676 MOVE L031-SHORT-DSCR TO MAP-STATUS. DTSCS11
|
|
00677 DTSCS11
|
|
00678 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS11
|
|
00679 IF MPRF-ENTITY-NAME NOT = SPACES DTSCS11
|
|
00680 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. DTSCS11
|
|
00681 DTSCS11
|
|
00682 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSCS11
|
|
00683 MOVE MPRF-FLD-ST TO L061-FLD-ST. DTSCS11
|
|
00684 MOVE WRK-EMP-NO TO L061-EMP-NO. DTSCS11
|
|
00685 PERFORM S061-FLD-ZIP THRU S061-EXIT. DTSCS11
|
|
00686 MOVE L061-FLD-REP-ID TO MAP-FLD-REP DTSCS11
|
|
00687 L062-FLD-REP-ID. DTSCS11
|
|
00688 PERFORM S062-DESC-FLD THRU S062-EXIT. DTSCS11
|
|
00689 MOVE L062-NAME TO MAP-FLD-REP-NAME. DTSCS11
|
|
00690 DTSCS11
|
|
00691 DTSCS11
|
|
00692 MOVE MPRF-ORG-TYPE TO MAP-ORG-TYPE DTSCS11
|
|
00693 L031-CD. DTSCS11
|
|
00694 SET L031-MPRF-ORG-TYPE TO TRUE. DTSCS11
|
|
00695 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11
|
|
00696 MOVE L031-SHORT-DSCR TO MAP-ORG-TYPE-DESC. DTSCS11
|
|
00697 DTSCS11
|
|
00698 IF MPRF-FEIN NOT = +0 DTSCS11
|
|
00699 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS11
|
|
00700 MOVE WRK-DISPLAY-FEIN-1 TO MAP-FEIN-1 DTSCS11
|
|
00701 MOVE WRK-DISPLAY-FEIN-2 TO MAP-FEIN-2. DTSCS11
|
|
00702 DTSCS11
|
|
00703 IF MPRF-DC-BUSINESS-TAX-ACCT-NO NOT = +0 DTSCS11
|
|
00704 MOVE MPRF-DC-BUSINESS-TAX-ACCT-NO DTSCS11
|
|
00705 TO MAP-BTN. DTSCS11
|
|
00706 DTSCS11
|
|
00707 IF MPRF-WRITE-OFF-DATE NOT = +0 DTSCS11
|
|
00708 MOVE 'Y' TO MAP-WRITE-OFF. DTSCS11
|
|
00709 DTSCS11
|
|
00710 IF MPRF-PURSUED-RPT-CNT > +0 DTSCS11
|
|
00711 OR MPRF-TOT-BALANCE-AMT > +0 DTSCS11
|
|
00712 MOVE 'Y' TO MAP-COL. DTSCS11
|
|
00713 DTSCS11
|
|
00714 IF MPRF-TOT-CREDIT-AMT NOT = +0 DTSCS11
|
|
00715 MOVE 'Y' TO MAP-CREDIT. DTSCS11
|
|
00716 DTSCS11
|
|
00717 IF MPRF-BANKRP-OPEN-88 DTSCS11
|
|
00718 MOVE 'Y' TO MAP-OPEN-BNK. DTSCS11
|
|
00719 DTSCS11
|
|
00720 MOVE MPRF-PURGE-IND TO MAP-PURGE. DTSCS11
|
|
00721 DTSCS11
|
|
00722 DTSCS11
|
|
00723 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS11
|
|
00724 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS11
|
|
00725 IF L410-ANN-SCHED-88 DTSCS11
|
|
00726 MOVE 'ANNUAL FILER ' TO MAP-FILER DTSCS11
|
|
00727 ELSE DTSCS11
|
|
00728 IF L410-QTRLY-SCHED-88 DTSCS11
|
|
00729 MOVE 'QUARTERLY FILER' TO MAP-FILER DTSCS11
|
|
00730 ELSE DTSCS11
|
|
00731 IF L410-PENDING-SCHED-88 DTSCS11
|
|
00732 MOVE 'PENDING ' TO MAP-FILER DTSCS11
|
|
00733 ELSE DTSCS11
|
|
00734 MOVE SPACES TO MAP-FILER DTSCS11
|
|
00735 END-IF DTSCS11
|
|
00736 END-IF. DTSCS11
|
|
00737 DTSCS11
|
|
00738 P6901-EXIT. EXIT. DTSCS11
|
|
00739 SKIP3 DTSCS11
|
|
00740 P6902-FROM-MTAD. DTSCS11
|
|
00741 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSCS11
|
|
00742 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS11
|
|
00743 SET MTAD-TAD-88 TO TRUE. DTSCS11
|
|
00744 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS11
|
|
00745 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS11
|
|
00746 PERFORM S810-READ THRU S810-EXIT. DTSCS11
|
|
00747 IF L810-OK-88 DTSCS11
|
|
00748 MOVE MSKL-REC TO MTAD-REC DTSCS11
|
|
00749 MOVE MTAD-ATTN-LINE TO MAP-1-ATTN-LINE DTSCS11
|
|
00750 MOVE MTAD-DELIV-LINE-1 TO MAP-1-DELIV-LINE-1 DTSCS11
|
|
00751 MOVE MTAD-DELIV-LINE-2 TO MAP-1-DELIV-LINE-2 DTSCS11
|
|
00752 MOVE MTAD-CITY TO MAP-1-CITY DTSCS11
|
|
00753 MOVE MTAD-ST TO MAP-1-ST DTSCS11
|
|
00754 MOVE MTAD-ZIP TO MAP-1-ZIP. DTSCS11
|
|
00755 DTSCS11
|
|
00756 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSCS11
|
|
00757 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS11
|
|
00758 SET MTAD-TAD-88 TO TRUE. DTSCS11
|
|
00759 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSCS11
|
|
00760 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS11
|
|
00761 PERFORM S810-READ THRU S810-EXIT. DTSCS11
|
|
00762 IF L810-OK-88 DTSCS11
|
|
00763 MOVE MSKL-REC TO MTAD-REC DTSCS11
|
|
00764 MOVE MTAD-ATTN-LINE TO MAP-2-ATTN-LINE DTSCS11
|
|
00765 MOVE MTAD-DELIV-LINE-1 TO MAP-2-DELIV-LINE-1 DTSCS11
|
|
00766 MOVE MTAD-DELIV-LINE-2 TO MAP-2-DELIV-LINE-2 DTSCS11
|
|
00767 MOVE MTAD-CITY TO MAP-2-CITY DTSCS11
|
|
00768 MOVE MTAD-ST TO MAP-2-ST DTSCS11
|
|
00769 MOVE MTAD-ZIP TO MAP-2-ZIP. DTSCS11
|
|
00770 DTSCS11
|
|
00771 P6902-EXIT. EXIT. DTSCS11
|
|
00772 SKIP3 DTSCS11
|
|
00773 P6903-FROM-MSOL. DTSCS11
|
|
00774 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
00775 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00776 SET MSKL-SOL-88 TO TRUE. DTSCS11
|
|
00777 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11
|
|
00778 MOVE WRK-LEFT-OUT TO MAP-SPANS. DTSCS11
|
|
00779 DTSCS11
|
|
00780 IF L810-RECORD-CNT = +0 DTSCS11
|
|
00781 GO TO P6903-EXIT. DTSCS11
|
|
00782 DTSCS11
|
|
00783 PERFORM S810-READ THRU S810-EXIT. DTSCS11
|
|
00784 MOVE MSKL-REC TO MSOL-REC. DTSCS11
|
|
00785 IF MSOL-INACT-WITHDRAWN-88 DTSCS11
|
|
00786 AND WRK-LEFT-IN > 1 DTSCS11
|
|
00787 PERFORM P6903A-LOCATE-MSOL THRU P6903A-EXIT. DTSCS11
|
|
00788 SKIP3 DTSCS11
|
|
00789 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9. DTSCS11
|
|
00790 SET L001-FROM-FED-8 TO TRUE. DTSCS11
|
|
00791 PERFORM S001-EDIT-DATE THRU S001-EXIT. DTSCS11
|
|
00792 MOVE L001-SLASH-DATE TO MAP-LIAB. DTSCS11
|
|
00793 DTSCS11
|
|
00794 IF MSOL-FIRST-LIAB-YRQ NOT = +0 DTSCS11
|
|
00795 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCS11
|
|
00796 SET L004-FROM-5 TO TRUE DTSCS11
|
|
00797 PERFORM S004-EDIT-QTR THRU S004-EXIT DTSCS11
|
|
00798 MOVE L004-SLASH-QTR TO MAP-LIAB-QTR. DTSCS11
|
|
00799 DTSCS11
|
|
00800 MOVE MSOL-LIAB-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS11
|
|
00801 SET L001-FROM-FED-8 TO TRUE. DTSCS11
|
|
00802 PERFORM S001-EDIT-DATE THRU S001-EXIT. DTSCS11
|
|
00803 MOVE L001-SLASH-DATE TO MAP-LIAB-ESTB. DTSCS11
|
|
00804 DTSCS11
|
|
00805 MOVE MSOL-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS11
|
|
00806 SET L001-FROM-FED-8 TO TRUE. DTSCS11
|
|
00807 PERFORM S001-EDIT-DATE THRU S001-EXIT. DTSCS11
|
|
00808 MOVE L001-SLASH-DATE TO MAP-LIAB-ENTRY. DTSCS11
|
|
00809 DTSCS11
|
|
00810 MOVE MSOL-LIAB-CD TO MAP-LIAB-CD DTSCS11
|
|
00811 L031-CD. DTSCS11
|
|
00812 SET L031-MSOL-LIAB-CD TO TRUE. DTSCS11
|
|
00813 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11
|
|
00814 MOVE L031-SHORT-DSCR TO MAP-LIAB-DESC. DTSCS11
|
|
00815 DTSCS11
|
|
00816 IF MSOL-INACT-ACTIVE-88 DTSCS11
|
|
00817 NEXT SENTENCE DTSCS11
|
|
00818 ELSE DTSCS11
|
|
00819 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 DTSCS11
|
|
00820 SET L001-FROM-FED-8 TO TRUE DTSCS11
|
|
00821 PERFORM S001-EDIT-DATE THRU S001-EXIT DTSCS11
|
|
00822 MOVE L001-SLASH-DATE TO MAP-INAC DTSCS11
|
|
00823 DTSCS11
|
|
00824 IF MSOL-LAST-LIAB-YRQ NOT = +0 DTSCS11
|
|
00825 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSCS11
|
|
00826 SET L004-FROM-5 TO TRUE DTSCS11
|
|
00827 PERFORM S004-EDIT-QTR THRU S004-EXIT DTSCS11
|
|
00828 MOVE L004-SLASH-QTR TO MAP-INAC-QTR. DTSCS11
|
|
00829 DTSCS11
|
|
00830 IF MSOL-INACT-ACTIVE-88 DTSCS11
|
|
00831 NEXT SENTENCE DTSCS11
|
|
00832 ELSE DTSCS11
|
|
00833 IF MSOL-INACT-ENTER-DATE NOT = +0 DTSCS11
|
|
00834 MOVE MSOL-INACT-ENTER-DATE TO L001-FED-8-DATE-9 DTSCS11
|
|
00835 SET L001-FROM-FED-8 TO TRUE DTSCS11
|
|
00836 PERFORM S001-EDIT-DATE THRU S001-EXIT DTSCS11
|
|
00837 MOVE L001-SLASH-DATE TO MAP-INAC-ENTRY. DTSCS11
|
|
00838 DTSCS11
|
|
00839 MOVE MSOL-INACT-CD TO MAP-INAC-CD DTSCS11
|
|
00840 L031-CD. DTSCS11
|
|
00841 SET L031-MSOL-INACT-CD TO TRUE. DTSCS11
|
|
00842 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11
|
|
00843 MOVE L031-SHORT-DSCR TO MAP-INAC-DESC. DTSCS11
|
|
00844 P6903-EXIT. EXIT. DTSCS11
|
|
00845 SKIP3 DTSCS11
|
|
00846 P6903A-LOCATE-MSOL. DTSCS11
|
|
00847 MOVE MSKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS11
|
|
00848 DTSCS11
|
|
00849 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11
|
|
00850 MOVE MSKL-REC TO MSOL-REC. DTSCS11
|
|
00851 DTSCS11
|
|
00852 PERFORM UNTIL L810-NO-REC-88 DTSCS11
|
|
00853 OR NOT MSOL-INACT-WITHDRAWN-88 DTSCS11
|
|
00854 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS11
|
|
00855 MOVE MSKL-REC TO MSOL-REC DTSCS11
|
|
00856 END-PERFORM. DTSCS11
|
|
00857 DTSCS11
|
|
00858 IF L810-OK-88 DTSCS11
|
|
00859 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11
|
|
00860 ELSE DTSCS11
|
|
00861 MOVE HOLD-KEY-AREA TO MSKL-KEY-AREA DTSCS11
|
|
00862 PERFORM S810-READ THRU S810-EXIT DTSCS11
|
|
00863 MOVE MSKL-REC TO MSOL-REC. DTSCS11
|
|
00864 P6903A-EXIT. EXIT. DTSCS11
|
|
00865 SKIP3 DTSCS11
|
|
00866 P6904-FROM-MREL. DTSCS11
|
|
00867 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
00868 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00869 SET MSKL-REL-88 TO TRUE. DTSCS11
|
|
00870 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11
|
|
00871 MOVE WRK-LEFT-OUT TO MAP-PRED. DTSCS11
|
|
00872 DTSCS11
|
|
00873 IF L810-RECORD-CNT NOT = +0 DTSCS11
|
|
00874 MOVE MSKL-KEY-AREA TO MREL-KEY-AREA DTSCS11
|
|
00875 MOVE MREL-PRED-EMP-NO TO WRK-DISPLAY DTSCS11
|
|
00876 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-EMP-NO-1 DTSCS11
|
|
00877 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-EMP-NO-2. DTSCS11
|
|
00878 P6904-EXIT. EXIT. DTSCS11
|
|
00879 SKIP3 DTSCS11
|
|
00880 P6905-FROM-IPES. DTSCS11
|
|
00881 MOVE LOW-VALUE TO IPES-KEY-AREA. DTSCS11
|
|
00882 SET IPES-PES-88 TO TRUE. DTSCS11
|
|
00883 MOVE WRK-EMP-NO TO IPES-PRED-EMP-NO. DTSCS11
|
|
00884 MOVE IPES-REC TO ISKL-REC. DTSCS11
|
|
00885 DTSCS11
|
|
00886 MOVE 0 TO WRK-LEFT-IN. DTSCS11
|
|
00887 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS11
|
|
00888 DTSCS11
|
|
00889 PERFORM UNTIL L821-NO-REC-88 DTSCS11
|
|
00890 MOVE ISKL-REC TO IPES-REC DTSCS11
|
|
00891 IF IPES-PRED-EMP-NO = WRK-EMP-NO DTSCS11
|
|
00892 ADD 1 TO WRK-LEFT-IN DTSCS11
|
|
00893 MOVE IPES-SUC-EMP-NO TO WRK-DISPLAY DTSCS11
|
|
00894 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS11
|
|
00895 ELSE DTSCS11
|
|
00896 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS11
|
|
00897 SET L821-NO-REC-88 TO TRUE DTSCS11
|
|
00898 END-IF DTSCS11
|
|
00899 END-PERFORM. DTSCS11
|
|
00900 DTSCS11
|
|
00901 IF WRK-LEFT-IN NOT = 0 DTSCS11
|
|
00902 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT DTSCS11
|
|
00903 MOVE WRK-LEFT-OUT TO MAP-SUC DTSCS11
|
|
00904 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-SUC-EMP-NO-1 DTSCS11
|
|
00905 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-SUC-EMP-NO-2. DTSCS11
|
|
00906 P6905-EXIT. EXIT. DTSCS11
|
|
00907 SKIP3 DTSCS11
|
|
00908 P6906-FROM-MAPL. DTSCS11
|
|
00909 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
00910 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00911 SET MSKL-APL-88 TO TRUE. DTSCS11
|
|
00912 DTSCS11
|
|
00913 MOVE 0 TO WRK-LEFT-IN. DTSCS11
|
|
00914 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11
|
|
00915 DTSCS11
|
|
00916 PERFORM UNTIL L810-NO-REC-88 DTSCS11
|
|
00917 MOVE MSKL-REC TO MAPL-REC DTSCS11
|
|
00918 IF MAPL-STATUS-OPEN-88 DTSCS11
|
|
00919 ADD 1 TO WRK-LEFT-IN DTSCS11
|
|
00920 END-IF DTSCS11
|
|
00921 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11
|
|
00922 END-PERFORM. DTSCS11
|
|
00923 DTSCS11
|
|
00924 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11
|
|
00925 MOVE WRK-LEFT-OUT TO MAP-OPEN-APL. DTSCS11
|
|
00926 P6906-EXIT. EXIT. DTSCS11
|
|
00927 SKIP3 DTSCS11
|
|
00928 P6907-FROM-MLIN. DTSCS11
|
|
00929 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
00930 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00931 SET MSKL-LIN-88 TO TRUE. DTSCS11
|
|
00932 DTSCS11
|
|
00933 MOVE 0 TO WRK-LEFT-IN. DTSCS11
|
|
00934 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11
|
|
00935 DTSCS11
|
|
00936 PERFORM UNTIL L810-NO-REC-88 DTSCS11
|
|
00937 MOVE MSKL-REC TO MLIN-REC DTSCS11
|
|
00938 IF MLIN-STATUS-ACTIVE-88 DTSCS11
|
|
00939 ADD 1 TO WRK-LEFT-IN DTSCS11
|
|
00940 END-IF DTSCS11
|
|
00941 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11
|
|
00942 END-PERFORM. DTSCS11
|
|
00943 DTSCS11
|
|
00944 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11
|
|
00945 MOVE WRK-LEFT-OUT TO MAP-OPEN-LIEN. DTSCS11
|
|
00946 P6907-EXIT. EXIT. DTSCS11
|
|
00947 SKIP3 DTSCS11
|
|
00948 P6908-FROM-MDPC. DTSCS11
|
|
00949 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
00950 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00951 SET MSKL-DPC-88 TO TRUE. DTSCS11
|
|
00952 DTSCS11
|
|
00953 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11
|
|
00954 DTSCS11
|
|
00955 PERFORM UNTIL L810-NO-REC-88 DTSCS11
|
|
00956 MOVE MSKL-REC TO MDPC-REC DTSCS11
|
|
00957 IF MDPC-STATUS-ACTIVE-88 DTSCS11
|
|
00958 MOVE 'Y' TO MAP-OPEN-DPC DTSCS11
|
|
00959 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11
|
|
00960 SET L810-NO-REC-88 TO TRUE DTSCS11
|
|
00961 ELSE DTSCS11
|
|
00962 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11
|
|
00963 END-IF DTSCS11
|
|
00964 END-PERFORM. DTSCS11
|
|
00965 P6908-EXIT. EXIT. DTSCS11
|
|
00966 SKIP3 DTSCS11
|
|
00967 P6909-FROM-MFAS. DTSCS11
|
|
00968 DTSCS11
|
|
00969 MOVE ZEROS TO WRK-LAST-AUDIT-YRQ. DTSCS11
|
|
00970 DTSCS11
|
|
00971 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
00972 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
00973 SET MSKL-FAS-88 TO TRUE. DTSCS11
|
|
00974 DTSCS11
|
|
00975 MOVE 0 TO WRK-LEFT-IN. DTSCS11
|
|
00976 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11
|
|
00977 DTSCS11
|
|
00978 PERFORM UNTIL L810-NO-REC-88 DTSCS11
|
|
00979 MOVE MSKL-REC TO MFAS-REC DTSCS11
|
|
00980 IF MFAS-STATUS-ACTIVE-88 DTSCS11
|
|
00981 OR MFAS-STATUS-HELD-88 DTSCS11
|
|
00982 ADD 1 TO WRK-LEFT-IN DTSCS11
|
|
00983 ELSE DTSCS11
|
|
00984 IF MFAS-STATUS-PROCESSED-88 DTSCS11
|
|
00985 IF MFAS-START-YRQ > WRK-LAST-AUDIT-YRQ DTSCS11
|
|
00986 MOVE MFAS-START-YRQ TO WRK-LAST-AUDIT-YRQ DTSCS11
|
|
00987 END-IF DTSCS11
|
|
00988 END-IF DTSCS11
|
|
00989 END-IF DTSCS11
|
|
00990 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11
|
|
00991 END-PERFORM. DTSCS11
|
|
00992 DTSCS11
|
|
00993 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11
|
|
00994 MOVE WRK-LEFT-OUT TO MAP-OPEN-FLD. DTSCS11
|
|
00995 IF WRK-LAST-AUDIT-CCYY > ZERO DTSCS11
|
|
00996 MOVE WRK-LAST-AUDIT-CCYY TO MAP-LAST-AUDIT DTSCS11
|
|
00997 END-IF. DTSCS11
|
|
00998 P6909-EXIT. EXIT. DTSCS11
|
|
00999 SKIP3 DTSCS11
|
|
01000 P6910-FROM-MNTE. DTSCS11
|
|
01001 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
01002 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
01003 SET MSKL-NTE-88 TO TRUE. DTSCS11
|
|
01004 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11
|
|
01005 MOVE WRK-LEFT-OUT TO MAP-NOTES. DTSCS11
|
|
01006 P6910-EXIT. EXIT. DTSCS11
|
|
01007 SKIP3 DTSCS11
|
|
01008 P6911-FROM-MTAA. DTSCS11
|
|
01009 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
01010 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
01011 SET MSKL-TAA-88 TO TRUE. DTSCS11
|
|
01012 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11
|
|
01013 MOVE WRK-LEFT-OUT TO MAP-ALT-ADDR. DTSCS11
|
|
01014 P6911-EXIT. EXIT. DTSCS11
|
|
01015 SKIP3 DTSCS11
|
|
01016 P6912-FROM-MOPO. DTSCS11
|
|
01017 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
01018 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
01019 SET MSKL-OPO-88 TO TRUE. DTSCS11
|
|
01020 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11
|
|
01021 MOVE WRK-LEFT-OUT TO MAP-OPO. DTSCS11
|
|
01022 P6912-EXIT. EXIT. DTSCS11
|
|
01023 SKIP3 DTSCS11
|
|
01024 P6913-FROM-MRTE. DTSCS11
|
|
01025 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11
|
|
01026 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11
|
|
01027 SET MSKL-RTE-88 TO TRUE. DTSCS11
|
|
01028 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11
|
|
01029 IF L810-RECORD-CNT = +0 DTSCS11
|
|
01030 GO TO P6913-EXIT. DTSCS11
|
|
01031 DTSCS11
|
|
01032 MOVE L810-RECORD-CNT TO HOLD-COUNT. DTSCS11
|
|
01033 SKIP3 DTSCS11
|
|
01034 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11
|
|
01035 IF L810-NO-REC-88 DTSCS11
|
|
01036 GO TO P6913-EXIT. DTSCS11
|
|
01037 DTSCS11
|
|
01038 MOVE MSKL-REC TO MRTE-REC. DTSCS11
|
|
01039 DTSCS11
|
|
01040 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11
|
|
01041 SET L004-FROM-5 TO TRUE. DTSCS11
|
|
01042 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11
|
|
01043 MOVE L004-SLASH-QTR TO MAP-1-EFF. DTSCS11
|
|
01044 DTSCS11
|
|
01045 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11
|
|
01046 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11
|
|
01047 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11
|
|
01048 MOVE L056-DISP-RATE TO MAP-1-UIRTE. DTSCS11
|
|
01049 DTSCS11
|
|
01050 IF HOLD-COUNT = +1 DTSCS11
|
|
01051 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11
|
|
01052 GO TO P6913-EXIT. DTSCS11
|
|
01053 SKIP3 DTSCS11
|
|
01054 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11
|
|
01055 IF L810-NO-REC-88 DTSCS11
|
|
01056 GO TO P6913-EXIT. DTSCS11
|
|
01057 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11
|
|
01058 IF L810-NO-REC-88 DTSCS11
|
|
01059 GO TO P6913-EXIT. DTSCS11
|
|
01060 MOVE MSKL-REC TO MRTE-REC. DTSCS11
|
|
01061 DTSCS11
|
|
01062 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11
|
|
01063 SET L004-FROM-5 TO TRUE. DTSCS11
|
|
01064 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11
|
|
01065 MOVE L004-SLASH-QTR TO MAP-2-EFF. DTSCS11
|
|
01066 DTSCS11
|
|
01067 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11
|
|
01068 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11
|
|
01069 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11
|
|
01070 MOVE L056-DISP-RATE TO MAP-2-UIRTE. DTSCS11
|
|
01071 DTSCS11
|
|
01072 IF HOLD-COUNT = +2 DTSCS11
|
|
01073 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11
|
|
01074 GO TO P6913-EXIT. DTSCS11
|
|
01075 SKIP3 DTSCS11
|
|
01076 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11
|
|
01077 IF L810-NO-REC-88 DTSCS11
|
|
01078 GO TO P6913-EXIT. DTSCS11
|
|
01079 MOVE MSKL-REC TO MRTE-REC. DTSCS11
|
|
01080 DTSCS11
|
|
01081 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11
|
|
01082 SET L004-FROM-5 TO TRUE. DTSCS11
|
|
01083 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11
|
|
01084 MOVE L004-SLASH-QTR TO MAP-3-EFF. DTSCS11
|
|
01085 DTSCS11
|
|
01086 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11
|
|
01087 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11
|
|
01088 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11
|
|
01089 MOVE L056-DISP-RATE TO MAP-3-UIRTE. DTSCS11
|
|
01090 DTSCS11
|
|
01091 IF HOLD-COUNT = +3 DTSCS11
|
|
01092 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11
|
|
01093 GO TO P6913-EXIT. DTSCS11
|
|
01094 SKIP3 DTSCS11
|
|
01095 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11
|
|
01096 IF L810-NO-REC-88 DTSCS11
|
|
01097 GO TO P6913-EXIT. DTSCS11
|
|
01098 MOVE MSKL-REC TO MRTE-REC. DTSCS11
|
|
01099 DTSCS11
|
|
01100 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11
|
|
01101 SET L004-FROM-5 TO TRUE. DTSCS11
|
|
01102 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11
|
|
01103 MOVE L004-SLASH-QTR TO MAP-4-EFF. DTSCS11
|
|
01104 DTSCS11
|
|
01105 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11
|
|
01106 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11
|
|
01107 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11
|
|
01108 MOVE L056-DISP-RATE TO MAP-4-UIRTE. DTSCS11
|
|
01109 DTSCS11
|
|
01110 IF HOLD-COUNT = +4 DTSCS11
|
|
01111 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11
|
|
01112 GO TO P6913-EXIT. DTSCS11
|
|
01113 SKIP3 DTSCS11
|
|
01114 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11
|
|
01115 IF L810-NO-REC-88 DTSCS11
|
|
01116 GO TO P6913-EXIT. DTSCS11
|
|
01117 MOVE MSKL-REC TO MRTE-REC. DTSCS11
|
|
01118 DTSCS11
|
|
01119 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11
|
|
01120 SET L004-FROM-5 TO TRUE. DTSCS11
|
|
01121 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11
|
|
01122 MOVE L004-SLASH-QTR TO MAP-5-EFF. DTSCS11
|
|
01123 DTSCS11
|
|
01124 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11
|
|
01125 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11
|
|
01126 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11
|
|
01127 MOVE L056-DISP-RATE TO MAP-5-UIRTE. DTSCS11
|
|
01128 DTSCS11
|
|
01129 DTSCS11
|
|
01130 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS11
|
|
01131 P6913-EXIT. EXIT. DTSCS11
|
|
01132 SKIP3 DTSCS11
|
|
01133 P6914-FROM-MQTR. DTSCS11
|
|
01134 MOVE ' ' TO MAP-PKUP-DUE. DTSCS11
|
|
01135 DTSCS11
|
|
01136 DTSCS11
|
|
01137 IF MPRF-TOT-BALANCE-AMT = +0 DTSCS11
|
|
01138 GO TO P6914-EXIT. DTSCS11
|
|
01139 DTSCS11
|
|
01140 DTSCS11
|
|
01141 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS11
|
|
01142 DTSCS11
|
|
01143 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS11
|
|
01144 DTSCS11
|
|
01145 SET MQTR-QTR-88 TO TRUE. DTSCS11
|
|
01146 DTSCS11
|
|
01147 MOVE LCCM-PICKUP-YRQ TO MQTR-YRQ. DTSCS11
|
|
01148 DTSCS11
|
|
01149 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS11
|
|
01150 DTSCS11
|
|
01151 PERFORM S810-READ THRU S810-EXIT. DTSCS11
|
|
01152 DTSCS11
|
|
01153 IF L810-NO-REC-88 DTSCS11
|
|
01154 GO TO P6914-EXIT. DTSCS11
|
|
01155 DTSCS11
|
|
01156 DTSCS11
|
|
01157 MOVE MSKL-REC TO MQTR-REC. DTSCS11
|
|
01158 DTSCS11
|
|
01159 DTSCS11
|
|
01160 PERFORM DTSCS11
|
|
01161 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS11
|
|
01162 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS11
|
|
01163 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0.00 DTSCS11
|
|
01164 MOVE 'Y' TO MAP-PKUP-DUE DTSCS11
|
|
01165 END-IF DTSCS11
|
|
01166 END-PERFORM. DTSCS11
|
|
01167 P6914-EXIT. DTSCS11
|
|
01168 EXIT. DTSCS11
|
|
01169 /*****************************************************************DTSCS11
|
|
01170 * LINKS TO UTILITY MODULES DTSCS11
|
|
01171 ******************************************************************DTSCS11
|
|
01172 DTSCS11
|
|
01173 S001-EDIT-DATE. DTSCS11
|
|
01174 EXEC CICS LINK DTSCS11
|
|
01175 PROGRAM ('DTSCU001') DTSCS11
|
|
01176 COMMAREA (L001-COMM-AREA) DTSCS11
|
|
01177 END-EXEC. DTSCS11
|
|
01178 S001-EXIT. EXIT. DTSCS11
|
|
01179 SKIP3 DTSCS11
|
|
01180 S004-EDIT-QTR. DTSCS11
|
|
01181 EXEC CICS LINK DTSCS11
|
|
01182 PROGRAM ('DTSCU004') DTSCS11
|
|
01183 COMMAREA (L004-COMM-AREA) DTSCS11
|
|
01184 END-EXEC. DTSCS11
|
|
01185 S004-EXIT. EXIT. DTSCS11
|
|
01186 SKIP3 DTSCS11
|
|
01187 S018-SCREEN-EMPNO. DTSCS11
|
|
01188 EXEC CICS LINK DTSCS11
|
|
01189 PROGRAM ('DTSCU018') DTSCS11
|
|
01190 COMMAREA (L018-COMM-AREA) DTSCS11
|
|
01191 END-EXEC. DTSCS11
|
|
01192 S018-EXIT. EXIT. DTSCS11
|
|
01193 SKIP3 DTSCS11
|
|
01194 S031-DESC-REG. DTSCS11
|
|
01195 EXEC CICS LINK DTSCS11
|
|
01196 PROGRAM ('DTSCU031') DTSCS11
|
|
01197 COMMAREA (L031-COMM-AREA) DTSCS11
|
|
01198 END-EXEC. DTSCS11
|
|
01199 S031-EXIT. EXIT. DTSCS11
|
|
01200 SKIP3 DTSCS11
|
|
01201 S056-DISP-RATE. DTSCS11
|
|
01202 EXEC CICS LINK DTSCS11
|
|
01203 PROGRAM ('DTSCU056') DTSCS11
|
|
01204 COMMAREA (L056-COMM-AREA) DTSCS11
|
|
01205 END-EXEC. DTSCS11
|
|
01206 S056-EXIT. EXIT. DTSCS11
|
|
01207 SKIP3 DTSCS11
|
|
01208 S061-FLD-ZIP. DTSCS11
|
|
01209 EXEC CICS LINK DTSCS11
|
|
01210 PROGRAM ('DTSCU061') DTSCS11
|
|
01211 COMMAREA (L061-COMM-AREA) DTSCS11
|
|
01212 END-EXEC. DTSCS11
|
|
01213 S061-EXIT. EXIT. DTSCS11
|
|
01214 SKIP3 DTSCS11
|
|
01215 S062-DESC-FLD. DTSCS11
|
|
01216 EXEC CICS LINK DTSCS11
|
|
01217 PROGRAM ('DTSCU062') DTSCS11
|
|
01218 COMMAREA (L062-COMM-AREA) DTSCS11
|
|
01219 END-EXEC. DTSCS11
|
|
01220 S062-EXIT. EXIT. DTSCS11
|
|
01221 SKIP3 DTSCS11
|
|
01222 S410-FILING-SCHEDULE. DTSCS11
|
|
01223 DTSCS11
|
|
01224 SET L410-MODE-MOST-RECENT-88 TO TRUE. DTSCS11
|
|
01225 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSCS11
|
|
01226 DTSCS11
|
|
01227 EXEC CICS LINK DTSCS11
|
|
01228 PROGRAM ('DTSCU410') DTSCS11
|
|
01229 COMMAREA (L410-COMM-AREA) DTSCS11
|
|
01230 END-EXEC. DTSCS11
|
|
01231 DTSCS11
|
|
01232 S410-EXIT. EXIT. DTSCS11
|
|
01233 SKIP3 DTSCS11
|
|
01234 S803-REQ-SCR-ID-EDIT. DTSCS11
|
|
01235 EXEC CICS LINK DTSCS11
|
|
01236 PROGRAM ('DTSCU803') DTSCS11
|
|
01237 COMMAREA (DFHCOMMAREA) DTSCS11
|
|
01238 END-EXEC. DTSCS11
|
|
01239 S803-EXIT. EXIT. DTSCS11
|
|
01240 SKIP3 DTSCS11
|
|
01241 S804-INVALID-KEY. DTSCS11
|
|
01242 EXEC CICS LINK DTSCS11
|
|
01243 PROGRAM ('DTSCU804') DTSCS11
|
|
01244 COMMAREA (DFHCOMMAREA) DTSCS11
|
|
01245 END-EXEC. DTSCS11
|
|
01246 S804-EXIT. EXIT. DTSCS11
|
|
01247 SKIP3 DTSCS11
|
|
01248 S805-MSG-AREA. DTSCS11
|
|
01249 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS11
|
|
01250 DTSCS11
|
|
01251 EXEC CICS LINK DTSCS11
|
|
01252 PROGRAM ('DTSCU805') DTSCS11
|
|
01253 COMMAREA (L805-COMM-AREA) DTSCS11
|
|
01254 END-EXEC. DTSCS11
|
|
01255 DTSCS11
|
|
01256 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS11
|
|
01257 S805-EXIT. EXIT. DTSCS11
|
|
01258 EJECT DTSCS11
|
|
01259 S810-READ. DTSCS11
|
|
01260 SET L810-READ-88 TO TRUE. DTSCS11
|
|
01261 GO TO S810-IO. DTSCS11
|
|
01262 DTSCS11
|
|
01263 S810-START-BROWSE. DTSCS11
|
|
01264 SET L810-START-BROWSE-88 TO TRUE. DTSCS11
|
|
01265 GO TO S810-IO. DTSCS11
|
|
01266 DTSCS11
|
|
01267 S810-READ-NEXT. DTSCS11
|
|
01268 SET L810-READ-NEXT-88 TO TRUE. DTSCS11
|
|
01269 GO TO S810-IO. DTSCS11
|
|
01270 DTSCS11
|
|
01271 S810-READ-PREV. DTSCS11
|
|
01272 SET L810-READ-PREV-88 TO TRUE. DTSCS11
|
|
01273 GO TO S810-IO. DTSCS11
|
|
01274 DTSCS11
|
|
01275 S810-END-BROWSE. DTSCS11
|
|
01276 SET L810-END-BROWSE-88 TO TRUE. DTSCS11
|
|
01277 GO TO S810-IO. DTSCS11
|
|
01278 DTSCS11
|
|
01279 S810-COUNT. DTSCS11
|
|
01280 SET L810-COUNT-88 TO TRUE. DTSCS11
|
|
01281 GO TO S810-IO. DTSCS11
|
|
01282 DTSCS11
|
|
01283 S810-IO. DTSCS11
|
|
01284 DTSCS11
|
|
01285 EXEC CICS LINK DTSCS11
|
|
01286 PROGRAM ('DTSCU810') DTSCS11
|
|
01287 COMMAREA (L810-COMM-AREA) DTSCS11
|
|
01288 END-EXEC. DTSCS11
|
|
01289 DTSCS11
|
|
01290 IF L810-FILE-CLOSED-88 DTSCS11
|
|
01291 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS11
|
|
01292 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS11
|
|
01293 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS11
|
|
01294 GO TO MAINLINE-EXIT. DTSCS11
|
|
01295 S810-EXIT. EXIT. DTSCS11
|
|
01296 EJECT DTSCS11
|
|
01297 S821-START-BROWSE. DTSCS11
|
|
01298 SET L821-START-BROWSE-88 TO TRUE. DTSCS11
|
|
01299 GO TO S821-I. DTSCS11
|
|
01300 DTSCS11
|
|
01301 S821-READ-NEXT. DTSCS11
|
|
01302 SET L821-READ-NEXT-88 TO TRUE. DTSCS11
|
|
01303 GO TO S821-I. DTSCS11
|
|
01304 DTSCS11
|
|
01305 S821-END-BROWSE. DTSCS11
|
|
01306 SET L821-END-BROWSE-88 TO TRUE. DTSCS11
|
|
01307 GO TO S821-I. DTSCS11
|
|
01308 DTSCS11
|
|
01309 S821-I. DTSCS11
|
|
01310 DTSCS11
|
|
01311 EXEC CICS LINK DTSCS11
|
|
01312 PROGRAM ('DTSCU821') DTSCS11
|
|
01313 COMMAREA (L821-COMM-AREA) DTSCS11
|
|
01314 END-EXEC. DTSCS11
|
|
01315 DTSCS11
|
|
01316 IF L821-FILE-CLOSED-88 DTSCS11
|
|
01317 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS11
|
|
01318 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS11
|
|
01319 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS11
|
|
01320 GO TO MAINLINE-EXIT. DTSCS11
|
|
01321 S821-EXIT. EXIT. DTSCS11
|
|
01322 EJECT DTSCS11
|
|
01323 S851-SCREEN-PROCESSING. DTSCS11
|
|
01324 EXEC CICS LINK DTSCS11
|
|
01325 PROGRAM ('DTSCU851') DTSCS11
|
|
01326 COMMAREA (L851-COMM-AREA) DTSCS11
|
|
01327 END-EXEC. DTSCS11
|
|
01328 S851-EXIT. EXIT. DTSCS11
|
|
01329 SKIP3 DTSCS11
|
|
01330 S899-ABEND. DTSCS11
|
|
01331 EXEC CICS ABEND DTSCS11
|
|
01332 ABCODE(WRK-ABEND-CD) DTSCS11
|
|
01333 END-EXEC. DTSCS11
|
|
01334 *S899-EXIT. EXIT. DTSCS11
|
|
01335 /*****************************************************************DTSCS11
|
|
01336 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS11
|
|
01337 ******************************************************************DTSCS11
|
|
01338 DTSCS11
|
|
01339 S1100-EMP-NO. DTSCS11
|
|
01340 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS11
|
|
01341 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT. DTSCS11
|
|
01342 DTSCS11
|
|
01343 IF L018-NO-ENTRY DTSCS11
|
|
01344 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS11
|
|
01345 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS11
|
|
01346 ELSE DTSCS11
|
|
01347 IF L018-NOT-VALID DTSCS11
|
|
01348 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS11
|
|
01349 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS11
|
|
01350 ELSE DTSCS11
|
|
01351 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS11
|
|
01352 S1100-EXIT. EXIT. DTSCS11
|
|
01353 SKIP3 DTSCS11
|
|
01354 S1101-ERROR. DTSCS11
|
|
01355 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS11
|
|
01356 MAP-EMP-NO-2-A. DTSCS11
|
|
01357 IF LCCM-NO-MSG DTSCS11
|
|
01358 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS11
|
|
01359 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS11
|
|
01360 S1101-EXIT. EXIT. DTSCS11
|
|
01361 /*****************************************************************DTSCS11
|
|
01362 * DTSCS11
|
|
01363 ******************************************************************DTSCS11
|
|
01364 S5000-SET-INQ-ATTRB. DTSCS11
|
|
01365 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS11
|
|
01366 MAP-EMP-NO-2-A. DTSCS11
|
|
01367 DTSCS11
|
|
01368 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ENTITY-NAME-A DTSCS11
|
|
01369 MAP-CLASS-A DTSCS11
|
|
01370 MAP-STATUS-A DTSCS11
|
|
01371 MAP-1-ATTN-LINE-A DTSCS11
|
|
01372 MAP-LIAB-A DTSCS11
|
|
01373 MAP-LIAB-QTR-A DTSCS11
|
|
01374 MAP-1-DELIV-LINE-1-A DTSCS11
|
|
01375 MAP-LIAB-ESTB-A DTSCS11
|
|
01376 MAP-1-DELIV-LINE-2-A DTSCS11
|
|
01377 MAP-LIAB-ENTRY-A DTSCS11
|
|
01378 MAP-1-CITY-A DTSCS11
|
|
01379 MAP-1-ST-A DTSCS11
|
|
01380 MAP-1-ZIP-A DTSCS11
|
|
01381 MAP-LIAB-CD-A DTSCS11
|
|
01382 MAP-LAST-AUDIT-A DTSCS11
|
|
01383 MAP-2-ATTN-LINE-A DTSCS11
|
|
01384 MAP-INAC-A DTSCS11
|
|
01385 MAP-INAC-QTR-A DTSCS11
|
|
01386 MAP-2-DELIV-LINE-1-A DTSCS11
|
|
01387 MAP-INAC-ENTRY-A DTSCS11
|
|
01388 MAP-2-DELIV-LINE-2-A DTSCS11
|
|
01389 MAP-INAC-CD-A DTSCS11
|
|
01390 MAP-2-CITY-A DTSCS11
|
|
01391 MAP-2-ST-A DTSCS11
|
|
01392 MAP-2-ZIP-A DTSCS11
|
|
01393 MAP-ORG-TYPE-A DTSCS11
|
|
01394 MAP-SPANS-A DTSCS11
|
|
01395 MAP-COL-A DTSCS11
|
|
01396 MAP-OPEN-APL-A DTSCS11
|
|
01397 MAP-FLD-REP-A DTSCS11
|
|
01398 MAP-CREDIT-A DTSCS11
|
|
01399 MAP-OPEN-LIEN-A DTSCS11
|
|
01400 MAP-1-EFF-A DTSCS11
|
|
01401 MAP-1-UIRTE-A DTSCS11
|
|
01402 MAP-PRED-EMP-NO-1-A DTSCS11
|
|
01403 MAP-PRED-EMP-NO-2-A DTSCS11
|
|
01404 MAP-PRED-A DTSCS11
|
|
01405 MAP-WRITE-OFF-A DTSCS11
|
|
01406 MAP-OPEN-FLD-A DTSCS11
|
|
01407 MAP-2-EFF-A DTSCS11
|
|
01408 MAP-2-UIRTE-A DTSCS11
|
|
01409 MAP-SUC-EMP-NO-1-A DTSCS11
|
|
01410 MAP-SUC-EMP-NO-2-A DTSCS11
|
|
01411 MAP-SUC-A DTSCS11
|
|
01412 MAP-OPEN-BNK-A DTSCS11
|
|
01413 MAP-NOTES-A DTSCS11
|
|
01414 MAP-3-EFF-A DTSCS11
|
|
01415 MAP-3-UIRTE-A DTSCS11
|
|
01416 MAP-FEIN-1-A DTSCS11
|
|
01417 MAP-FEIN-2-A DTSCS11
|
|
01418 MAP-OPEN-DPC-A DTSCS11
|
|
01419 MAP-ALT-ADDR-A DTSCS11
|
|
01420 MAP-4-EFF-A DTSCS11
|
|
01421 MAP-4-UIRTE-A DTSCS11
|
|
01422 MAP-BTN-A DTSCS11
|
|
01423 MAP-PKUP-DUE-A DTSCS11
|
|
01424 MAP-OPO-A DTSCS11
|
|
01425 MAP-5-EFF-A DTSCS11
|
|
01426 MAP-5-UIRTE-A DTSCS11
|
|
01427 MAP-PURGE-A. DTSCS11
|
|
01428 DTSCS11
|
|
01429 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-FILER-A. DTSCS11
|
|
01430 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A. DTSCS11
|
|
01431 DTSCS11
|
|
01432 MOVE CATB-ASKIP-NORM-MDTON TO MAP-LIAB-DESC-A DTSCS11
|
|
01433 MAP-ORG-TYPE-DESC-A DTSCS11
|
|
01434 MAP-INAC-DESC-A DTSCS11
|
|
01435 MAP-FLD-REP-NAME-A. DTSCS11
|
|
01436 DTSCS11
|
|
01437 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS11
|
|
01438 S5000-EXIT. EXIT. DTSCS11
|
|
01439 /*****************************************************************DTSCS11
|
|
01440 * *DTSCS11
|
|
01441 ******************************************************************DTSCS11
|
|
01442 S8000-RETURN-DISP-COUNT. DTSCS11
|
|
01443 PERFORM S810-COUNT THRU S810-EXIT. DTSCS11
|
|
01444 MOVE L810-RECORD-CNT TO WRK-LEFT-IN. DTSCS11
|
|
01445 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11
|
|
01446 S8000-EXIT. EXIT. DTSCS11
|
|
01447 SKIP3 DTSCS11
|
|
01448 S8100-LEFT-JUSTIFY. DTSCS11
|
|
01449 IF NOT-TAKE-THREE DTSCS11
|
|
01450 IF NOT-TAKE-TWO DTSCS11
|
|
01451 IF NOT-TAKE-ONE DTSCS11
|
|
01452 MOVE LOW-VALUE TO WRK-LEFT-OUT DTSCS11
|
|
01453 ELSE DTSCS11
|
|
01454 MOVE ONE-DIGIT TO WRK-LEFT-OUT DTSCS11
|
|
01455 ELSE DTSCS11
|
|
01456 MOVE TWO-DIGITS TO WRK-LEFT-OUT DTSCS11
|
|
01457 ELSE DTSCS11
|
|
01458 MOVE THREE-DIGITS TO WRK-LEFT-OUT. DTSCS11
|
|
01459 S8100-EXIT. EXIT. DTSCS11
|
|
01460 /*****************************************************************DTSCS11
|
|
01461 * MAP ROUTINES *DTSCS11
|
|
01462 ******************************************************************DTSCS11
|
|
01463 S9100-RECEIVE. DTSCS11
|
|
01464 DTSCS11
|
|
01465 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS11
|
|
01466 DTSCS11
|
|
01467 SET L851-RECEIVE-88 TO TRUE. DTSCS11
|
|
01468 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS11
|
|
01469 DTSCS11
|
|
01470 MOVE L851-AID TO LCCM-AID. DTSCS11
|
|
01471 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS11
|
|
01472 S9100-EXIT. EXIT. DTSCS11
|
|
01473 SKIP3 DTSCS11
|
|
01474 ******************************************************************DTSCS11
|
|
01475 * *DTSCS11
|
|
01476 ******************************************************************DTSCS11
|
|
01477 S9200-SEND-DATAONLY. DTSCS11
|
|
01478 MOVE LOW-VALUES TO MAP-AREA. DTSCS11
|
|
01479 DTSCS11
|
|
01480 IF LCCM-MSG DTSCS11
|
|
01481 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS11
|
|
01482 DTSCS11
|
|
01483 IF CURSOR-SET-GOTO DTSCS11
|
|
01484 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS11
|
|
01485 ELSE DTSCS11
|
|
01486 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS11
|
|
01487 DTSCS11
|
|
01488 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS11
|
|
01489 DTSCS11
|
|
01490 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS11
|
|
01491 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS11
|
|
01492 S9200-EXIT. EXIT. DTSCS11
|
|
01493 SKIP3 DTSCS11
|
|
01494 ******************************************************************DTSCS11
|
|
01495 * *DTSCS11
|
|
01496 ******************************************************************DTSCS11
|
|
01497 S9300-SEND-MAP. DTSCS11
|
|
01498 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS11
|
|
01499 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS11
|
|
01500 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS11
|
|
01501 DTSCS11
|
|
01502 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS11
|
|
01503 DTSCS11
|
|
01504 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS11
|
|
01505 DTSCS11
|
|
01506 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS11
|
|
01507 DTSCS11
|
|
01508 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS11
|
|
01509 DTSCS11
|
|
01510 SET L851-SEND-88 TO TRUE. DTSCS11
|
|
01511 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS11
|
|
01512 S9300-EXIT. EXIT. DTSCS11
|
|
01513 SKIP3 DTSCS11
|
|
01514 S9320-INQUIRY-FKEYS. DTSCS11
|
|
01515 MOVE 'F19=PRED' TO MAP-KEY-PRED. DTSCS11
|
|
01516 MOVE 'F20=SUC' TO MAP-KEY-SUC. DTSCS11
|
|
01517 S9320-EXIT. EXIT. DTSCS11
|
|
01518 SKIP3 DTSCS11
|
|
01519 S9900-PREPARE-SEND. DTSCS11
|
|
01520 MOVE WRK-SCR-ID TO LCCM-SCR-ID DTSCS11
|
|
01521 L851-SCR-ID. DTSCS11
|
|
01522 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS11
|
|
01523 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS11
|
|
01524 S9900-EXIT. EXIT. DTSCS11
|