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