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