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