1616 lines
126 KiB
COBOL
1616 lines
126 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/09/04
|
|
00002 PROGRAM-ID. DTSCS35. DTSCS35
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008
|
|
00004 DATE-WRITTEN. JUNE 1994. DTSCS35
|
|
00005 DATE-COMPILED. DTSCS35
|
|
00006 DTSCS35
|
|
00007 ***** DTSCS35
|
|
00008 * DTSCS35
|
|
00009 * FUNCTION: ADJUSTMENT INQUIRY SCREEN PROCESSOR. DTSCS35
|
|
00010 * DTSCS35
|
|
00011 * DTSCS35
|
|
00012 * MODIFICATION LOG: DTSCS35
|
|
00013 * DTSCS35
|
|
00014 * 12/28/98 INITIAL DEVELOPMENT COPIED FROM MACCS35 DTSCS35
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1 DTSCS35
|
|
00016 * DTSCS35
|
|
00017 * 05/18/1999 PICKUP MODIFICATIONS. DTSCS35
|
|
00018 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS35
|
|
00019 * DTSCS35
|
|
00020 * 08/13/1999 CHANGED MISCELLANEOUS AREA LABELS FROM 'ASTR' DTSCS35
|
|
00021 * TO 'WSTR' AND FROM 'AEND' TO 'WEND', PER DC DTSCS35
|
|
00022 * SPECIFICATIONS. OVER LOOKED DURING INITIAL DTSCS35
|
|
00023 * DEVELOPMENT (FROM MT CODE). DTSCS35
|
|
00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS35
|
|
00025 * DTSCS35
|
|
00026 * 04/29/2004 CHANGED MISCELLANEOUS AREA TO DISPLAY CMPRMISE DTSCS35
|
|
00027 * WHEN CMP-ESTB-ABSTIME > ZERO DTSCS35
|
|
00028 * REFERENCE: COMP SETELEMENT PROGRAMMER: ZL1 DTSCS35
|
|
00029 * DTSCS35
|
|
00030 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS35
|
|
00031 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS35
|
|
00032 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS35
|
|
00033 * DTSCS35
|
|
00034 * DTSCS35
|
|
00035 * DESCRIPTION: DTSCS35
|
|
00036 * DTSCS35
|
|
00037 * CLEAR: DTSCS35
|
|
00038 * DTSCS35
|
|
00039 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS35
|
|
00040 * DTSCS35
|
|
00041 * DTSCS35
|
|
00042 * JUMP: DTSCS35
|
|
00043 * DTSCS35
|
|
00044 * F09 QUARTER INQUIRY (31). DTSCS35
|
|
00045 * F10 REPORT INQUIRY (33). DTSCS35
|
|
00046 * F11 PAYMENT INQUIRY (34). DTSCS35
|
|
00047 * DTSCS35
|
|
00048 * DTSCS35
|
|
00049 * INQUIRY: DTSCS35
|
|
00050 * DTSCS35
|
|
00051 * CONTROL FIELD(S): MAP-EMP-NO DTSCS35
|
|
00052 * MAP-YRQ. DTSCS35
|
|
00053 * DTSCS35
|
|
00054 * DTSCS35
|
|
00055 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR35-HOLD-AREA EMP-NO DTSCS35
|
|
00056 * IF LCCM-YRQ = LCCM-SCR35-HOLD-AREA YRQ DTSCS35
|
|
00057 * DISPLAY THE PAGE INDICATED IN DTSCS35
|
|
00058 * LCCM-SCR35-HOLD-AREA DTSCS35
|
|
00059 * ELSE DTSCS35
|
|
00060 * IF LCCM-YRQ = 0 DTSCS35
|
|
00061 * DISPLAY PAGE 1 OF "ALL QUARTERS" DTSCS35
|
|
00062 * ELSE DTSCS35
|
|
00063 * DISPLAY PAGE 1 OF "LCCM-YRQ" DTSCS35
|
|
00064 * ELSE DTSCS35
|
|
00065 * IF LCCM-EMP-NO = 0 DTSCS35
|
|
00066 * DISPLAY 'PLEASE ENTER' MESSAGE DTSCS35
|
|
00067 * ELSE DTSCS35
|
|
00068 * IF LCCM-YRQ = 0 DTSCS35
|
|
00069 * DISPLAY PAGE 1 OF "ALL QUARTERS" DTSCS35
|
|
00070 * ELSE DTSCS35
|
|
00071 * DISPLAY PAGE 1 OF "LCCM-YRQ". DTSCS35
|
|
00072 * DTSCS35
|
|
00073 * DTSCS35
|
|
00074 * ENTER, F05, F06, F07, F08: DTSCS35
|
|
00075 * DTSCS35
|
|
00076 * DISPLAY SEQUENCE: SEE SCREEN DESCRIPTION. DTSCS35
|
|
00077 * DTSCS35
|
|
00078 * PAGE INITIALLY DISPLAYED: FIRST. DTSCS35
|
|
00079 * DTSCS35
|
|
00080 * DTSCS35
|
|
00081 * CONSTRUCTION OF THE PAGES IS SO COMPLEX THAT IT DTSCS35
|
|
00082 * WILL PROBABLY BE NECESSARY TO CONSTRUCT PAGES DTSCS35
|
|
00083 * OF INFORMATION IN TS Q 'S'. DTSCS35
|
|
00084 * DTSCS35
|
|
00085 * DTSCS35
|
|
00086 * JUMP OUT: STORE INFORMATION REPRESENTING PAGE DTSCS35
|
|
00087 * CURRENTLY DISPLAYED IN LCCM-SCR35-HOLD-AREA. DTSCS35
|
|
00088 * DTSCS35
|
|
00089 * DELETE TEMPORARY STORAGE QUEUE 'S'. DTSCS35
|
|
00090 * DTSCS35
|
|
00091 * DTSCS35
|
|
00092 * LCCM-MISC-CONTROL-AREA MAINTENANCE: DTSCS35
|
|
00093 * DTSCS35
|
|
00094 * LCCM-EMP-NO DTSCS35
|
|
00095 * DTSCS35
|
|
00096 * LCCM-YRQ DTSCS35
|
|
00097 * DTSCS35
|
|
00098 * DTSCS35
|
|
00099 * UPDATE: DTSCS35
|
|
00100 * DTSCS35
|
|
00101 * NONE. DTSCS35
|
|
00102 * DTSCS35
|
|
00103 * DTSCS35
|
|
00104 * RECORDS READ: DTSCS35
|
|
00105 * DTSCS35
|
|
00106 * MASTER: DTSCS35
|
|
00107 * DTSCS35
|
|
00108 * MPRF DTSCS35
|
|
00109 * MADJ DTSCS35
|
|
00110 * DTSCS35
|
|
00111 * DTSCS35
|
|
00112 * ALTERNATE INDEX: DTSCS35
|
|
00113 * DTSCS35
|
|
00114 * NONE. DTSCS35
|
|
00115 * DTSCS35
|
|
00116 * DTSCS35
|
|
00117 * REFERENCE: DTSCS35
|
|
00118 * DTSCS35
|
|
00119 * NONE. DTSCS35
|
|
00120 * DTSCS35
|
|
00121 * DTSCS35
|
|
00122 * ACCOUNTING TRANSACTION COLLECTION: DTSCS35
|
|
00123 * DTSCS35
|
|
00124 * NONE. DTSCS35
|
|
00125 * DTSCS35
|
|
00126 * DTSCS35
|
|
00127 * RECORDS UPDATED: DTSCS35
|
|
00128 * DTSCS35
|
|
00129 * MASTER: DTSCS35
|
|
00130 * DTSCS35
|
|
00131 * NONE. DTSCS35
|
|
00132 * DTSCS35
|
|
00133 * DTSCS35
|
|
00134 * REFERENCE: DTSCS35
|
|
00135 * DTSCS35
|
|
00136 * NONE. DTSCS35
|
|
00137 * DTSCS35
|
|
00138 * DTSCS35
|
|
00139 * ACCOUNTING TRANSACTION COLLECTION: DTSCS35
|
|
00140 * DTSCS35
|
|
00141 * NONE. DTSCS35
|
|
00142 * DTSCS35
|
|
00143 * DTSCS35
|
|
00144 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS35
|
|
00145 * DTSCS35
|
|
00146 * NONE. DTSCS35
|
|
00147 * DTSCS35
|
|
00148 * DTSCS35
|
|
00149 * TEMPORARY STORAGE USAGE: DTSCS35
|
|
00150 * DTSCS35
|
|
00151 * S IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL. DTSCS35
|
|
00152 * DTSCS35
|
|
00153 * DTSCS35
|
|
00154 * MODULES LINKED TO: DTSCS35
|
|
00155 * DTSCS35
|
|
00156 * DTSCU001 DATE EDIT/CONVERSION. DTSCS35
|
|
00157 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS35
|
|
00158 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS35
|
|
00159 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS35
|
|
00160 * DTSCU056 RATE DISPLAY. DTSCS35
|
|
00161 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS35
|
|
00162 * DTSCU829 TEMPORARY STORAGE INPUT/OUTPUT. DTSCS35
|
|
00163 * DTSCS35
|
|
00164 * DTSCS35
|
|
00165 * VERMONT REFERENCE: DTSCS35
|
|
00166 * DTSCS35
|
|
00167 * TXC230C. DTSCS35
|
|
00168 * DTSCS35
|
|
00169 * DTSCS35
|
|
00170 * NOTES FOR JEFF: DTSCS35
|
|
00171 * DTSCS35
|
|
00172 * . PLEASE CLONE MACCS35 FROM MACCS33. OBVIOUSLY, MACCS33 DTSCS35
|
|
00173 * IS "COLUMN" ORIENTED WHILE MACCS35 IS "ROW" ORIENTED, DTSCS35
|
|
00174 * BUT THAT IS A MINOR CHANGE. DTSCS35
|
|
00175 * DTSCS35
|
|
00176 * DTSCS35
|
|
00177 * . AFTER YOU DETERMINE THE LENGTH OF "PAGE-AREA", YOU WILL DTSCS35
|
|
00178 * BE ABLE TO DETERMINE THE NUMBER OF LCCM-SCR-HOLD-PAGE DTSCS35
|
|
00179 * AREA OCCURRENCES. DTSCS35
|
|
00180 * DTSCS35
|
|
00181 * DTSCS35
|
|
00182 * . THE P7000 LOGIC IN MACCS35 SHOULD BE SIMPLER THAN IN DTSCS35
|
|
00183 * MACCS33. SCREEN 35 SPECIFICATIONS STATES "SEQUENCE OF DTSCS35
|
|
00184 * DISPLAY IS DESCENDING ON "DOCUMENT"". THUS, YOU NEED DTSCS35
|
|
00185 * ONLY DO A L810-COUNT-88 TO FIND THE THE KEY OF THE LAST DTSCS35
|
|
00186 * MADJ AND THEN DO A START BROWSE/READ PREV TO POSITION DTSCS35
|
|
00187 * YOURSELF. THEN READ PREVS WILL DO THE TRICK. DTSCS35
|
|
00188 * DTSCS35
|
|
00189 * DTSCS35
|
|
00190 * . SCREEN 35 SCREEN DESCRIPTION STATES THAT "IF A VALUE IS DTSCS35
|
|
00191 * ENTERED IN YR/Q, THEN ONLY ADJUSTMENT TRANSACTIONS FOR DTSCS35
|
|
00192 * THE SPECIFIED QUARTER ARE DISPLAYED". THIS JUST MEANS DTSCS35
|
|
00193 * THAT IF WRK-YRQ IS NOT EQUAL TO ZER, THEN THE DISPLAY DTSCS35
|
|
00194 * IS LIMITED TO THOSE MADJ RECORDS WITH MADJ-APPLIC-YRQ DTSCS35
|
|
00195 * EQUAL TO WRK-YRQ. DTSCS35
|
|
00196 * DTSCS35
|
|
00197 * DTSCS35
|
|
00198 * . A GIVEN MADJ RECORD MAY OCCUPY MORE THAN ONE (ACTUALLY DTSCS35
|
|
00199 * UP TO FOUR LINES) ON THE SCREEN. SEE THE DESCRIPTION DTSCS35
|
|
00200 * OF THE "MISCELLANEOUS" AREA (DISPLAYED ON THE RIGHT DTSCS35
|
|
00201 * SIDE OF THE SCREEN). DISPLAY A FOUR CHARACTER "LABEL" DTSCS35
|
|
00202 * (DESCRIBING THE DATA ELEMENT BEING DISPLAYED IN THIS DTSCS35
|
|
00203 * LINES "MISCELLANEOUS") AREA AND DISPLAY THE DATA DTSCS35
|
|
00204 * ELEMENT VALUE. SCR35.DSC LISTS THE "LABELS" TO BE DTSCS35
|
|
00205 * USED. DTSCS35
|
|
00206 * DTSCS35
|
|
00207 * DTSCS35
|
|
00208 * . WHEN MORE THAN ONE LINE OF "MISCELLANEOUS" DATA IS DTSCS35
|
|
00209 * DISPLAYED FOR ONE MADJ RECORD, PLEASE "GROUP INDICATE" DTSCS35
|
|
00210 * THE INFORMATION DISPLAYED TO THE LEFT OF THE DTSCS35
|
|
00211 * "MISCELLANEOUS" DATA. DTSCS35
|
|
00212 * DTSCS35
|
|
00213 * DTSCS35
|
|
00214 ***** DTSCS35
|
|
00215 ENVIRONMENT DIVISION. DTSCS35
|
|
00216 DTSCS35
|
|
00217 DATA DIVISION. DTSCS35
|
|
00218 DTSCS35
|
|
00219 WORKING-STORAGE SECTION. DTSCS35
|
|
002195 77 PAN-VALET PICTURE X(24) VALUE '008DTSCS35 12/09/04'. DTSCS35
|
|
00220 DTSCS35
|
|
00221 01 WRK-AREA. DTSCS35
|
|
00222 05 WRK-ABEND-CD PIC X(04) VALUE 'S35 '. DTSCS35
|
|
00223 DTSCS35
|
|
00224 05 WRK-SCR-ID. DTSCS35
|
|
00225 10 WRK-SCR-ID-N PIC 9(02) VALUE 35. DTSCS35
|
|
00226 DTSCS35
|
|
00227 05 WRK-F03-SCR-ID PIC X(02) VALUE '30'. DTSCS35
|
|
00228 DTSCS35
|
|
00229 05 ROWS-PER-PAGE PIC S9(04) COMP VALUE +16. DTSCS35
|
|
00230 DTSCS35
|
|
00231 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS35
|
|
00232 VALUE +99999. DTSCS35
|
|
00233 DTSCS35
|
|
00234 05 SCR-ACCESS-IND PIC X(01). DTSCS35
|
|
00235 88 SCR-ACCESS-INQ VALUE '1'. DTSCS35
|
|
00236 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS35
|
|
00237 DTSCS35
|
|
00238 05 CURSOR-SET-IND PIC X(01). DTSCS35
|
|
00239 88 CURSOR-SET-YES VALUE 'Y'. DTSCS35
|
|
00240 88 CURSOR-SET-NO VALUE 'N'. DTSCS35
|
|
00241 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS35
|
|
00242 DTSCS35
|
|
00243 05 REQ-IND PIC X(01). DTSCS35
|
|
00244 88 REQ-ERROR VALUE 'O'. DTSCS35
|
|
00245 88 REQ-JUMP VALUE 'J'. DTSCS35
|
|
00246 88 REQ-INQUIRE VALUE 'I'. DTSCS35
|
|
00247 88 REQ-CLEAR VALUE 'C'. DTSCS35
|
|
00248 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS35
|
|
00249 DTSCS35
|
|
00250 05 RESP-IND PIC X(01). DTSCS35
|
|
00251 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS35
|
|
00252 88 RESP-SEND-MAP VALUE 'M'. DTSCS35
|
|
00253 88 RESP-JUMP VALUE 'J'. DTSCS35
|
|
00254 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS35
|
|
00255 DTSCS35
|
|
00256 05 WRK-MSG-AREA PIC X(64). DTSCS35
|
|
00257 DTSCS35
|
|
00258 05 WRK-ATB-AN PIC X(01). DTSCS35
|
|
00259 05 WRK-ATB-NUM PIC X(01). DTSCS35
|
|
00260 DTSCS35
|
|
00261 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS35
|
|
00262 DTSCS35
|
|
00263 05 WRK-MPRF-IND PIC X(01). DTSCS35
|
|
00264 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS35
|
|
00265 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS35
|
|
00266 DTSCS35
|
|
00267 05 WRK-YRQ PIC S9(05) COMP-3. DTSCS35
|
|
00268 DTSCS35
|
|
00269 05 PROCESS-YRQ PIC S9(05) COMP-3. DTSCS35
|
|
00270 DTSCS35
|
|
00271 05 WRK-DISPLAY PIC 9(11). DTSCS35
|
|
00272 DTSCS35
|
|
00273 05 FILLER REDEFINES WRK-DISPLAY. DTSCS35
|
|
00274 10 FILLER PIC X(05). DTSCS35
|
|
00275 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS35
|
|
00276 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS35
|
|
00277 DTSCS35
|
|
00278 05 FILLER REDEFINES WRK-DISPLAY. DTSCS35
|
|
00279 10 FILLER PIC X(08). DTSCS35
|
|
00280 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS35
|
|
00281 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS35
|
|
00282 DTSCS35
|
|
00283 05 ROW-OCC PIC S9(04) COMP. DTSCS35
|
|
00284 DTSCS35
|
|
00285 05 SCR-HOLD-AREA. DTSCS35
|
|
00286 10 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS35
|
|
00287 10 SCR-HOLD-YRQ PIC S9(05) COMP-3. DTSCS35
|
|
00288 10 SCR-HOLD-CURR-PAGE-NUM PIC S9(04) COMP. DTSCS35
|
|
00289 DTSCS35
|
|
00290 05 INQUIRY-CONTROL-AREA. DTSCS35
|
|
00291 10 ITEM-LENGTH PIC S9(04) COMP VALUE +722. DTSCS35
|
|
00292 DTSCS35
|
|
00293 10 ITEM-MAX PIC S9(05) COMP VALUE +32760. DTSCS35
|
|
00294 DTSCS35
|
|
00295 10 ITEM-MAX-LCCM PIC S9(04) COMP VALUE +2. DTSCS35
|
|
00296 DTSCS35
|
|
00297 10 CURR-PAGE-NUM PIC S9(04) COMP. DTSCS35
|
|
00298 DTSCS35
|
|
00299 10 ITEM-SUB PIC S9(04) COMP. DTSCS35
|
|
00300 DTSCS35
|
|
00301 10 ITEM-CNT PIC S9(04) COMP. DTSCS35
|
|
00302 DTSCS35
|
|
00303 ***** DTSCS35
|
|
00304 * DTSCS35
|
|
00305 * IF THE LENGTH OF PAGE-AREA IS MODIFIED, THEN MAKE DTSCS35
|
|
00306 * CORRESPONDING MODIFICATIONS TO ITEM-LENGTH, L829-REC, DTSCS35
|
|
00307 * AND LCCM-SCR-HOLD-PAGE-AREA. DTSCS35
|
|
00308 * DTSCS35
|
|
00309 ***** DTSCS35
|
|
00310 DTSCS35
|
|
00311 05 PAGE-AREA PIC X(722). DTSCS35
|
|
00312 DTSCS35
|
|
00313 05 FILLER REDEFINES PAGE-AREA. DTSCS35
|
|
00314 10 PAGE-ROW-CNT PIC S9(04) COMP. DTSCS35
|
|
00315 DTSCS35
|
|
00316 10 PAGE-ROW OCCURS 16 TIMES. DTSCS35
|
|
00317 15 PAGE-ADJ-TYPE PIC X(02). DTSCS35
|
|
00318 15 PAGE-DOC-NO. DTSCS35
|
|
00319 20 PAGE-BATCH-NO PIC S9(05) COMP-3.DTSCS35
|
|
00320 20 PAGE-ITEM-NO PIC S9(03) COMP-3.DTSCS35
|
|
00321 15 PAGE-AMT PIC S9(09)V9(02) COMP-3.DTSCS35
|
|
00322 15 PAGE-RECEIVED-DATE PIC S9(09) COMP-3.DTSCS35
|
|
00323 15 PAGE-PROCESSED-DATE PIC S9(09) COMP-3.DTSCS35
|
|
00324 15 PAGE-APPLIC-YRQ PIC S9(05) COMP-3.DTSCS35
|
|
00325 15 PAGE-APPLIC-IND PIC X(02). DTSCS35
|
|
00326 15 PAGE-APPLIC-DOC-NO. DTSCS35
|
|
00327 20 PAGE-APPLIC-BATCH-NO DTSCS35
|
|
00328 PIC S9(05) COMP-3.DTSCS35
|
|
00329 20 PAGE-APPLIC-ITEM-NO PIC S9(03) COMP-3.DTSCS35
|
|
00330 15 PAGE-MISC-1 PIC X(04). DTSCS35
|
|
00331 15 PAGE-MISC-2 PIC X(08). DTSCS35
|
|
00332 *****EJECT DTSCS35
|
|
00333 *01 MSG-LITERALS. DTSCS35
|
|
00334 *****05 MSG-E351-AREA. DTSCS35
|
|
00335 ***** 10 FILLER PIC X(04) VALUE 'E351'. DTSCS35
|
|
00336 ***** 10 FILLER PIC X(30) DTSCS35
|
|
00337 ***** VALUE ' '. DTSCS35
|
|
00338 ***** 10 FILLER PIC X(30) DTSCS35
|
|
00339 ***** VALUE ' '. DTSCS35
|
|
00340 EJECT DTSCS35
|
|
00341 01 L001-COMM-AREA. DTSCS35
|
|
00342 ++INCLUDE DTSIL001 DTSCS35
|
|
00343 EJECT DTSCS35
|
|
00344 01 L004-COMM-AREA. DTSCS35
|
|
00345 ++INCLUDE DTSIL004 DTSCS35
|
|
00346 EJECT DTSCS35
|
|
00347 01 L018-COMM-AREA. DTSCS35
|
|
00348 ++INCLUDE DTSIL018 DTSCS35
|
|
00349 EJECT DTSCS35
|
|
00350 01 L029-COMM-AREA. DTSCS35
|
|
00351 ++INCLUDE DTSIL029 DTSCS35
|
|
00352 EJECT DTSCS35
|
|
00353 01 L056-COMM-AREA. DTSCS35
|
|
00354 ++INCLUDE DTSIL056 DTSCS35
|
|
00355 EJECT DTSCS35
|
|
00356 01 L805-COMM-AREA. DTSCS35
|
|
00357 ++INCLUDE DTSIL805 DTSCS35
|
|
00358 EJECT DTSCS35
|
|
00359 01 L810-COMM-AREA. DTSCS35
|
|
00360 05 L810-CONTROL-BLOCK. DTSCS35
|
|
00361 ++INCLUDE DTSIL810 DTSCS35
|
|
00362 EJECT DTSCS35
|
|
00363 05 MSKL-REC. DTSCS35
|
|
00364 ++INCLUDE DTSIMSKL DTSCS35
|
|
00365 EJECT DTSCS35
|
|
00366 01 MPRF-REC. DTSCS35
|
|
00367 ++INCLUDE DTSIMPRF DTSCS35
|
|
00368 EJECT DTSCS35
|
|
00369 01 MADJ-REC. DTSCS35
|
|
00370 ++INCLUDE DTSIMADJ DTSCS35
|
|
00371 EJECT DTSCS35
|
|
00372 01 L829-COMM-AREA. DTSCS35
|
|
00373 05 L829-CONTROL-BLOCK. DTSCS35
|
|
00374 ++INCLUDE DTSIL829 DTSCS35
|
|
00375 DTSCS35
|
|
00376 05 L829-REC PIC X(722). DTSCS35
|
|
00377 EJECT DTSCS35
|
|
00378 01 L851-COMM-AREA. DTSCS35
|
|
00379 ++INCLUDE DTSIL851 DTSCS35
|
|
00380 DTSCS35
|
|
00381 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS35
|
|
00382 ++INCLUDE DTSIS35 DTSCS35
|
|
00383 EJECT DTSCS35
|
|
00384 01 CATB-LITERALS. DTSCS35
|
|
00385 ++INCLUDE DTSICATB DTSCS35
|
|
00386 DTSCS35
|
|
00387 01 CFKD-LITERALS. DTSCS35
|
|
00388 ++INCLUDE DTSICFKD DTSCS35
|
|
00389 DTSCS35
|
|
00390 01 CECD-LITERALS. DTSCS35
|
|
00391 ++INCLUDE DTSICECD DTSCS35
|
|
00392 DTSCS35
|
|
00393 01 CPCD-LITERALS. DTSCS35
|
|
00394 ++INCLUDE DTSICPCD DTSCS35
|
|
00395 EJECT DTSCS35
|
|
00396 LINKAGE SECTION. DTSCS35
|
|
00397 DTSCS35
|
|
00398 01 DFHCOMMAREA. DTSCS35
|
|
00399 ++INCLUDE DTSILCCM DTSCS35
|
|
00400 DTSCS35
|
|
00401 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS35
|
|
00402 20 LCCM-SCR-HOLD-CONTROL-AREA. DTSCS35
|
|
00403 25 LCCM-SCR-HOLD-EMP-NO PIC S9(07) COMP-3.DTSCS35
|
|
00404 25 LCCM-SCR-HOLD-YRQ PIC S9(05) COMP-3.DTSCS35
|
|
00405 25 LCCM-SCR-HOLD-ABSTIME PIC S9(15) COMP-3.DTSCS35
|
|
00406 25 LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS35
|
|
00407 PIC S9(04) COMP. DTSCS35
|
|
00408 20 LCCM-SCR-HOLD-PAGE-AREA OCCURS 2 TIMES DTSCS35
|
|
00409 PIC X(722). DTSCS35
|
|
00410 EJECT DTSCS35
|
|
00411 ******************************************************************DTSCS35
|
|
00412 * *DTSCS35
|
|
00413 ******************************************************************DTSCS35
|
|
00414 DTSCS35
|
|
00415 PROCEDURE DIVISION. DTSCS35
|
|
00416 DTSCS35
|
|
00417 MOVE +0 TO WRK-EMP-NO. DTSCS35
|
|
00418 DTSCS35
|
|
00419 SET WRK-MPRF-NO-88 TO TRUE. DTSCS35
|
|
00420 DTSCS35
|
|
00421 MOVE +0 TO WRK-YRQ. DTSCS35
|
|
00422 DTSCS35
|
|
00423 MOVE LOW-VALUES TO MAP-AREA. DTSCS35
|
|
00424 DTSCS35
|
|
00425 SET CURSOR-SET-NO TO TRUE. DTSCS35
|
|
00426 DTSCS35
|
|
00427 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS35
|
|
00428 TO SCR-ACCESS-IND. DTSCS35
|
|
00429 DTSCS35
|
|
00430 MOVE SPACE TO REQ-IND. DTSCS35
|
|
00431 DTSCS35
|
|
00432 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS35
|
|
00433 DTSCS35
|
|
00434 *----------------------------------------------------- DTSCS35
|
|
00435 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS35
|
|
00436 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS35
|
|
00437 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS35
|
|
00438 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS35
|
|
00439 * DTSCS35
|
|
00440 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS35
|
|
00441 * PROCESSED. DTSCS35
|
|
00442 * DTSCS35
|
|
00443 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS35
|
|
00444 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS35
|
|
00445 * WORK STATION OPERATOR. DTSCS35
|
|
00446 *----------------------------------------------------- DTSCS35
|
|
00447 DTSCS35
|
|
00448 MOVE SPACE TO RESP-IND. DTSCS35
|
|
00449 DTSCS35
|
|
00450 IF REQ-ERROR DTSCS35
|
|
00451 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS35
|
|
00452 ELSE DTSCS35
|
|
00453 IF REQ-JUMP DTSCS35
|
|
00454 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS35
|
|
00455 ELSE DTSCS35
|
|
00456 IF REQ-CLEAR DTSCS35
|
|
00457 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS35
|
|
00458 ELSE DTSCS35
|
|
00459 IF REQ-CURSOR-TO-GOTO DTSCS35
|
|
00460 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS35
|
|
00461 ELSE DTSCS35
|
|
00462 IF REQ-INQUIRE DTSCS35
|
|
00463 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS35
|
|
00464 ELSE DTSCS35
|
|
00465 *****IF REQ-EDIT DTSCS35
|
|
00466 ***** PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS35
|
|
00467 *****ELSE DTSCS35
|
|
00468 *****IF REQ-UPDATE DTSCS35
|
|
00469 ***** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS35
|
|
00470 *****ELSE DTSCS35
|
|
00471 GO TO S899-ABEND. DTSCS35
|
|
00472 DTSCS35
|
|
00473 *----------------------------------------------------- DTSCS35
|
|
00474 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS35
|
|
00475 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS35
|
|
00476 *----------------------------------------------------- DTSCS35
|
|
00477 DTSCS35
|
|
00478 IF RESP-SEND-MAP DTSCS35
|
|
00479 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS35
|
|
00480 SET LCCM-END-TASK-88 TO TRUE DTSCS35
|
|
00481 ELSE DTSCS35
|
|
00482 IF RESP-SEND-MSGONLY DTSCS35
|
|
00483 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS35
|
|
00484 SET LCCM-END-TASK-88 TO TRUE DTSCS35
|
|
00485 ELSE DTSCS35
|
|
00486 IF RESP-JUMP DTSCS35
|
|
00487 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS35
|
|
00488 ELSE DTSCS35
|
|
00489 IF RESP-CURSOR-TO-GOTO DTSCS35
|
|
00490 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS35
|
|
00491 SET LCCM-END-TASK-88 TO TRUE DTSCS35
|
|
00492 ELSE DTSCS35
|
|
00493 GO TO S899-ABEND. DTSCS35
|
|
00494 DTSCS35
|
|
00495 MAINLINE-EXIT. DTSCS35
|
|
00496 DTSCS35
|
|
00497 EXEC CICS DTSCS35
|
|
00498 RETURN DTSCS35
|
|
00499 END-EXEC. DTSCS35
|
|
00500 DTSCS35
|
|
00501 GOBACK. DTSCS35
|
|
00502 EJECT DTSCS35
|
|
00503 /*****************************************************************DTSCS35
|
|
00504 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS35
|
|
00505 ******************************************************************DTSCS35
|
|
00506 P1000-ANALYZE-REQUEST. DTSCS35
|
|
00507 DTSCS35
|
|
00508 *----------------------------------------------------- DTSCS35
|
|
00509 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS35
|
|
00510 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS35
|
|
00511 * REPLACED WITH ENTER) DTSCS35
|
|
00512 *----------------------------------------------------- DTSCS35
|
|
00513 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS35
|
|
00514 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS35
|
|
00515 SET LCCM-ENTER-88 TO TRUE DTSCS35
|
|
00516 IF LCCM-EMP-NO = +0 DTSCS35
|
|
00517 MOVE +0 TO LCCM-YRQ DTSCS35
|
|
00518 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCS35
|
|
00519 SET REQ-CLEAR TO TRUE DTSCS35
|
|
00520 ELSE DTSCS35
|
|
00521 SET REQ-INQUIRE TO TRUE DTSCS35
|
|
00522 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS35
|
|
00523 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS35
|
|
00524 PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT DTSCS35
|
|
00525 END-IF DTSCS35
|
|
00526 GO TO P1000-EXIT. DTSCS35
|
|
00527 DTSCS35
|
|
00528 *----------------------------------------------------- DTSCS35
|
|
00529 * MAP IS RECEIVED DTSCS35
|
|
00530 *----------------------------------------------------- DTSCS35
|
|
00531 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS35
|
|
00532 DTSCS35
|
|
00533 *----------------------------------------------------- DTSCS35
|
|
00534 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS35
|
|
00535 * WORK STATION DTSCS35
|
|
00536 *----------------------------------------------------- DTSCS35
|
|
00537 IF LCCM-CLEAR-88 DTSCS35
|
|
00538 SET REQ-CLEAR TO TRUE DTSCS35
|
|
00539 GO TO P1000-EXIT. DTSCS35
|
|
00540 DTSCS35
|
|
00541 *----------------------------------------------------- DTSCS35
|
|
00542 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS35
|
|
00543 *----------------------------------------------------- DTSCS35
|
|
00544 IF LCCM-PA2-88 DTSCS35
|
|
00545 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS35
|
|
00546 GO TO P1000-EXIT. DTSCS35
|
|
00547 DTSCS35
|
|
00548 *----------------------------------------------------- DTSCS35
|
|
00549 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS35
|
|
00550 *----------------------------------------------------- DTSCS35
|
|
00551 IF LCCM-PA-88 DTSCS35
|
|
00552 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS35
|
|
00553 SET REQ-ERROR TO TRUE DTSCS35
|
|
00554 GO TO P1000-EXIT. DTSCS35
|
|
00555 DTSCS35
|
|
00556 *----------------------------------------------------- DTSCS35
|
|
00557 * IF PF12 KEY IS PRESSED CLEAR SCREEN DTSCS35
|
|
00558 *----------------------------------------------------- DTSCS35
|
|
00559 IF LCCM-F12-88 DTSCS35
|
|
00560 MOVE LOW-VALUES TO MAP-AREA DTSCS35
|
|
00561 SET REQ-CLEAR TO TRUE DTSCS35
|
|
00562 GO TO P1000-EXIT. DTSCS35
|
|
00563 DTSCS35
|
|
00564 *----------------------------------------------------- DTSCS35
|
|
00565 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS35
|
|
00566 *----------------------------------------------------- DTSCS35
|
|
00567 IF LCCM-F03-88 DTSCS35
|
|
00568 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS35
|
|
00569 SET REQ-JUMP TO TRUE DTSCS35
|
|
00570 GO TO P1000-EXIT. DTSCS35
|
|
00571 DTSCS35
|
|
00572 *----------------------------------------------------- DTSCS35
|
|
00573 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS35
|
|
00574 *----------------------------------------------------- DTSCS35
|
|
00575 IF LCCM-F04-88 DTSCS35
|
|
00576 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS35
|
|
00577 SET REQ-JUMP TO TRUE DTSCS35
|
|
00578 GO TO P1000-EXIT. DTSCS35
|
|
00579 DTSCS35
|
|
00580 *----------------------------------------------------- DTSCS35
|
|
00581 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS35
|
|
00582 * CORRESPONDENCE SCREEN DTSCS35
|
|
00583 *----------------------------------------------------- DTSCS35
|
|
00584 IF LCCM-F14-88 DTSCS35
|
|
00585 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS35
|
|
00586 SET REQ-JUMP TO TRUE DTSCS35
|
|
00587 GO TO P1000-EXIT. DTSCS35
|
|
00588 DTSCS35
|
|
00589 * IF LCCM-F09-88 DTSCS35
|
|
00590 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS35
|
|
00591 * SET REQ-JUMP TO TRUE DTSCS35
|
|
00592 * GO TO P1000-EXIT. DTSCS35
|
|
00593 * DTSCS35
|
|
00594 * IF LCCM-F10-88 DTSCS35
|
|
00595 * MOVE '33' TO LCCM-REQ-SCR-ID DTSCS35
|
|
00596 * SET REQ-JUMP TO TRUE DTSCS35
|
|
00597 * GO TO P1000-EXIT. DTSCS35
|
|
00598 * DTSCS35
|
|
00599 * IF LCCM-F11-88 DTSCS35
|
|
00600 * MOVE '34' TO LCCM-REQ-SCR-ID DTSCS35
|
|
00601 * SET REQ-JUMP TO TRUE DTSCS35
|
|
00602 * GO TO P1000-EXIT. DTSCS35
|
|
00603 * DTSCS35
|
|
00604 *----------------------------------------------------- DTSCS35
|
|
00605 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS35
|
|
00606 * REQUESTED SCREEN TYPE DTSCS35
|
|
00607 *----------------------------------------------------- DTSCS35
|
|
00608 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS35
|
|
00609 NEXT SENTENCE DTSCS35
|
|
00610 ELSE DTSCS35
|
|
00611 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS35
|
|
00612 SET REQ-JUMP TO TRUE DTSCS35
|
|
00613 GO TO P1000-EXIT. DTSCS35
|
|
00614 DTSCS35
|
|
00615 *----------------------------------------------------- DTSCS35
|
|
00616 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS35
|
|
00617 * F8), INDICATE INQUIRY REQUEST DTSCS35
|
|
00618 *----------------------------------------------------- DTSCS35
|
|
00619 IF LCCM-INQUIRY-88 DTSCS35
|
|
00620 SET REQ-INQUIRE TO TRUE DTSCS35
|
|
00621 GO TO P1000-EXIT. DTSCS35
|
|
00622 DTSCS35
|
|
00623 *----------------------------------------------------- DTSCS35
|
|
00624 * ANY OTHER KEY IS INVALID DTSCS35
|
|
00625 *----------------------------------------------------- DTSCS35
|
|
00626 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS35
|
|
00627 SET REQ-ERROR TO TRUE. DTSCS35
|
|
00628 P1000-EXIT. DTSCS35
|
|
00629 EXIT. DTSCS35
|
|
00630 DTSCS35
|
|
00631 P1100-CHECK-LCCM-YRQ. DTSCS35
|
|
00632 IF LCCM-YRQ = ALL-NINES-YRQ DTSCS35
|
|
00633 MOVE +0 TO LCCM-YRQ DTSCS35
|
|
00634 GO TO P1100-EXIT. DTSCS35
|
|
00635 DTSCS35
|
|
00636 IF LCCM-YRQ < LCCM-PICKUP-YRQ DTSCS35
|
|
00637 MOVE +0 TO LCCM-YRQ DTSCS35
|
|
00638 GO TO P1100-EXIT. DTSCS35
|
|
00639 DTSCS35
|
|
00640 IF LCCM-YRQ > +0 DTSCS35
|
|
00641 PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT DTSCS35
|
|
00642 GO TO P1100-EXIT. DTSCS35
|
|
00643 DTSCS35
|
|
00644 *****MOVE LCCM-SCR35-HOLD-AREA TO SCR-HOLD-AREA. DTSCS35
|
|
00645 *****IF SCR-HOLD-AREA NOT = LOW-VALUES DTSCS35
|
|
00646 *********IF SCR-HOLD-EMP-NO = LCCM-EMP-NO DTSCS35
|
|
00647 ***********IF SCR-HOLD-YRQ > +0 DTSCS35
|
|
00648 *************MOVE SCR-HOLD-YRQ TO LCCM-YRQ DTSCS35
|
|
00649 *************PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT. DTSCS35
|
|
00650 P1100-EXIT. DTSCS35
|
|
00651 EXIT. DTSCS35
|
|
00652 DTSCS35
|
|
00653 P1110-DISPLAY-YRQ. DTSCS35
|
|
00654 IF LCCM-YRQ = LCCM-PICKUP-YRQ DTSCS35
|
|
00655 MOVE 'PU' TO MAP-YRQ-YR DTSCS35
|
|
00656 MOVE ' ' TO MAP-YRQ-Q DTSCS35
|
|
00657 ELSE DTSCS35
|
|
00658 MOVE LCCM-YRQ TO WRK-DISPLAY DTSCS35
|
|
00659 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR DTSCS35
|
|
00660 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. DTSCS35
|
|
00661 P1110-EXIT. DTSCS35
|
|
00662 EXIT. DTSCS35
|
|
00663 /*****************************************************************DTSCS35
|
|
00664 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS35
|
|
00665 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS35
|
|
00666 ******************************************************************DTSCS35
|
|
00667 DTSCS35
|
|
00668 P2000-REQUEST-ERROR. DTSCS35
|
|
00669 IF LCCM-MSG DTSCS35
|
|
00670 SET RESP-SEND-MSGONLY TO TRUE DTSCS35
|
|
00671 ELSE DTSCS35
|
|
00672 GO TO S899-ABEND. DTSCS35
|
|
00673 P2000-EXIT. DTSCS35
|
|
00674 EXIT. DTSCS35
|
|
00675 /*****************************************************************DTSCS35
|
|
00676 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS35
|
|
00677 ******************************************************************DTSCS35
|
|
00678 DTSCS35
|
|
00679 P3000-REQUEST-JUMP. DTSCS35
|
|
00680 *----------------------------------------------------- DTSCS35
|
|
00681 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS35
|
|
00682 * BY USER DTSCS35
|
|
00683 *----------------------------------------------------- DTSCS35
|
|
00684 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS35
|
|
00685 DTSCS35
|
|
00686 *----------------------------------------------------- DTSCS35
|
|
00687 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS35
|
|
00688 *----------------------------------------------------- DTSCS35
|
|
00689 IF LCCM-MSG DTSCS35
|
|
00690 SET RESP-SEND-MSGONLY TO TRUE DTSCS35
|
|
00691 SET CURSOR-SET-GOTO TO TRUE DTSCS35
|
|
00692 GO TO P3000-EXIT. DTSCS35
|
|
00693 SKIP3 DTSCS35
|
|
00694 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS35
|
|
00695 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS35
|
|
00696 IF L018-VALID DTSCS35
|
|
00697 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCS35
|
|
00698 DTSCS35
|
|
00699 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA DTSCS35
|
|
00700 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT DTSCS35
|
|
00701 IF L029-VALID DTSCS35
|
|
00702 MOVE L029-YRQ TO LCCM-YRQ. DTSCS35
|
|
00703 DTSCS35
|
|
00704 *----------------------------------------------------- DTSCS35
|
|
00705 * IF PAGES OF INFORMATION ARE IN TS, THEN BEFORE DTSCS35
|
|
00706 * JUMPING OUT OF THIS MODULE, DELETE THE TS QUEUE. DTSCS35
|
|
00707 *----------------------------------------------------- DTSCS35
|
|
00708 DTSCS35
|
|
00709 IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES DTSCS35
|
|
00710 NEXT SENTENCE DTSCS35
|
|
00711 ELSE DTSCS35
|
|
00712 IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM DTSCS35
|
|
00713 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS35
|
|
00714 DTSCS35
|
|
00715 *----------------------------------------------------- DTSCS35
|
|
00716 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS35
|
|
00717 *----------------------------------------------------- DTSCS35
|
|
00718 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS35
|
|
00719 LCCM-SCR-HOLD-AREA. DTSCS35
|
|
00720 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS35
|
|
00721 SET RESP-JUMP TO TRUE. DTSCS35
|
|
00722 P3000-EXIT. DTSCS35
|
|
00723 EXIT. DTSCS35
|
|
00724 /*****************************************************************DTSCS35
|
|
00725 * CLEAR KEY WAS PRESSED *DTSCS35
|
|
00726 ******************************************************************DTSCS35
|
|
00727 DTSCS35
|
|
00728 P4000-REQUEST-CLEAR. DTSCS35
|
|
00729 *----------------------------------------------------- DTSCS35
|
|
00730 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS35
|
|
00731 * FIELDS FROM EARLIER REQUESTS DTSCS35
|
|
00732 *----------------------------------------------------- DTSCS35
|
|
00733 IF LCCM-EMP-NO > ZERO DTSCS35
|
|
00734 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS35
|
|
00735 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS35
|
|
00736 DTSCS35
|
|
00737 MOVE ZERO TO LCCM-EMP-NO DTSCS35
|
|
00738 LCCM-YRQ. DTSCS35
|
|
00739 DTSCS35
|
|
00740 MOVE LOW-VALUES TO LCCM-SCR35-HOLD-AREA. DTSCS35
|
|
00741 DTSCS35
|
|
00742 DTSCS35
|
|
00743 DTSCS35
|
|
00744 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS35
|
|
00745 DTSCS35
|
|
00746 SET LCCM-SCR-CLEAR TO TRUE. DTSCS35
|
|
00747 DTSCS35
|
|
00748 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS35
|
|
00749 DTSCS35
|
|
00750 SET RESP-SEND-MAP TO TRUE. DTSCS35
|
|
00751 P4000-EXIT. DTSCS35
|
|
00752 EXIT. DTSCS35
|
|
00753 /*****************************************************************DTSCS35
|
|
00754 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS35
|
|
00755 ******************************************************************DTSCS35
|
|
00756 DTSCS35
|
|
00757 P5000-CURSOR-TO-GOTO. DTSCS35
|
|
00758 SET CURSOR-SET-GOTO TO TRUE. DTSCS35
|
|
00759 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS35
|
|
00760 P5000-EXIT. DTSCS35
|
|
00761 EXIT. DTSCS35
|
|
00762 /*****************************************************************DTSCS35
|
|
00763 * INQUIRY WAS REQUESTED *DTSCS35
|
|
00764 ******************************************************************DTSCS35
|
|
00765 DTSCS35
|
|
00766 P6000-REQUEST-INQUIRE. DTSCS35
|
|
00767 *------------------------------------------------------------ DTSCS35
|
|
00768 * CLEAR MAP-AREA WHILE PRESERVING MAP-EMP-NO-AREA AND DTSCS35
|
|
00769 * MAP-YRQ-AREA. DTSCS35
|
|
00770 *------------------------------------------------------------ DTSCS35
|
|
00771 DTSCS35
|
|
00772 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS35
|
|
00773 DTSCS35
|
|
00774 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS35
|
|
00775 DTSCS35
|
|
00776 MOVE LOW-VALUES TO MAP-AREA. DTSCS35
|
|
00777 DTSCS35
|
|
00778 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS35
|
|
00779 DTSCS35
|
|
00780 MOVE L029-S-YRQ-AREA TO MAP-YRQ-AREA. DTSCS35
|
|
00781 DTSCS35
|
|
00782 DTSCS35
|
|
00783 SET LCCM-SCR-CLEAR TO TRUE. DTSCS35
|
|
00784 DTSCS35
|
|
00785 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS35
|
|
00786 DTSCS35
|
|
00787 SET RESP-SEND-MAP TO TRUE. DTSCS35
|
|
00788 DTSCS35
|
|
00789 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS35
|
|
00790 DTSCS35
|
|
00791 DTSCS35
|
|
00792 *------------------------------------------------------------ DTSCS35
|
|
00793 * IF LAST ACTION WAS A SCREEN 33 DISPLAY, THEN LCCM-SCR35 DTSCS35
|
|
00794 * HOLD-AREA CONTAINS EMP NO, YRQ AND PAGE NUMBER LAST DTSCS35
|
|
00795 * DISPLAYED. DTSCS35
|
|
00796 *------------------------------------------------------------ DTSCS35
|
|
00797 DTSCS35
|
|
00798 MOVE LCCM-SCR35-HOLD-AREA TO SCR-HOLD-AREA. DTSCS35
|
|
00799 DTSCS35
|
|
00800 MOVE LOW-VALUES TO LCCM-SCR35-HOLD-AREA. DTSCS35
|
|
00801 DTSCS35
|
|
00802 DTSCS35
|
|
00803 *------------------------------------------------------------ DTSCS35
|
|
00804 * EDIT MAP-EMP-NO-AREA AND MAP-YRQ-AREA FOR VALIDITY. DTSCS35
|
|
00805 *------------------------------------------------------------ DTSCS35
|
|
00806 DTSCS35
|
|
00807 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS35
|
|
00808 IF LCCM-MSG DTSCS35
|
|
00809 NEXT SENTENCE DTSCS35
|
|
00810 ELSE DTSCS35
|
|
00811 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS35
|
|
00812 DTSCS35
|
|
00813 PERFORM S1200-YRQ THRU S1200-EXIT. DTSCS35
|
|
00814 IF LCCM-MSG DTSCS35
|
|
00815 GO TO P6000-EXIT. DTSCS35
|
|
00816 DTSCS35
|
|
00817 MOVE WRK-YRQ TO LCCM-YRQ. DTSCS35
|
|
00818 DTSCS35
|
|
00819 DTSCS35
|
|
00820 *------------------------------------------------------------ DTSCS35
|
|
00821 * THIS MODULE CONSTRUCTS PAGES OF INFORMATION INTO DTSCS35
|
|
00822 * LCCM-SCR-HOLD-AREA (WITH ANY OVERFLOW STORED IN TS) DTSCS35
|
|
00823 * AND RETAINS THIS INFORMATION BETWEEN TASKS. DTSCS35
|
|
00824 * DTSCS35
|
|
00825 * IF LCCM-SCR-HOLD-AREA CONTAINS INFORMATION FOR THE EMP-NO DTSCS35
|
|
00826 * AND YRQ SPECIFIED ON THE SCREEN AND THE EMPLOYER'S DTSCS35
|
|
00827 * RECORDS HAVE NOT BEEN UPDATED SINCE THE LCCM-SCR-HOLD-AREA DTSCS35
|
|
00828 * WAS CONSTRUCTED, THEN THE INFORMATION IN LCCM-SCR-HOLD-AREA DTSCS35
|
|
00829 * MAY BE USED FOR PAGING AND DISPLAY - IT IS NOT NECESSARY DTSCS35
|
|
00830 * TO REBUILD LCCM-SCR-HOLD-AREA. DTSCS35
|
|
00831 *------------------------------------------------------------ DTSCS35
|
|
00832 DTSCS35
|
|
00833 IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES) DTSCS35
|
|
00834 OR DTSCS35
|
|
00835 (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO) DTSCS35
|
|
00836 OR DTSCS35
|
|
00837 (WRK-YRQ NOT = LCCM-SCR-HOLD-YRQ) DTSCS35
|
|
00838 OR DTSCS35
|
|
00839 (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME) DTSCS35
|
|
00840 PERFORM P7000-CONSTRUCT-PAGES THRU P7000-EXIT. DTSCS35
|
|
00841 DTSCS35
|
|
00842 DTSCS35
|
|
00843 *------------------------------------------------------------ DTSCS35
|
|
00844 * IF NO INFORMATION IS AVAILABLE FOR DISPLAY, THEN YOU DTSCS35
|
|
00845 * ARE DONE. DTSCS35
|
|
00846 *------------------------------------------------------------ DTSCS35
|
|
00847 DTSCS35
|
|
00848 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0 DTSCS35
|
|
00849 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS35
|
|
00850 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS35
|
|
00851 GO TO P6000-EXIT. DTSCS35
|
|
00852 DTSCS35
|
|
00853 DTSCS35
|
|
00854 *------------------------------------------------------------ DTSCS35
|
|
00855 * DETERMINE WHICH PAGE TO DISPLAY. DTSCS35
|
|
00856 *------------------------------------------------------------ DTSCS35
|
|
00857 DTSCS35
|
|
00858 PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT. DTSCS35
|
|
00859 IF LCCM-MSG DTSCS35
|
|
00860 GO TO P6000-EXIT. DTSCS35
|
|
00861 DTSCS35
|
|
00862 DTSCS35
|
|
00863 *------------------------------------------------------------ DTSCS35
|
|
00864 * PLACE INFORMATION INTO MAP-AREA. DTSCS35
|
|
00865 *------------------------------------------------------------ DTSCS35
|
|
00866 DTSCS35
|
|
00867 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS35
|
|
00868 DTSCS35
|
|
00869 DTSCS35
|
|
00870 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCS35
|
|
00871 DTSCS35
|
|
00872 MOVE WRK-YRQ TO SCR-HOLD-YRQ. DTSCS35
|
|
00873 DTSCS35
|
|
00874 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCS35
|
|
00875 DTSCS35
|
|
00876 MOVE SCR-HOLD-AREA TO LCCM-SCR35-HOLD-AREA. DTSCS35
|
|
00877 DTSCS35
|
|
00878 DTSCS35
|
|
00879 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS35
|
|
00880 P6000-EXIT. DTSCS35
|
|
00881 EXIT. DTSCS35
|
|
00882 EJECT DTSCS35
|
|
00883 P6200-LOCATE-PAGE. DTSCS35
|
|
00884 IF (SCR-HOLD-AREA = LOW-VALUES) DTSCS35
|
|
00885 OR DTSCS35
|
|
00886 (SCR-HOLD-EMP-NO NOT = WRK-EMP-NO) DTSCS35
|
|
00887 OR DTSCS35
|
|
00888 (SCR-HOLD-YRQ NOT = WRK-YRQ) DTSCS35
|
|
00889 MOVE +1 TO CURR-PAGE-NUM DTSCS35
|
|
00890 GO TO P6200-EXIT. DTSCS35
|
|
00891 DTSCS35
|
|
00892 IF LCCM-ENTER-88 DTSCS35
|
|
00893 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCS35
|
|
00894 ELSE DTSCS35
|
|
00895 IF LCCM-F05-88 DTSCS35
|
|
00896 MOVE +1 TO CURR-PAGE-NUM DTSCS35
|
|
00897 ELSE DTSCS35
|
|
00898 IF LCCM-F06-88 DTSCS35
|
|
00899 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM DTSCS35
|
|
00900 ELSE DTSCS35
|
|
00901 IF LCCM-F07-88 DTSCS35
|
|
00902 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1 DTSCS35
|
|
00903 ELSE DTSCS35
|
|
00904 IF LCCM-F08-88 DTSCS35
|
|
00905 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1 DTSCS35
|
|
00906 ELSE DTSCS35
|
|
00907 GO TO S899-ABEND. DTSCS35
|
|
00908 DTSCS35
|
|
00909 IF CURR-PAGE-NUM < +1 DTSCS35
|
|
00910 MOVE +1 TO CURR-PAGE-NUM DTSCS35
|
|
00911 ELSE DTSCS35
|
|
00912 IF CURR-PAGE-NUM > LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS35
|
|
00913 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCS35
|
|
00914 P6200-EXIT. DTSCS35
|
|
00915 EXIT. DTSCS35
|
|
00916 /*****************************************************************DTSCS35
|
|
00917 * *DTSCS35
|
|
00918 ******************************************************************DTSCS35
|
|
00919 DTSCS35
|
|
00920 P6900-CONSTRUCT-SCREEN. DTSCS35
|
|
00921 *-------------------------------------------------------------- DTSCS35
|
|
00922 * PAGES OF INFORMATION HAVE BEEN ASSEMBLED AND PLACED INTO DTSCS35
|
|
00923 * LCCM-SCR-HOLD-AREA AND A PAGE (CURR-PAGE-NUM) HAS BEEN DTSCS35
|
|
00924 * SELECTED FOR DISPLAY. THUS, ALL THAT IS LEFT IS TO RETRIEVE DTSCS35
|
|
00925 * THE SELECTED PAGE OF INFORMATION FROM LCCM-SCR-HOLD-AREA DTSCS35
|
|
00926 * (OR THE TS OVERFLOW) INTO PAGE-AREA AND MOVE DATA ELEMENTS DTSCS35
|
|
00927 * FROM PAGE-AREA TO MAP-AREA. DTSCS35
|
|
00928 *-------------------------------------------------------------- DTSCS35
|
|
00929 DTSCS35
|
|
00930 MOVE CURR-PAGE-NUM TO ITEM-SUB. DTSCS35
|
|
00931 DTSCS35
|
|
00932 PERFORM P8200-RETREIVE-PAGE-AREA THRU P8200-EXIT. DTSCS35
|
|
00933 DTSCS35
|
|
00934 PERFORM P6910-PAGE-AREA-TO-MAP THRU P6910-EXIT DTSCS35
|
|
00935 VARYING ROW-OCC FROM 1 BY 1 DTSCS35
|
|
00936 UNTIL ROW-OCC > PAGE-ROW-CNT. DTSCS35
|
|
00937 DTSCS35
|
|
00938 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS35
|
|
00939 P6900-EXIT. DTSCS35
|
|
00940 EXIT. DTSCS35
|
|
00941 DTSCS35
|
|
00942 P6910-PAGE-AREA-TO-MAP. DTSCS35
|
|
00943 MOVE SPACES TO MAP-LINE(ROW-OCC). DTSCS35
|
|
00944 DTSCS35
|
|
00945 MOVE PAGE-MISC-1(ROW-OCC) TO MAP-MISC-1(ROW-OCC). DTSCS35
|
|
00946 MOVE PAGE-MISC-2(ROW-OCC) TO MAP-MISC-2(ROW-OCC). DTSCS35
|
|
00947 DTSCS35
|
|
00948 * *-------------------------------------- DTSCS35
|
|
00949 *-----------------------* THE FOLLOWING SENTENCE PERFORMS THE DTSCS35
|
|
00950 * * GROUP INDICATE FUNCTION DTSCS35
|
|
00951 * *-------------------------------------- DTSCS35
|
|
00952 IF ROW-OCC = 1 DTSCS35
|
|
00953 NEXT SENTENCE DTSCS35
|
|
00954 ELSE DTSCS35
|
|
00955 IF PAGE-DOC-NO (ROW-OCC) = PAGE-DOC-NO (ROW-OCC - 1) DTSCS35
|
|
00956 GO TO P6910-EXIT DTSCS35
|
|
00957 ELSE DTSCS35
|
|
00958 NEXT SENTENCE. DTSCS35
|
|
00959 DTSCS35
|
|
00960 MOVE PAGE-ADJ-TYPE (ROW-OCC) TO MAP-ADJ-TYPE (ROW-OCC). DTSCS35
|
|
00961 DTSCS35
|
|
00962 MOVE PAGE-BATCH-NO (ROW-OCC) TO MAP-BATCH-NO (ROW-OCC). DTSCS35
|
|
00963 MOVE PAGE-ITEM-NO (ROW-OCC) TO MAP-ITEM-NO (ROW-OCC). DTSCS35
|
|
00964 DTSCS35
|
|
00965 IF PAGE-APPLIC-YRQ (ROW-OCC) > +0 DTSCS35
|
|
00966 MOVE PAGE-APPLIC-YRQ (ROW-OCC) TO L004-QTR-5-9 DTSCS35
|
|
00967 PERFORM P6911-SLASH-YRQ THRU P6911-EXIT DTSCS35
|
|
00968 MOVE L004-SLASH-QTR TO MAP-APPLIC-YRQ (ROW-OCC). DTSCS35
|
|
00969 DTSCS35
|
|
00970 DTSCS35
|
|
00971 IF PAGE-APPLIC-BATCH-NO (ROW-OCC) > +0 DTSCS35
|
|
00972 OR PAGE-APPLIC-ITEM-NO (ROW-OCC) > +0 DTSCS35
|
|
00973 MOVE PAGE-APPLIC-BATCH-NO (ROW-OCC) DTSCS35
|
|
00974 TO MAP-APPLIC-BATCH-NO (ROW-OCC) DTSCS35
|
|
00975 MOVE PAGE-APPLIC-ITEM-NO (ROW-OCC) DTSCS35
|
|
00976 TO MAP-APPLIC-ITEM-NO (ROW-OCC). DTSCS35
|
|
00977 DTSCS35
|
|
00978 MOVE PAGE-APPLIC-IND (ROW-OCC) DTSCS35
|
|
00979 TO MAP-APPLIC-IND (ROW-OCC). DTSCS35
|
|
00980 DTSCS35
|
|
00981 MOVE PAGE-PROCESSED-DATE (ROW-OCC) TO L001-FED-8-DATE-9. DTSCS35
|
|
00982 PERFORM P6912-SLASH-DATE THRU P6912-EXIT. DTSCS35
|
|
00983 MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE (ROW-OCC). DTSCS35
|
|
00984 DTSCS35
|
|
00985 MOVE PAGE-RECEIVED-DATE (ROW-OCC) TO L001-FED-8-DATE-9. DTSCS35
|
|
00986 PERFORM P6912-SLASH-DATE THRU P6912-EXIT. DTSCS35
|
|
00987 MOVE L001-SLASH-DATE TO MAP-RECEIVED-DATE (ROW-OCC). DTSCS35
|
|
00988 DTSCS35
|
|
00989 MOVE PAGE-AMT (ROW-OCC) TO MAP-AMT-Z (ROW-OCC). DTSCS35
|
|
00990 DTSCS35
|
|
00991 P6910-EXIT. DTSCS35
|
|
00992 EXIT. DTSCS35
|
|
00993 DTSCS35
|
|
00994 P6911-SLASH-YRQ. DTSCS35
|
|
00995 IF L004-QTR-5-9 = +0 DTSCS35
|
|
00996 MOVE SPACES TO L004-SLASH-QTR DTSCS35
|
|
00997 ELSE DTSCS35
|
|
00998 IF L004-QTR-5-9 = LCCM-PICKUP-YRQ DTSCS35
|
|
00999 MOVE 'PKUP' TO L004-SLASH-QTR DTSCS35
|
|
01000 ELSE DTSCS35
|
|
01001 MOVE L004-QTR-5-YR TO L004-SLASH-YR DTSCS35
|
|
01002 MOVE '/' TO L004-SLASH-LIT DTSCS35
|
|
01003 MOVE L004-QTR-5-Q TO L004-SLASH-Q. DTSCS35
|
|
01004 P6911-EXIT. DTSCS35
|
|
01005 EXIT. DTSCS35
|
|
01006 DTSCS35
|
|
01007 P6912-SLASH-DATE. DTSCS35
|
|
01008 IF L001-FED-8-DATE-9 = +0 DTSCS35
|
|
01009 MOVE SPACES TO L001-SLASH-DATE DTSCS35
|
|
01010 ELSE DTSCS35
|
|
01011 MOVE ' / / ' TO L001-SLASH-DATE DTSCS35
|
|
01012 MOVE L001-FED-8-MO TO L001-SLASH-MO DTSCS35
|
|
01013 MOVE L001-FED-8-DA TO L001-SLASH-DA DTSCS35
|
|
01014 MOVE L001-FED-8-YR TO L001-SLASH-YR. DTSCS35
|
|
01015 P6912-EXIT. DTSCS35
|
|
01016 EXIT. DTSCS35
|
|
01017 DTSCS35
|
|
01018 P6990-PAGE-NUMBER. DTSCS35
|
|
01019 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCS35
|
|
01020 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCS35
|
|
01021 DTSCS35
|
|
01022 IF CURR-PAGE-NUM = +1 DTSCS35
|
|
01023 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1 DTSCS35
|
|
01024 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS35
|
|
01025 ELSE DTSCS35
|
|
01026 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS35
|
|
01027 ELSE DTSCS35
|
|
01028 IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS35
|
|
01029 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS35
|
|
01030 P6990-EXIT. DTSCS35
|
|
01031 EXIT. DTSCS35
|
|
01032 EJECT DTSCS35
|
|
01033 P7000-CONSTRUCT-PAGES. DTSCS35
|
|
01034 *-------------------------------------------------------------- DTSCS35
|
|
01035 * INQUIRY FOR WRK-EMP-NO AND WRK-YRQ HAS BEEN REQUESTED. DTSCS35
|
|
01036 * P7000 ASSEMBLES PAGES OF INFORMATION INTO LCCM-SCR-HOLD-AREA DTSCS35
|
|
01037 * (WITH OVERFLOW INTO TS). DTSCS35
|
|
01038 * DTSCS35
|
|
01039 * THE PRINCIPLE DIFFICULTY IS WITH THE SEQUENCE IN WHICH MADJ DTSCS35
|
|
01040 * RECORDS MUST BE DISPLAYED: ASCENDING ON DOC NO. DTSCS35
|
|
01041 * DTSCS35
|
|
01042 * IF WRK-YRQ IS EQUAL TO ZERO, THEN ALL MADJ RECORDS FOR EMP DTSCS35
|
|
01043 * NO MUST BE DISPLAYED. DTSCS35
|
|
01044 * DTSCS35
|
|
01045 * IF WRK-YRQ IS NOT EQUAL TO ZERO, THEN ONLY THOSE MADJ DTSCS35
|
|
01046 * RECORDS WITH MADJ-YRQ EQUAL TO WRK-YRQ ARE DISPLAYED. DTSCS35
|
|
01047 *-------------------------------------------------------------- DTSCS35
|
|
01048 IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES DTSCS35
|
|
01049 NEXT SENTENCE DTSCS35
|
|
01050 ELSE DTSCS35
|
|
01051 IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM DTSCS35
|
|
01052 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS35
|
|
01053 DTSCS35
|
|
01054 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS35
|
|
01055 DTSCS35
|
|
01056 MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO. DTSCS35
|
|
01057 MOVE WRK-YRQ TO LCCM-SCR-HOLD-YRQ. DTSCS35
|
|
01058 MOVE MPRF-UPDATE-END-ABSTIME TO LCCM-SCR-HOLD-ABSTIME. DTSCS35
|
|
01059 MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM. DTSCS35
|
|
01060 DTSCS35
|
|
01061 MOVE +0 TO ITEM-CNT. DTSCS35
|
|
01062 DTSCS35
|
|
01063 PERFORM P7100-ALL-QUARTERS THRU P7100-EXIT DTSCS35
|
|
01064 DTSCS35
|
|
01065 MOVE ITEM-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM. DTSCS35
|
|
01066 P7000-EXIT. DTSCS35
|
|
01067 EXIT. DTSCS35
|
|
01068 DTSCS35
|
|
01069 P7100-ALL-QUARTERS. DTSCS35
|
|
01070 *-------------------------------------------------------------- DTSCS35
|
|
01071 * PROCESS ALL MADJ RECORDS, WHILE MEETING THE "DESCENDING DTSCS35
|
|
01072 * ON DOC NO" REQUIREMENT. DTSCS35
|
|
01073 *-------------------------------------------------------------- DTSCS35
|
|
01074 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS35
|
|
01075 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS35
|
|
01076 SET MSKL-ADJ-88 TO TRUE. DTSCS35
|
|
01077 PERFORM S810-COUNT THRU S810-EXIT. DTSCS35
|
|
01078 IF L810-RECORD-CNT = +0 DTSCS35
|
|
01079 GO TO P7100-EXIT. DTSCS35
|
|
01080 DTSCS35
|
|
01081 MOVE +0 TO PAGE-ROW-CNT. DTSCS35
|
|
01082 DTSCS35
|
|
01083 MOVE MSKL-KEY-AREA TO MADJ-KEY-AREA. DTSCS35
|
|
01084 DTSCS35
|
|
01085 DTSCS35
|
|
01086 PERFORM P7900-PROCESS-YRQ THRU P7900-EXIT. DTSCS35
|
|
01087 DTSCS35
|
|
01088 DTSCS35
|
|
01089 IF PAGE-ROW-CNT > +0 DTSCS35
|
|
01090 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS35
|
|
01091 P7100-EXIT. DTSCS35
|
|
01092 EXIT. DTSCS35
|
|
01093 DTSCS35
|
|
01094 P7900-PROCESS-YRQ. DTSCS35
|
|
01095 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSCS35
|
|
01096 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS35
|
|
01097 IF L810-NO-REC-88 DTSCS35
|
|
01098 GO TO P7900-EXIT. DTSCS35
|
|
01099 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS35
|
|
01100 DTSCS35
|
|
01101 PERFORM P7910-SCAN-MADJ THRU P7910-EXIT DTSCS35
|
|
01102 UNTIL L810-NO-REC-88. DTSCS35
|
|
01103 P7900-EXIT. DTSCS35
|
|
01104 EXIT. DTSCS35
|
|
01105 DTSCS35
|
|
01106 P7910-SCAN-MADJ. DTSCS35
|
|
01107 MOVE MSKL-REC TO MADJ-REC. DTSCS35
|
|
01108 DTSCS35
|
|
01109 IF WRK-YRQ = +0 DTSCS35
|
|
01110 OR MADJ-APPLIC-YRQ = WRK-YRQ DTSCS35
|
|
01111 NEXT SENTENCE DTSCS35
|
|
01112 ELSE DTSCS35
|
|
01113 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS35
|
|
01114 GO TO P7910-EXIT. DTSCS35
|
|
01115 DTSCS35
|
|
01116 IF PAGE-ROW-CNT < ROWS-PER-PAGE DTSCS35
|
|
01117 NEXT SENTENCE DTSCS35
|
|
01118 ELSE DTSCS35
|
|
01119 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS35
|
|
01120 MOVE +0 TO PAGE-ROW-CNT. DTSCS35
|
|
01121 DTSCS35
|
|
01122 PERFORM P7911-MADJ-TO-PAGE-AREA THRU P7911-EXIT. DTSCS35
|
|
01123 DTSCS35
|
|
01124 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS35
|
|
01125 P7910-EXIT. DTSCS35
|
|
01126 EXIT. DTSCS35
|
|
01127 DTSCS35
|
|
01128 * STORE THE DATA FOR ALL FIELDS FOR EACH PAGE DTSCS35
|
|
01129 P7911-MADJ-TO-PAGE-AREA. DTSCS35
|
|
01130 PERFORM P7913-NORMAL-INFO THRU P7913-EXIT DTSCS35
|
|
01131 DTSCS35
|
|
01132 IF MADJ-DUE-DATE-88 DTSCS35
|
|
01133 MOVE 'RDUE' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01134 MOVE MADJ-DATE-1 TO L001-FED-8-DATE-9 DTSCS35
|
|
01135 PERFORM P6912-SLASH-DATE THRU P6912-EXIT DTSCS35
|
|
01136 MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01137 PERFORM P7914-CHECK-PAGE THRU P7914-EXIT DTSCS35
|
|
01138 PERFORM P7913-NORMAL-INFO THRU P7913-EXIT DTSCS35
|
|
01139 MOVE 'TDUE' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01140 MOVE MADJ-DATE-2 TO L001-FED-8-DATE-9 DTSCS35
|
|
01141 PERFORM P6912-SLASH-DATE THRU P6912-EXIT DTSCS35
|
|
01142 MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01143 ELSE DTSCS35
|
|
01144 IF MADJ-WAIVE-DATE-88 DTSCS35
|
|
01145 MOVE 'WSTR' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01146 MOVE MADJ-DATE-1 TO L001-FED-8-DATE-9 DTSCS35
|
|
01147 PERFORM P6912-SLASH-DATE THRU P6912-EXIT DTSCS35
|
|
01148 MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01149 PERFORM P7914-CHECK-PAGE THRU P7914-EXIT DTSCS35
|
|
01150 PERFORM P7913-NORMAL-INFO THRU P7913-EXIT DTSCS35
|
|
01151 MOVE 'WEND' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01152 MOVE MADJ-DATE-2 TO L001-FED-8-DATE-9 DTSCS35
|
|
01153 PERFORM P6912-SLASH-DATE THRU P6912-EXIT DTSCS35
|
|
01154 MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01155 ELSE DTSCS35
|
|
01156 IF MADJ-INT-DATE-88 DTSCS35
|
|
01157 MOVE 'ISTR' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01158 MOVE MADJ-DATE-1 TO L001-FED-8-DATE-9 DTSCS35
|
|
01159 PERFORM P6912-SLASH-DATE THRU P6912-EXIT DTSCS35
|
|
01160 MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01161 PERFORM P7914-CHECK-PAGE THRU P7914-EXIT DTSCS35
|
|
01162 PERFORM P7913-NORMAL-INFO THRU P7913-EXIT DTSCS35
|
|
01163 MOVE 'IEND' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01164 MOVE MADJ-DATE-2 TO L001-FED-8-DATE-9 DTSCS35
|
|
01165 PERFORM P6912-SLASH-DATE THRU P6912-EXIT DTSCS35
|
|
01166 MOVE L001-SLASH-DATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01167 PERFORM P7914-CHECK-PAGE THRU P7914-EXIT DTSCS35
|
|
01168 PERFORM P7913-NORMAL-INFO THRU P7913-EXIT DTSCS35
|
|
01169 MOVE 'ISPN' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01170 MOVE MADJ-INT-SPAN-IND TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01171 PERFORM P7914-CHECK-PAGE THRU P7914-EXIT DTSCS35
|
|
01172 PERFORM P7913-NORMAL-INFO THRU P7913-EXIT DTSCS35
|
|
01173 MOVE 'IRTE' TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01174 MOVE MADJ-INT-RATE TO L056-RATE DTSCS35
|
|
01175 PERFORM S056-DISP1-RIGHT THRU S056-EXIT DTSCS35
|
|
01176 MOVE L056-DISP-RATE TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01177 ELSE DTSCS35
|
|
01178 IF MADJ-CMP-ESTB-ABSTIME > ZERO DTSCS35
|
|
01179 MOVE 'CMPRMISE' TO PAGE-MISC-2(PAGE-ROW-CNT) DTSCS35
|
|
01180 ELSE DTSCS35
|
|
01181 MOVE SPACES TO PAGE-MISC-1(PAGE-ROW-CNT) DTSCS35
|
|
01182 MOVE SPACES TO PAGE-MISC-2(PAGE-ROW-CNT). DTSCS35
|
|
01183 P7911-EXIT. DTSCS35
|
|
01184 EXIT. DTSCS35
|
|
01185 EJECT DTSCS35
|
|
01186 P7913-NORMAL-INFO. DTSCS35
|
|
01187 ADD +1 TO PAGE-ROW-CNT. DTSCS35
|
|
01188 MOVE MADJ-DOC-NO TO PAGE-DOC-NO(PAGE-ROW-CNT). DTSCS35
|
|
01189 MOVE MADJ-ADJ-TYPE TO PAGE-ADJ-TYPE(PAGE-ROW-CNT). DTSCS35
|
|
01190 MOVE MADJ-AMT TO PAGE-AMT(PAGE-ROW-CNT). DTSCS35
|
|
01191 MOVE MADJ-RECEIVED-DATE TO PAGE-RECEIVED-DATE(PAGE-ROW-CNT). DTSCS35
|
|
01192 MOVE MADJ-ESTB-DATE TO PAGE-PROCESSED-DATE(PAGE-ROW-CNT).DTSCS35
|
|
01193 MOVE MADJ-APPLIC-YRQ TO PAGE-APPLIC-YRQ(PAGE-ROW-CNT). DTSCS35
|
|
01194 MOVE MADJ-APPLIC-IND TO PAGE-APPLIC-IND(PAGE-ROW-CNT). DTSCS35
|
|
01195 MOVE MADJ-APPLIC-DOC-NO TO PAGE-APPLIC-DOC-NO(PAGE-ROW-CNT). DTSCS35
|
|
01196 P7913-EXIT. EXIT. DTSCS35
|
|
01197 DTSCS35
|
|
01198 P7914-CHECK-PAGE. DTSCS35
|
|
01199 IF PAGE-ROW-CNT < ROWS-PER-PAGE DTSCS35
|
|
01200 NEXT SENTENCE DTSCS35
|
|
01201 ELSE DTSCS35
|
|
01202 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS35
|
|
01203 MOVE +0 TO PAGE-ROW-CNT. DTSCS35
|
|
01204 P7914-EXIT. EXIT. DTSCS35
|
|
01205 EJECT DTSCS35
|
|
01206 P8100-STORE-PAGE-AREA. DTSCS35
|
|
01207 IF ITEM-CNT < ITEM-MAX-LCCM DTSCS35
|
|
01208 ADD +1 TO ITEM-CNT DTSCS35
|
|
01209 MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT) DTSCS35
|
|
01210 GO TO P8100-EXIT. DTSCS35
|
|
01211 DTSCS35
|
|
01212 IF ITEM-CNT < ITEM-MAX DTSCS35
|
|
01213 ADD +1 TO ITEM-CNT DTSCS35
|
|
01214 MOVE PAGE-AREA TO L829-REC DTSCS35
|
|
01215 PERFORM S829-WRITE THRU S829-EXIT. DTSCS35
|
|
01216 P8100-EXIT. DTSCS35
|
|
01217 EXIT. DTSCS35
|
|
01218 DTSCS35
|
|
01219 P8200-RETREIVE-PAGE-AREA. DTSCS35
|
|
01220 IF ITEM-SUB > ITEM-MAX-LCCM DTSCS35
|
|
01221 COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM DTSCS35
|
|
01222 PERFORM S829-READ-ITEM THRU S829-EXIT DTSCS35
|
|
01223 IF L829-NO-REC-88 DTSCS35
|
|
01224 GO TO S899-ABEND DTSCS35
|
|
01225 ELSE DTSCS35
|
|
01226 MOVE L829-REC TO PAGE-AREA DTSCS35
|
|
01227 ELSE DTSCS35
|
|
01228 MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA. DTSCS35
|
|
01229 P8200-EXIT. DTSCS35
|
|
01230 EXIT. DTSCS35
|
|
01231 /*****************************************************************DTSCS35
|
|
01232 * LINKS TO UTILITY MODULES DTSCS35
|
|
01233 ******************************************************************DTSCS35
|
|
01234 DTSCS35
|
|
01235 *S001-FROM-FED-8. DTSCS35
|
|
01236 *****SET L001-FROM-FED-8 TO TRUE. DTSCS35
|
|
01237 *****GO TO S001-DATE. DTSCS35
|
|
01238 DTSCS35
|
|
01239 *S001-FROM-ABS-DATE. DTSCS35
|
|
01240 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS35
|
|
01241 *****GO TO S001-DATE. DTSCS35
|
|
01242 DTSCS35
|
|
01243 *S001-DATE. DTSCS35
|
|
01244 *****EXEC CICS LINK DTSCS35
|
|
01245 ***** PROGRAM('MACCU001') DTSCS35
|
|
01246 ***** COMMAREA(L001-COMM-AREA) DTSCS35
|
|
01247 ***** LENGTH(L001-LENGTH) DTSCS35
|
|
01248 *****END-EXEC. DTSCS35
|
|
01249 *S001-EXIT. DTSCS35
|
|
01250 *****EXIT. DTSCS35
|
|
01251 DTSCS35
|
|
01252 *S004-FROM-5. DTSCS35
|
|
01253 *****SET L004-FROM-5 TO TRUE. DTSCS35
|
|
01254 *****GO TO S004-QTR. DTSCS35
|
|
01255 DTSCS35
|
|
01256 *S004-FROM-ABS. DTSCS35
|
|
01257 *****SET L004-FROM-ABS TO TRUE. DTSCS35
|
|
01258 *****GO TO S004-QTR. DTSCS35
|
|
01259 DTSCS35
|
|
01260 *S004-QTR. DTSCS35
|
|
01261 *****EXEC CICS LINK DTSCS35
|
|
01262 ***** PROGRAM('MACCU004') DTSCS35
|
|
01263 ***** COMMAREA(L004-COMM-AREA) DTSCS35
|
|
01264 ***** LENGTH(L004-LENGTH) DTSCS35
|
|
01265 *****END-EXEC. DTSCS35
|
|
01266 *S004-EXIT. DTSCS35
|
|
01267 *****EXIT. DTSCS35
|
|
01268 DTSCS35
|
|
01269 S018-EMP-NO-FROM-SCREEN. DTSCS35
|
|
01270 EXEC CICS LINK DTSCS35
|
|
01271 PROGRAM('DTSCU018') DTSCS35
|
|
01272 COMMAREA(L018-COMM-AREA) DTSCS35
|
|
01273 END-EXEC. DTSCS35
|
|
01274 S018-EXIT. DTSCS35
|
|
01275 EXIT. DTSCS35
|
|
01276 DTSCS35
|
|
01277 S029-YRQ-FROM-SCREEN. DTSCS35
|
|
01278 EXEC CICS LINK DTSCS35
|
|
01279 PROGRAM('DTSCU029') DTSCS35
|
|
01280 COMMAREA(L029-COMM-AREA) DTSCS35
|
|
01281 END-EXEC. DTSCS35
|
|
01282 S029-EXIT. DTSCS35
|
|
01283 EXIT. DTSCS35
|
|
01284 DTSCS35
|
|
01285 S056-DISP1-RIGHT. DTSCS35
|
|
01286 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS35
|
|
01287 GO TO S056-RATE-DISPLAY. DTSCS35
|
|
01288 DTSCS35
|
|
01289 S056-RATE-DISPLAY. DTSCS35
|
|
01290 EXEC CICS LINK DTSCS35
|
|
01291 PROGRAM('DTSCU056') DTSCS35
|
|
01292 COMMAREA(L056-COMM-AREA) DTSCS35
|
|
01293 END-EXEC. DTSCS35
|
|
01294 S056-EXIT. DTSCS35
|
|
01295 EXIT. DTSCS35
|
|
01296 DTSCS35
|
|
01297 S803-REQ-SCR-ID-EDIT. DTSCS35
|
|
01298 EXEC CICS LINK DTSCS35
|
|
01299 PROGRAM ('DTSCU803') DTSCS35
|
|
01300 COMMAREA (DFHCOMMAREA) DTSCS35
|
|
01301 END-EXEC. DTSCS35
|
|
01302 S803-EXIT. DTSCS35
|
|
01303 EXIT. DTSCS35
|
|
01304 DTSCS35
|
|
01305 S804-INVALID-KEY. DTSCS35
|
|
01306 EXEC CICS LINK DTSCS35
|
|
01307 PROGRAM ('DTSCU804') DTSCS35
|
|
01308 COMMAREA (DFHCOMMAREA) DTSCS35
|
|
01309 END-EXEC. DTSCS35
|
|
01310 S804-EXIT. DTSCS35
|
|
01311 EXIT. DTSCS35
|
|
01312 DTSCS35
|
|
01313 S805-MSG-AREA. DTSCS35
|
|
01314 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS35
|
|
01315 DTSCS35
|
|
01316 EXEC CICS LINK DTSCS35
|
|
01317 PROGRAM ('DTSCU805') DTSCS35
|
|
01318 COMMAREA (L805-COMM-AREA) DTSCS35
|
|
01319 END-EXEC. DTSCS35
|
|
01320 DTSCS35
|
|
01321 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS35
|
|
01322 S805-EXIT. DTSCS35
|
|
01323 EXIT. DTSCS35
|
|
01324 EJECT DTSCS35
|
|
01325 S810-READ. DTSCS35
|
|
01326 SET L810-READ-88 TO TRUE. DTSCS35
|
|
01327 GO TO S810-IO. DTSCS35
|
|
01328 DTSCS35
|
|
01329 S810-START-BROWSE. DTSCS35
|
|
01330 SET L810-START-BROWSE-88 TO TRUE. DTSCS35
|
|
01331 GO TO S810-IO. DTSCS35
|
|
01332 DTSCS35
|
|
01333 *S810-READ-NEXT. DTSCS35
|
|
01334 *****SET L810-READ-NEXT-88 TO TRUE. DTSCS35
|
|
01335 *****GO TO S810-IO. DTSCS35
|
|
01336 DTSCS35
|
|
01337 S810-READ-PREV. DTSCS35
|
|
01338 SET L810-READ-PREV-88 TO TRUE. DTSCS35
|
|
01339 GO TO S810-IO. DTSCS35
|
|
01340 DTSCS35
|
|
01341 *S810-END-BROWSE. DTSCS35
|
|
01342 *****SET L810-END-BROWSE-88 TO TRUE. DTSCS35
|
|
01343 *****GO TO S810-IO. DTSCS35
|
|
01344 DTSCS35
|
|
01345 S810-COUNT. DTSCS35
|
|
01346 SET L810-COUNT-88 TO TRUE. DTSCS35
|
|
01347 GO TO S810-IO. DTSCS35
|
|
01348 DTSCS35
|
|
01349 *S810-REWRITE. DTSCS35
|
|
01350 *****SET L810-REWRITE-88 TO TRUE. DTSCS35
|
|
01351 *****GO TO S810-IO. DTSCS35
|
|
01352 ***** DTSCS35
|
|
01353 *S810-WRITE. DTSCS35
|
|
01354 *****SET L810-WRITE-88 TO TRUE. DTSCS35
|
|
01355 *****GO TO S810-IO. DTSCS35
|
|
01356 ***** DTSCS35
|
|
01357 *S810-DELETE. DTSCS35
|
|
01358 *****SET L810-DELETE-88 TO TRUE. DTSCS35
|
|
01359 *****GO TO S810-IO. DTSCS35
|
|
01360 DTSCS35
|
|
01361 S810-IO. DTSCS35
|
|
01362 DTSCS35
|
|
01363 EXEC CICS LINK DTSCS35
|
|
01364 PROGRAM ('DTSCU810') DTSCS35
|
|
01365 COMMAREA (L810-COMM-AREA) DTSCS35
|
|
01366 END-EXEC. DTSCS35
|
|
01367 DTSCS35
|
|
01368 IF L810-FILE-CLOSED-88 DTSCS35
|
|
01369 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS35
|
|
01370 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS35
|
|
01371 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS35
|
|
01372 GO TO MAINLINE-EXIT. DTSCS35
|
|
01373 S810-EXIT. DTSCS35
|
|
01374 EXIT. DTSCS35
|
|
01375 EJECT DTSCS35
|
|
01376 S829-READ-ITEM. DTSCS35
|
|
01377 SET L829-READ-ITEM-88 TO TRUE. DTSCS35
|
|
01378 GO TO S829-IO. DTSCS35
|
|
01379 DTSCS35
|
|
01380 S829-WRITE. DTSCS35
|
|
01381 SET L829-WRITE-88 TO TRUE. DTSCS35
|
|
01382 GO TO S829-IO. DTSCS35
|
|
01383 DTSCS35
|
|
01384 S829-DELETE-QUEUE. DTSCS35
|
|
01385 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS35
|
|
01386 GO TO S829-IO. DTSCS35
|
|
01387 DTSCS35
|
|
01388 S829-IO. DTSCS35
|
|
01389 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS35
|
|
01390 MOVE 'S' TO L829-QUEUE-NAME-SUFFIX. DTSCS35
|
|
01391 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCS35
|
|
01392 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS35
|
|
01393 DTSCS35
|
|
01394 EXEC CICS DTSCS35
|
|
01395 LINK DTSCS35
|
|
01396 PROGRAM ('DTSCU829') DTSCS35
|
|
01397 COMMAREA (L829-COMM-AREA) DTSCS35
|
|
01398 END-EXEC. DTSCS35
|
|
01399 S829-EXIT. DTSCS35
|
|
01400 EXIT. DTSCS35
|
|
01401 EJECT DTSCS35
|
|
01402 S851-SCREEN-PROCESSING. DTSCS35
|
|
01403 EXEC CICS LINK DTSCS35
|
|
01404 PROGRAM ('DTSCU851') DTSCS35
|
|
01405 COMMAREA (L851-COMM-AREA) DTSCS35
|
|
01406 END-EXEC. DTSCS35
|
|
01407 S851-EXIT. DTSCS35
|
|
01408 EXIT. DTSCS35
|
|
01409 DTSCS35
|
|
01410 S899-ABEND. DTSCS35
|
|
01411 EXEC CICS ABEND DTSCS35
|
|
01412 ABCODE(WRK-ABEND-CD) DTSCS35
|
|
01413 END-EXEC. DTSCS35
|
|
01414 S899-EXIT. DTSCS35
|
|
01415 EXIT. DTSCS35
|
|
01416 EJECT DTSCS35
|
|
01417 S1100-EDIT-KEY. DTSCS35
|
|
01418 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS35
|
|
01419 S1100-EXIT. EXIT. DTSCS35
|
|
01420 /*****************************************************************DTSCS35
|
|
01421 * DTSCS35
|
|
01422 ******************************************************************DTSCS35
|
|
01423 S1101-EMP-NO. DTSCS35
|
|
01424 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS35
|
|
01425 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS35
|
|
01426 DTSCS35
|
|
01427 IF L018-NO-ENTRY DTSCS35
|
|
01428 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS35
|
|
01429 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS35
|
|
01430 GO TO S1101-EXIT. DTSCS35
|
|
01431 DTSCS35
|
|
01432 IF L018-NOT-VALID DTSCS35
|
|
01433 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS35
|
|
01434 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS35
|
|
01435 GO TO S1101-EXIT. DTSCS35
|
|
01436 DTSCS35
|
|
01437 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS35
|
|
01438 DTSCS35
|
|
01439 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS35
|
|
01440 S1101-EXIT. EXIT. DTSCS35
|
|
01441 DTSCS35
|
|
01442 S1110-READ-MPRF. DTSCS35
|
|
01443 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS35
|
|
01444 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS35
|
|
01445 SET MPRF-PRF-88 TO TRUE. DTSCS35
|
|
01446 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS35
|
|
01447 PERFORM S810-READ THRU S810-EXIT. DTSCS35
|
|
01448 IF L810-NO-REC-88 DTSCS35
|
|
01449 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS35
|
|
01450 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS35
|
|
01451 ELSE DTSCS35
|
|
01452 MOVE MSKL-REC TO MPRF-REC DTSCS35
|
|
01453 SET WRK-MPRF-YES-88 TO TRUE. DTSCS35
|
|
01454 S1110-EXIT. DTSCS35
|
|
01455 EXIT. DTSCS35
|
|
01456 DTSCS35
|
|
01457 S1199-ERROR. DTSCS35
|
|
01458 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS35
|
|
01459 MAP-EMP-NO-2-A. DTSCS35
|
|
01460 IF LCCM-NO-MSG DTSCS35
|
|
01461 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS35
|
|
01462 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS35
|
|
01463 SET CURSOR-SET-YES TO TRUE. DTSCS35
|
|
01464 S1199-EXIT. EXIT. DTSCS35
|
|
01465 /*****************************************************************DTSCS35
|
|
01466 * DTSCS35
|
|
01467 ******************************************************************DTSCS35
|
|
01468 S1200-YRQ. DTSCS35
|
|
01469 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS35
|
|
01470 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS35
|
|
01471 DTSCS35
|
|
01472 IF L029-NO-ENTRY DTSCS35
|
|
01473 MOVE +0 TO WRK-YRQ DTSCS35
|
|
01474 ELSE DTSCS35
|
|
01475 IF L029-VALID DTSCS35
|
|
01476 MOVE L029-YRQ TO WRK-YRQ DTSCS35
|
|
01477 ELSE DTSCS35
|
|
01478 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS35
|
|
01479 PERFORM S1299-ERROR THRU S1299-EXIT. DTSCS35
|
|
01480 S1200-EXIT. DTSCS35
|
|
01481 EXIT. DTSCS35
|
|
01482 DTSCS35
|
|
01483 S1299-ERROR. DTSCS35
|
|
01484 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A DTSCS35
|
|
01485 MAP-YRQ-Q-A. DTSCS35
|
|
01486 DTSCS35
|
|
01487 IF LCCM-NO-MSG DTSCS35
|
|
01488 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS35
|
|
01489 MOVE CATB-CURSOR TO MAP-YRQ-YR-L DTSCS35
|
|
01490 SET CURSOR-SET-YES TO TRUE. DTSCS35
|
|
01491 S1299-EXIT. DTSCS35
|
|
01492 EXIT. DTSCS35
|
|
01493 /*****************************************************************DTSCS35
|
|
01494 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS35
|
|
01495 ******************************************************************DTSCS35
|
|
01496 S5300-SET-INQ-ATTRB. DTSCS35
|
|
01497 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS35
|
|
01498 WRK-ATB-NUM. DTSCS35
|
|
01499 DTSCS35
|
|
01500 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS35
|
|
01501 S5300-EXIT. DTSCS35
|
|
01502 EXIT. DTSCS35
|
|
01503 DTSCS35
|
|
01504 S5900-SET-ATTRB. DTSCS35
|
|
01505 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS35
|
|
01506 MAP-EMP-NO-2-A. DTSCS35
|
|
01507 DTSCS35
|
|
01508 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A DTSCS35
|
|
01509 MAP-YRQ-Q-A. DTSCS35
|
|
01510 DTSCS35
|
|
01511 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-PRIMARY-NAME-A DTSCS35
|
|
01512 MAP-CURR-PAGE-A DTSCS35
|
|
01513 MAP-LAST-PAGE-A. DTSCS35
|
|
01514 DTSCS35
|
|
01515 PERFORM DTSCS35
|
|
01516 VARYING ROW-OCC FROM 1 BY 1 DTSCS35
|
|
01517 UNTIL ROW-OCC > ROWS-PER-PAGE DTSCS35
|
|
01518 MOVE CATB-ASKIP-BRT-MDTOFF DTSCS35
|
|
01519 TO MAP-LINE-A(ROW-OCC) DTSCS35
|
|
01520 END-PERFORM. DTSCS35
|
|
01521 DTSCS35
|
|
01522 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS35
|
|
01523 S5900-EXIT. DTSCS35
|
|
01524 EXIT. DTSCS35
|
|
01525 /*****************************************************************DTSCS35
|
|
01526 * MAP ROUTINES *DTSCS35
|
|
01527 ******************************************************************DTSCS35
|
|
01528 S9100-RECEIVE. DTSCS35
|
|
01529 SET L851-RECEIVE-88 TO TRUE. DTSCS35
|
|
01530 DTSCS35
|
|
01531 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS35
|
|
01532 DTSCS35
|
|
01533 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS35
|
|
01534 DTSCS35
|
|
01535 MOVE L851-AID TO LCCM-AID. DTSCS35
|
|
01536 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS35
|
|
01537 S9100-EXIT. DTSCS35
|
|
01538 EXIT. DTSCS35
|
|
01539 DTSCS35
|
|
01540 S9200-SEND-DATAONLY. DTSCS35
|
|
01541 MOVE LOW-VALUES TO MAP-AREA. DTSCS35
|
|
01542 DTSCS35
|
|
01543 IF LCCM-NO-MSG DTSCS35
|
|
01544 NEXT SENTENCE DTSCS35
|
|
01545 ELSE DTSCS35
|
|
01546 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS35
|
|
01547 DTSCS35
|
|
01548 IF CURSOR-SET-GOTO DTSCS35
|
|
01549 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS35
|
|
01550 ELSE DTSCS35
|
|
01551 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS35
|
|
01552 DTSCS35
|
|
01553 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS35
|
|
01554 DTSCS35
|
|
01555 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS35
|
|
01556 DTSCS35
|
|
01557 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS35
|
|
01558 S9200-EXIT. DTSCS35
|
|
01559 EXIT. DTSCS35
|
|
01560 DTSCS35
|
|
01561 S9300-SEND-MAP. DTSCS35
|
|
01562 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS35
|
|
01563 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS35
|
|
01564 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS35
|
|
01565 DTSCS35
|
|
01566 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS35
|
|
01567 DTSCS35
|
|
01568 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS35
|
|
01569 DTSCS35
|
|
01570 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS35
|
|
01571 DTSCS35
|
|
01572 IF CURSOR-SET-NO DTSCS35
|
|
01573 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS35
|
|
01574 DTSCS35
|
|
01575 SET L851-SEND-88 TO TRUE. DTSCS35
|
|
01576 DTSCS35
|
|
01577 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS35
|
|
01578 DTSCS35
|
|
01579 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS35
|
|
01580 S9300-EXIT. DTSCS35
|
|
01581 EXIT. DTSCS35
|
|
01582 DTSCS35
|
|
01583 S9320-INQUIRY-FKEYS. DTSCS35
|
|
01584 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS35
|
|
01585 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS35
|
|
01586 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS35
|
|
01587 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS35
|
|
01588 DTSCS35
|
|
01589 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS35
|
|
01590 S9320-EXIT. DTSCS35
|
|
01591 EXIT. DTSCS35
|
|
01592 DTSCS35
|
|
01593 *S9321-JUMP-KEYS. DTSCS35
|
|
01594 * MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ. DTSCS35
|
|
01595 * MOVE 'F11=PAY' TO MAP-KEY-PAY-INQ. DTSCS35
|
|
01596 * MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ. DTSCS35
|
|
01597 *S9321-EXIT. DTSCS35
|
|
01598 * EXIT. DTSCS35
|
|
01599 DTSCS35
|
|
01600 S9330-DSCR-FIELDS. DTSCS35
|
|
01601 IF WRK-MPRF-YES-88 DTSCS35
|
|
01602 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS35
|
|
01603 ELSE DTSCS35
|
|
01604 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS35
|
|
01605 S9330-EXIT. DTSCS35
|
|
01606 EXIT. DTSCS35
|
|
01607 DTSCS35
|
|
01608 S9900-PREPARE-SEND. DTSCS35
|
|
01609 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS35
|
|
01610 LCCM-SCR-ID. DTSCS35
|
|
01611 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS35
|
|
01612 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS35
|
|
01613 S9900-EXIT. DTSCS35
|
|
01614 EXIT. DTSCS35
|