2483 lines
194 KiB
COBOL
2483 lines
194 KiB
COBOL
00001 IDENTIFICATION DIVISION. 04/12/13
|
|
00002 PROGRAM-ID. DTSCS73. DTSCS73
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV018
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS73
|
|
00005 DATE-COMPILED. DTSCS73
|
|
00006 SKIP3 DTSCS73
|
|
00007 ***** DTSCS73
|
|
00008 * DTSCS73
|
|
00009 * FUNCTION: EVENT LOG INQUIRY/UPDATE DTSCS73
|
|
00010 * SCREEN PROCESSOR. DTSCS73
|
|
00011 * DTSCS73
|
|
00012 * DTSCS73
|
|
00013 * MODIFICATION LOG: DTSCS73
|
|
00014 * DTSCS73
|
|
00015 * 09/28/1998 INITIAL DEVELOPMENT. COPIED FROM MACCS73 DTSCS73
|
|
00016 * REFERENCE RFP: PROGRAMMER: ZL1.DTSCS73
|
|
00017 * DTSCS73
|
|
00018 * 10/11/2006 MODIFIED TO RECORD 15 EVENTS TAX STAFF CAN ENTER DTSCS73
|
|
00019 * REFERENCE RFP: PROGRAMMER: ZL1.DTSCS73
|
|
00020 * DTSCS73
|
|
00021 * 03/05/2007 ADDED P8900 TO UPDATED MEVL-TEXT BASED ON DTSCS73
|
|
00022 * BUSINESS AREA AND ACTIVITY CODE. DTSCS73
|
|
00023 * REFERENCE RFP: PROGRAMMER: GD DTSCS73
|
|
00024 * DTSCS73
|
|
00025 * 11/27/2009 ADDED CODE TO UPDATED MEVL-TEXT BASED ON DTSCS73
|
|
00026 * SUPERVISOR APPROVAL. DTSCS73
|
|
00027 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS73
|
|
00028 * DTSCS73
|
|
00029 * 12/15/2009 REMOVED EDIT IN S1700 THAT REQUIRED ENTRY OF DTSCS73
|
|
00030 * AN EVENT. THE EDIT WAS ACCIDENTALLY RE-INSERTED DTSCS73
|
|
00031 * DURING A PREVIOUS UPDATE. DTSCS73
|
|
00032 * REFERENCE RFP: PROGRAMMER: GD DTSCS73
|
|
00033 * DTSCS73
|
|
00034 * 12/16/2009 MODIFIED S1700. IF AN EVENT REQUIRING SUPERVISOR DTSCS73
|
|
00035 * APPROVAL IS SELECTED, SET MAP-APPRV TO 'X'. DTSCS73
|
|
00036 * REFERENCE RFP: PROGRAMMER: GD DTSCS73
|
|
00037 * DTSCS73
|
|
00038 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS73
|
|
00039 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS73
|
|
00040 * WORK ORDER: PROGRAMMER: XXX DTSCS73
|
|
00041 * DTSCS73
|
|
00042 * DTSCS73
|
|
00043 * DESCRIPTION: DTSCS73
|
|
00044 * DTSCS73
|
|
00045 * CLEAR: DTSCS73
|
|
00046 * DTSCS73
|
|
00047 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS73
|
|
00048 * DTSCS73
|
|
00049 * DTSCS73
|
|
00050 * JUMP: DTSCS73
|
|
00051 * DTSCS73
|
|
00052 * F17 REGISTRATION INQUIRY (11). DTSCS73
|
|
00053 * F19 QUARTER INQUIRY (31). DTSCS73
|
|
00054 * F20 COLLECTIONS INQUIRY (41). DTSCS73
|
|
00055 * F21 EVENT LOG INQUIRY (72). DTSCS73
|
|
00056 * DTSCS73
|
|
00057 * DTSCS73
|
|
00058 * INQUIRY: DTSCS73
|
|
00059 * DTSCS73
|
|
00060 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS73
|
|
00061 * DTSCS73
|
|
00062 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR73-HOLD-AREA EMP-NO DTSCS73
|
|
00063 * DISPLAY RECORD INDICATED BY DTSCS73
|
|
00064 * LCCM-SCR73-HOLD-AREA DTSCS73
|
|
00065 * ELSE DTSCS73
|
|
00066 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS73
|
|
00067 * WITH LCCM-EMP-NO. DTSCS73
|
|
00068 * DTSCS73
|
|
00069 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS73
|
|
00070 * DTSCS73
|
|
00071 * DISPLAY SEQUENCE: ASCENDING ON DTSCS73
|
|
00072 * MEVL-DATE + MEVL-TIME. DTSCS73
|
|
00073 * DTSCS73
|
|
00074 * PAGE INITIALLY DISPLAYED: LAST. DTSCS73
|
|
00075 * DTSCS73
|
|
00076 * DTSCS73
|
|
00077 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS73
|
|
00078 * DTSCS73
|
|
00079 * STORE INFORMATION REPRESENTING PAGE DTSCS73
|
|
00080 * CURRENTLY DISPLAYED IN LCCM-SCR73-HOLD-AREA. DTSCS73
|
|
00081 * DTSCS73
|
|
00082 * DTSCS73
|
|
00083 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS73
|
|
00084 * DTSCS73
|
|
00085 * DTSCS73
|
|
00086 * UPDATE: DTSCS73
|
|
00087 * DTSCS73
|
|
00088 * ADD DTSCS73
|
|
00089 * MOD DTSCS73
|
|
00090 * DEL DTSCS73
|
|
00091 * DTSCS73
|
|
00092 * DTSCS73
|
|
00093 * RECORDS READ: DTSCS73
|
|
00094 * DTSCS73
|
|
00095 * MASTER: DTSCS73
|
|
00096 * DTSCS73
|
|
00097 * MPRF DTSCS73
|
|
00098 * MEVL DTSCS73
|
|
00099 * DTSCS73
|
|
00100 * DTSCS73
|
|
00101 * ALTERNATE INDEX: DTSCS73
|
|
00102 * DTSCS73
|
|
00103 * NONE. DTSCS73
|
|
00104 * DTSCS73
|
|
00105 * DTSCS73
|
|
00106 * REFERENCE: DTSCS73
|
|
00107 * DTSCS73
|
|
00108 * NONE. DTSCS73
|
|
00109 * DTSCS73
|
|
00110 * DTSCS73
|
|
00111 * ACCOUNTING TRANSACTION COLLECTION: DTSCS73
|
|
00112 * DTSCS73
|
|
00113 * NONE. DTSCS73
|
|
00114 * DTSCS73
|
|
00115 * DTSCS73
|
|
00116 * RECORDS UPDATED: DTSCS73
|
|
00117 * DTSCS73
|
|
00118 * MASTER: DTSCS73
|
|
00119 * DTSCS73
|
|
00120 * MEVL (ADD, REWRITE, DELETE) DTSCS73
|
|
00121 * DTSCS73
|
|
00122 * DTSCS73
|
|
00123 * REFERENCE: DTSCS73
|
|
00124 * DTSCS73
|
|
00125 * NONE. DTSCS73
|
|
00126 * DTSCS73
|
|
00127 * DTSCS73
|
|
00128 * ACCOUNTING TRANSACTION COLLECTION: DTSCS73
|
|
00129 * DTSCS73
|
|
00130 * NONE. DTSCS73
|
|
00131 * DTSCS73
|
|
00132 * DTSCS73
|
|
00133 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS73
|
|
00134 * DTSCS73
|
|
00135 * NONE. DTSCS73
|
|
00136 * DTSCS73
|
|
00137 * DTSCS73
|
|
00138 * TEMPORARY STORAGE USAGE: DTSCS73
|
|
00139 * DTSCS73
|
|
00140 * NONE DTSCS73
|
|
00141 * DTSCS73
|
|
00142 * DTSCS73
|
|
00143 * MODULES LINKED TO: DTSCS73
|
|
00144 * DTSCS73
|
|
00145 * DTSCU001 DATE EDIT/CONVERSION. DTSCS73
|
|
00146 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS73
|
|
00147 * DTSCU025 TIME FROM SCREEN FORMAT/EDIT. DTSCS73
|
|
00148 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS73
|
|
00149 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS73
|
|
00150 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS73
|
|
00151 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS73
|
|
00152 * DTSCS73
|
|
00153 * DTSCS73
|
|
00154 * VERMONT REFERENCE: DTSCS73
|
|
00155 * DTSCS73
|
|
00156 * NONE. DTSCS73
|
|
00157 * DTSCS73
|
|
00158 * DTSCS73
|
|
00159 * NOTES TO JEFF: DTSCS73
|
|
00160 * DTSCS73
|
|
00161 * . WITH THE EXCEPTION OF ALLOWING "EVENT DATE" AND "EVENT DTSCS73
|
|
00162 * TIME" (WHICH ARE MEVL KEY FIELDS) TO BE CHANGED DURING DTSCS73
|
|
00163 * A MODIFY, THIS SCREEN SHOULD BE VERY SIMPLE. DTSCS73
|
|
00164 * DTSCS73
|
|
00165 * DTSCS73
|
|
00166 ***** DTSCS73
|
|
00167 DTSCS73
|
|
00168 ENVIRONMENT DIVISION. DTSCS73
|
|
00169 DTSCS73
|
|
00170 DATA DIVISION. DTSCS73
|
|
00171 DTSCS73
|
|
00172 WORKING-STORAGE SECTION. DTSCS73
|
|
001725 77 PAN-VALET PICTURE X(24) VALUE '018DTSCS73 04/12/13'. DTSCS73
|
|
00173 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS73 10/12/12'. DTSCS73
|
|
00174 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS73 12/16/09'. DTSCS73
|
|
00175 DTSCS73
|
|
00176 01 WRK-AREA. DTSCS73
|
|
00177 05 WRK-ABEND-CD PIC X(04) VALUE 'S73 '. DTSCS73
|
|
00178 DTSCS73
|
|
00179 05 WRK-SCR-ID. DTSCS73
|
|
00180 10 WRK-SCR-ID-N PIC 9(02) VALUE 73. DTSCS73
|
|
00181 DTSCS73
|
|
00182 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS73
|
|
00183 DTSCS73
|
|
00184 05 SCR-ACCESS-IND PIC X(01). DTSCS73
|
|
00185 88 SCR-ACCESS-INQ VALUE '1'. DTSCS73
|
|
00186 88 SCR-ACCESS-UPDATE VALUE '2' '3'. DTSCS73
|
|
00187 88 SCR-ACCESS-SUPERVISOR VALUE '3'. DTSCS73
|
|
00188 DTSCS73
|
|
00189 05 CURSOR-SET-IND PIC X(01). DTSCS73
|
|
00190 88 CURSOR-SET-YES VALUE 'Y'. DTSCS73
|
|
00191 88 CURSOR-SET-NO VALUE 'N'. DTSCS73
|
|
00192 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS73
|
|
00193 DTSCS73
|
|
00194 05 REQ-IND PIC X(01). DTSCS73
|
|
00195 88 REQ-ERROR VALUE 'O'. DTSCS73
|
|
00196 88 REQ-JUMP VALUE 'J'. DTSCS73
|
|
00197 88 REQ-INQUIRE VALUE 'I'. DTSCS73
|
|
00198 88 REQ-CLEAR VALUE 'C'. DTSCS73
|
|
00199 88 REQ-EDIT VALUE 'E'. DTSCS73
|
|
00200 88 REQ-UPDATE VALUE 'U'. DTSCS73
|
|
00201 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS73
|
|
00202 DTSCS73
|
|
00203 05 RESP-IND PIC X(01). DTSCS73
|
|
00204 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS73
|
|
00205 88 RESP-SEND-MAP VALUE 'M'. DTSCS73
|
|
00206 88 RESP-JUMP VALUE 'J'. DTSCS73
|
|
00207 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS73
|
|
00208 DTSCS73
|
|
00209 DTSCS73
|
|
00210 05 WRK-MSG-AREA PIC X(64). DTSCS73
|
|
00211 DTSCS73
|
|
00212 05 WRK-ATB-AN PIC X(01). DTSCS73
|
|
00213 05 WRK-ATB-NUM PIC X(01). DTSCS73
|
|
00214 DTSCS73
|
|
00215 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS73
|
|
00216 DTSCS73
|
|
00217 05 WRK-MPRF-IND PIC X(01). DTSCS73
|
|
00218 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS73
|
|
00219 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS73
|
|
00220 DTSCS73
|
|
00221 05 WRK-EVENT-SECTION-IND PIC 9(01) VALUE ZEROS. DTSCS73
|
|
00222 05 WRK-EVENT-WORK-IND PIC 9(02) VALUE ZEROS. DTSCS73
|
|
00223 DTSCS73
|
|
00224 05 WRK-BUSINESS-AREA PIC X(12) VALUE SPACES. DTSCS73
|
|
00225 05 WRK-ACTIVITY PIC X(36) VALUE SPACES. DTSCS73
|
|
00226 DTSCS73
|
|
00227 05 WRK-DISPLAY PIC 9(11). DTSCS73
|
|
00228 05 FILLER REDEFINES WRK-DISPLAY. DTSCS73
|
|
00229 10 FILLER PIC X(05). DTSCS73
|
|
00230 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS73
|
|
00231 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS73
|
|
00232 DTSCS73
|
|
00233 05 FILLER REDEFINES WRK-DISPLAY. DTSCS73
|
|
00234 10 FILLER PIC X(05). DTSCS73
|
|
00235 10 WRK-DISPLAY-YR PIC X(02). DTSCS73
|
|
00236 10 WRK-DISPLAY-MO PIC X(02). DTSCS73
|
|
00237 10 WRK-DISPLAY-DA PIC X(02). DTSCS73
|
|
00238 DTSCS73
|
|
00239 05 FILLER REDEFINES WRK-DISPLAY. DTSCS73
|
|
00240 10 FILLER PIC X(05). DTSCS73
|
|
00241 10 WRK-DISPLAY-HR PIC X(02). DTSCS73
|
|
00242 10 WRK-DISPLAY-MN PIC X(02). DTSCS73
|
|
00243 10 WRK-DISPLAY-SC PIC X(02). DTSCS73
|
|
00244 DTSCS73
|
|
00245 DTSCS73
|
|
00246 05 INQUIRY-CONTROL-AREA. DTSCS73
|
|
00247 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS73
|
|
00248 10 WS-REC-NUM PIC S9(08) COMP. DTSCS73
|
|
00249 DTSCS73
|
|
00250 10 LAST-REC-KEY-AREA PIC X(16). DTSCS73
|
|
00251 10 SCR-REC-KEY-AREA PIC X(16). DTSCS73
|
|
00252 DTSCS73
|
|
00253 10 WS-REC-FOUND-IND PIC X(01). DTSCS73
|
|
00254 EJECT DTSCS73
|
|
00255 DTSCS73
|
|
00256 01 MSG-LITERALS. DTSCS73
|
|
00257 DTSCS73
|
|
00258 05 MSG-E731-AREA. DTSCS73
|
|
00259 10 FILLER PIC X(04) VALUE 'E731'. DTSCS73
|
|
00260 10 FILLER PIC X(30) DTSCS73
|
|
00261 VALUE 'RECORD EXISTS. DATE/TIME MATCH'. DTSCS73
|
|
00262 10 FILLER PIC X(30) DTSCS73
|
|
00263 VALUE ' AN EXISTING EVENT LOG. '. DTSCS73
|
|
00264 DTSCS73
|
|
00265 05 MSG-E732-AREA. DTSCS73
|
|
00266 10 FILLER PIC X(04) VALUE 'E732'. DTSCS73
|
|
00267 10 FILLER PIC X(30) DTSCS73
|
|
00268 VALUE 'DATE/TIME MAY NOT BE CHANGED D'. DTSCS73
|
|
00269 10 FILLER PIC X(30) DTSCS73
|
|
00270 VALUE 'URING A DELETE. '. DTSCS73
|
|
00271 DTSCS73
|
|
00272 05 MSG-E733-AREA. DTSCS73
|
|
00273 10 FILLER PIC X(04) VALUE 'E733'. DTSCS73
|
|
00274 10 FILLER PIC X(30) DTSCS73
|
|
00275 VALUE 'EVENT DATE MUST BE <= TAX SYST'. DTSCS73
|
|
00276 10 FILLER PIC X(30) DTSCS73
|
|
00277 VALUE 'EM PROCESSING DATE '. DTSCS73
|
|
00278 DTSCS73
|
|
00279 05 MSG-E734-AREA. DTSCS73
|
|
00280 10 FILLER PIC X(04) VALUE 'E734'. DTSCS73
|
|
00281 10 FILLER PIC X(30) DTSCS73
|
|
00282 VALUE 'EVENT CANNOT BELONG TO MORE TH'. DTSCS73
|
|
00283 10 FILLER PIC X(30) DTSCS73
|
|
00284 VALUE 'AN ONE SECTION. '. DTSCS73
|
|
00285 DTSCS73
|
|
00286 05 MSG-E735-AREA. DTSCS73
|
|
00287 10 FILLER PIC X(04) VALUE 'E735'. DTSCS73
|
|
00288 10 FILLER PIC X(30) DTSCS73
|
|
00289 VALUE 'CANNOT RECORD MORE THAN ONE EV'. DTSCS73
|
|
00290 10 FILLER PIC X(30) DTSCS73
|
|
00291 VALUE 'ENT AT A TIME. '. DTSCS73
|
|
00292 DTSCS73
|
|
00293 05 MSG-E736-AREA. DTSCS73
|
|
00294 10 FILLER PIC X(04) VALUE 'E736'. DTSCS73
|
|
00295 10 FILLER PIC X(30) DTSCS73
|
|
00296 VALUE 'CANNOT MODIFY (CHANGE/DEL) ANO'. DTSCS73
|
|
00297 10 FILLER PIC X(30) DTSCS73
|
|
00298 VALUE 'THER USER EVENT LOG. '. DTSCS73
|
|
00299 DTSCS73
|
|
00300 EJECT DTSCS73
|
|
00301 01 L001-COMM-AREA. DTSCS73
|
|
00302 ++INCLUDE DTSIL001 DTSCS73
|
|
00303 EJECT DTSCS73
|
|
00304 01 L015-COMM-AREA. DTSCS73
|
|
00305 ++INCLUDE DTSIL015 DTSCS73
|
|
00306 EJECT DTSCS73
|
|
00307 01 L018-COMM-AREA. DTSCS73
|
|
00308 ++INCLUDE DTSIL018 DTSCS73
|
|
00309 EJECT DTSCS73
|
|
00310 01 L025-COMM-AREA. DTSCS73
|
|
00311 ++INCLUDE DTSIL025 DTSCS73
|
|
00312 EJECT DTSCS73
|
|
00313 01 L082-COMM-AREA. DTSCS73
|
|
00314 ++INCLUDE DTSIL082 DTSCS73
|
|
00315 EJECT DTSCS73
|
|
00316 01 L221-COMM-AREA. DTSCS73
|
|
00317 ++INCLUDE DTSIL221 DTSCS73
|
|
00318 EJECT DTSCS73
|
|
00319 01 L805-COMM-AREA. DTSCS73
|
|
00320 ++INCLUDE DTSIL805 DTSCS73
|
|
00321 EJECT DTSCS73
|
|
00322 01 L810-COMM-AREA. DTSCS73
|
|
00323 05 L810-CONTROL-BLOCK. DTSCS73
|
|
00324 ++INCLUDE DTSIL810 DTSCS73
|
|
00325 EJECT DTSCS73
|
|
00326 05 MSKL-REC. DTSCS73
|
|
00327 ++INCLUDE DTSIMSKL DTSCS73
|
|
00328 EJECT DTSCS73
|
|
00329 01 MPRF-REC. DTSCS73
|
|
00330 ++INCLUDE DTSIMPRF DTSCS73
|
|
00331 EJECT DTSCS73
|
|
00332 01 MEVL-REC. DTSCS73
|
|
00333 ++INCLUDE DTSIMEVL DTSCS73
|
|
00334 EJECT DTSCS73
|
|
00335 01 L851-COMM-AREA. DTSCS73
|
|
00336 ++INCLUDE DTSIL851 DTSCS73
|
|
00337 DTSCS73
|
|
00338 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS73
|
|
00339 ++INCLUDE DTSIS73 DTSCS73
|
|
00340 EJECT DTSCS73
|
|
00341 01 CATB-LITERALS. DTSCS73
|
|
00342 ++INCLUDE DTSICATB DTSCS73
|
|
00343 DTSCS73
|
|
00344 01 CFKD-LITERALS. DTSCS73
|
|
00345 ++INCLUDE DTSICFKD DTSCS73
|
|
00346 DTSCS73
|
|
00347 01 CECD-LITERALS. DTSCS73
|
|
00348 ++INCLUDE DTSICECD DTSCS73
|
|
00349 DTSCS73
|
|
00350 01 CPCD-LITERALS. DTSCS73
|
|
00351 ++INCLUDE DTSICPCD DTSCS73
|
|
00352 EJECT DTSCS73
|
|
00353 LINKAGE SECTION. DTSCS73
|
|
00354 DTSCS73
|
|
00355 01 DFHCOMMAREA. DTSCS73
|
|
00356 ++INCLUDE DTSILCCM DTSCS73
|
|
00357 EJECT DTSCS73
|
|
00358 ******************************************************************DTSCS73
|
|
00359 * *DTSCS73
|
|
00360 ******************************************************************DTSCS73
|
|
00361 DTSCS73
|
|
00362 PROCEDURE DIVISION. DTSCS73
|
|
00363 DTSCS73
|
|
00364 MOVE +0 TO WRK-EMP-NO. DTSCS73
|
|
00365 SET WRK-MPRF-NO-88 TO TRUE. DTSCS73
|
|
00366 DTSCS73
|
|
00367 MOVE LOW-VALUES TO MAP-AREA. DTSCS73
|
|
00368 DTSCS73
|
|
00369 SET CURSOR-SET-NO TO TRUE. DTSCS73
|
|
00370 DTSCS73
|
|
00371 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS73
|
|
00372 TO SCR-ACCESS-IND. DTSCS73
|
|
00373 DTSCS73
|
|
00374 MOVE SPACE TO REQ-IND. DTSCS73
|
|
00375 DTSCS73
|
|
00376 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS73
|
|
00377 DTSCS73
|
|
00378 *----------------------------------------------------- DTSCS73
|
|
00379 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS73
|
|
00380 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS73
|
|
00381 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS73
|
|
00382 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS73
|
|
00383 * DTSCS73
|
|
00384 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS73
|
|
00385 * PROCESSED. DTSCS73
|
|
00386 * DTSCS73
|
|
00387 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS73
|
|
00388 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS73
|
|
00389 * WORK STATION OPERATOR. DTSCS73
|
|
00390 *----------------------------------------------------- DTSCS73
|
|
00391 DTSCS73
|
|
00392 MOVE SPACE TO RESP-IND. DTSCS73
|
|
00393 DTSCS73
|
|
00394 IF REQ-ERROR DTSCS73
|
|
00395 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS73
|
|
00396 ELSE DTSCS73
|
|
00397 IF REQ-JUMP DTSCS73
|
|
00398 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS73
|
|
00399 ELSE DTSCS73
|
|
00400 IF REQ-CLEAR DTSCS73
|
|
00401 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS73
|
|
00402 ELSE DTSCS73
|
|
00403 IF REQ-CURSOR-TO-GOTO DTSCS73
|
|
00404 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS73
|
|
00405 ELSE DTSCS73
|
|
00406 IF REQ-INQUIRE DTSCS73
|
|
00407 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS73
|
|
00408 ELSE DTSCS73
|
|
00409 IF REQ-EDIT DTSCS73
|
|
00410 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS73
|
|
00411 ELSE DTSCS73
|
|
00412 IF REQ-UPDATE DTSCS73
|
|
00413 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS73
|
|
00414 ELSE DTSCS73
|
|
00415 GO TO S899-ABEND. DTSCS73
|
|
00416 DTSCS73
|
|
00417 *----------------------------------------------------- DTSCS73
|
|
00418 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS73
|
|
00419 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS73
|
|
00420 *----------------------------------------------------- DTSCS73
|
|
00421 DTSCS73
|
|
00422 IF RESP-SEND-MAP DTSCS73
|
|
00423 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS73
|
|
00424 SET LCCM-END-TASK-88 TO TRUE DTSCS73
|
|
00425 ELSE DTSCS73
|
|
00426 IF RESP-SEND-MSGONLY DTSCS73
|
|
00427 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS73
|
|
00428 SET LCCM-END-TASK-88 TO TRUE DTSCS73
|
|
00429 ELSE DTSCS73
|
|
00430 IF RESP-JUMP DTSCS73
|
|
00431 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73
|
|
00432 ELSE DTSCS73
|
|
00433 IF RESP-CURSOR-TO-GOTO DTSCS73
|
|
00434 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS73
|
|
00435 SET LCCM-END-TASK-88 TO TRUE DTSCS73
|
|
00436 ELSE DTSCS73
|
|
00437 GO TO S899-ABEND. DTSCS73
|
|
00438 DTSCS73
|
|
00439 MAINLINE-EXIT. DTSCS73
|
|
00440 DTSCS73
|
|
00441 EXEC CICS DTSCS73
|
|
00442 RETURN DTSCS73
|
|
00443 END-EXEC. DTSCS73
|
|
00444 DTSCS73
|
|
00445 GOBACK. DTSCS73
|
|
00446 EJECT DTSCS73
|
|
00447 /*****************************************************************DTSCS73
|
|
00448 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS73
|
|
00449 ******************************************************************DTSCS73
|
|
00450 P1000-ANALYZE-REQUEST. DTSCS73
|
|
00451 DTSCS73
|
|
00452 *----------------------------------------------------- DTSCS73
|
|
00453 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS73
|
|
00454 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS73
|
|
00455 * REPLACED WITH ENTER) DTSCS73
|
|
00456 *----------------------------------------------------- DTSCS73
|
|
00457 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS73
|
|
00458 SET LCCM-ENTER-88 TO TRUE DTSCS73
|
|
00459 IF LCCM-EMP-NO > ZERO DTSCS73
|
|
00460 SET REQ-INQUIRE TO TRUE DTSCS73
|
|
00461 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS73
|
|
00462 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS73
|
|
00463 ELSE DTSCS73
|
|
00464 SET REQ-INQUIRE TO TRUE DTSCS73
|
|
00465 END-IF DTSCS73
|
|
00466 GO TO P1000-EXIT. DTSCS73
|
|
00467 DTSCS73
|
|
00468 *----------------------------------------------------- DTSCS73
|
|
00469 * MAP IS RECEIVED DTSCS73
|
|
00470 *----------------------------------------------------- DTSCS73
|
|
00471 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS73
|
|
00472 DTSCS73
|
|
00473 *----------------------------------------------------- DTSCS73
|
|
00474 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS73
|
|
00475 * WORK STATION DTSCS73
|
|
00476 *----------------------------------------------------- DTSCS73
|
|
00477 IF LCCM-CLEAR-88 DTSCS73
|
|
00478 SET REQ-CLEAR TO TRUE DTSCS73
|
|
00479 GO TO P1000-EXIT. DTSCS73
|
|
00480 DTSCS73
|
|
00481 *----------------------------------------------------- DTSCS73
|
|
00482 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS73
|
|
00483 *----------------------------------------------------- DTSCS73
|
|
00484 IF LCCM-SCR-UPDATE-LOCKED DTSCS73
|
|
00485 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS73
|
|
00486 GO TO P1000-EXIT. DTSCS73
|
|
00487 DTSCS73
|
|
00488 *----------------------------------------------------- DTSCS73
|
|
00489 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS73
|
|
00490 *----------------------------------------------------- DTSCS73
|
|
00491 IF LCCM-PA2-88 DTSCS73
|
|
00492 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS73
|
|
00493 GO TO P1000-EXIT. DTSCS73
|
|
00494 DTSCS73
|
|
00495 *----------------------------------------------------- DTSCS73
|
|
00496 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS73
|
|
00497 *----------------------------------------------------- DTSCS73
|
|
00498 IF LCCM-PA-88 DTSCS73
|
|
00499 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS73
|
|
00500 SET REQ-ERROR TO TRUE DTSCS73
|
|
00501 GO TO P1000-EXIT. DTSCS73
|
|
00502 DTSCS73
|
|
00503 *----------------------------------------------------- DTSCS73
|
|
00504 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS73
|
|
00505 * CLEAR SCREEN DTSCS73
|
|
00506 *----------------------------------------------------- DTSCS73
|
|
00507 IF LCCM-F12-88 DTSCS73
|
|
00508 MOVE LOW-VALUES TO MAP-AREA DTSCS73
|
|
00509 SET REQ-CLEAR TO TRUE DTSCS73
|
|
00510 GO TO P1000-EXIT. DTSCS73
|
|
00511 DTSCS73
|
|
00512 *----------------------------------------------------- DTSCS73
|
|
00513 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS73
|
|
00514 *----------------------------------------------------- DTSCS73
|
|
00515 IF LCCM-F03-88 DTSCS73
|
|
00516 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS73
|
|
00517 SET REQ-JUMP TO TRUE DTSCS73
|
|
00518 GO TO P1000-EXIT. DTSCS73
|
|
00519 DTSCS73
|
|
00520 *----------------------------------------------------- DTSCS73
|
|
00521 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS73
|
|
00522 *----------------------------------------------------- DTSCS73
|
|
00523 IF LCCM-F04-88 DTSCS73
|
|
00524 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS73
|
|
00525 SET REQ-JUMP TO TRUE DTSCS73
|
|
00526 GO TO P1000-EXIT. DTSCS73
|
|
00527 DTSCS73
|
|
00528 *--------------------------------------------------------- DTSCS73
|
|
00529 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS73
|
|
00530 * CORRESPONDENCE SCREEN. DTSCS73
|
|
00531 *--------------------------------------------------------- DTSCS73
|
|
00532 DTSCS73
|
|
00533 IF LCCM-F14-88 DTSCS73
|
|
00534 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS73
|
|
00535 SET REQ-JUMP TO TRUE DTSCS73
|
|
00536 GO TO P1000-EXIT. DTSCS73
|
|
00537 DTSCS73
|
|
00538 *----------------------------------------------------- DTSCS73
|
|
00539 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS73
|
|
00540 * REQUESTED SCREEN TYPE DTSCS73
|
|
00541 *----------------------------------------------------- DTSCS73
|
|
00542 * JUMP: DTSCS73
|
|
00543 * DTSCS73
|
|
00544 * F17 REGISTRATION INQUIRY (11). DTSCS73
|
|
00545 * F19 QUARTER INQUIRY (31). DTSCS73
|
|
00546 * F20 COLLECTIONS INQUIRY (41). DTSCS73
|
|
00547 * F21 EVENT LOG INQUIRY (72). DTSCS73
|
|
00548 * DTSCS73
|
|
00549 * IF LCCM-F17-88 DTSCS73
|
|
00550 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS73
|
|
00551 * SET REQ-JUMP TO TRUE DTSCS73
|
|
00552 * GO TO P1000-EXIT. DTSCS73
|
|
00553 * DTSCS73
|
|
00554 * IF LCCM-F19-88 DTSCS73
|
|
00555 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS73
|
|
00556 * SET REQ-JUMP TO TRUE DTSCS73
|
|
00557 * GO TO P1000-EXIT. DTSCS73
|
|
00558 * DTSCS73
|
|
00559 * IF LCCM-F20-88 DTSCS73
|
|
00560 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS73
|
|
00561 * SET REQ-JUMP TO TRUE DTSCS73
|
|
00562 * GO TO P1000-EXIT. DTSCS73
|
|
00563 * DTSCS73
|
|
00564 * IF LCCM-F21-88 DTSCS73
|
|
00565 * MOVE '72' TO LCCM-REQ-SCR-ID DTSCS73
|
|
00566 * SET REQ-JUMP TO TRUE DTSCS73
|
|
00567 * GO TO P1000-EXIT. DTSCS73
|
|
00568 DTSCS73
|
|
00569 *----------------------------------------------------- DTSCS73
|
|
00570 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS73
|
|
00571 * REQUESTED SCREEN TYPE DTSCS73
|
|
00572 *----------------------------------------------------- DTSCS73
|
|
00573 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS73
|
|
00574 NEXT SENTENCE DTSCS73
|
|
00575 ELSE DTSCS73
|
|
00576 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS73
|
|
00577 SET REQ-JUMP TO TRUE DTSCS73
|
|
00578 GO TO P1000-EXIT. DTSCS73
|
|
00579 DTSCS73
|
|
00580 *----------------------------------------------------- DTSCS73
|
|
00581 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS73
|
|
00582 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS73
|
|
00583 *----------------------------------------------------- DTSCS73
|
|
00584 IF LCCM-F09-88 DTSCS73
|
|
00585 OR LCCM-F10-88 DTSCS73
|
|
00586 OR LCCM-F23-88 DTSCS73
|
|
00587 IF SCR-ACCESS-UPDATE DTSCS73
|
|
00588 SET REQ-EDIT TO TRUE DTSCS73
|
|
00589 GO TO P1000-EXIT DTSCS73
|
|
00590 ELSE DTSCS73
|
|
00591 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS73
|
|
00592 SET REQ-ERROR TO TRUE DTSCS73
|
|
00593 GO TO P1000-EXIT. DTSCS73
|
|
00594 DTSCS73
|
|
00595 *----------------------------------------------------- DTSCS73
|
|
00596 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS73
|
|
00597 * OR F8), INDICATE INQUIRY REQUEST DTSCS73
|
|
00598 *----------------------------------------------------- DTSCS73
|
|
00599 IF LCCM-INQUIRY-88 DTSCS73
|
|
00600 SET REQ-INQUIRE TO TRUE DTSCS73
|
|
00601 GO TO P1000-EXIT. DTSCS73
|
|
00602 DTSCS73
|
|
00603 *----------------------------------------------------- DTSCS73
|
|
00604 * ANY OTHER KEY IS INVALID DTSCS73
|
|
00605 *----------------------------------------------------- DTSCS73
|
|
00606 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS73
|
|
00607 SET REQ-ERROR TO TRUE. DTSCS73
|
|
00608 P1000-EXIT. DTSCS73
|
|
00609 EXIT. DTSCS73
|
|
00610 DTSCS73
|
|
00611 ******************************************************************DTSCS73
|
|
00612 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS73
|
|
00613 ******************************************************************DTSCS73
|
|
00614 DTSCS73
|
|
00615 P1100-UPDATE-LOCKED. DTSCS73
|
|
00616 *----------------------------------------------------- DTSCS73
|
|
00617 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS73
|
|
00618 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS73
|
|
00619 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS73
|
|
00620 *----------------------------------------------------- DTSCS73
|
|
00621 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS73
|
|
00622 SET REQ-UPDATE TO TRUE DTSCS73
|
|
00623 ELSE DTSCS73
|
|
00624 SET REQ-ERROR TO TRUE DTSCS73
|
|
00625 IF LCCM-SCR-ADD-LOCKED DTSCS73
|
|
00626 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS73
|
|
00627 ELSE DTSCS73
|
|
00628 IF LCCM-SCR-MOD-LOCKED DTSCS73
|
|
00629 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS73
|
|
00630 ELSE DTSCS73
|
|
00631 IF LCCM-SCR-DEL-LOCKED DTSCS73
|
|
00632 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS73
|
|
00633 ELSE DTSCS73
|
|
00634 GO TO S899-ABEND. DTSCS73
|
|
00635 P1100-EXIT. DTSCS73
|
|
00636 EXIT. DTSCS73
|
|
00637 /*****************************************************************DTSCS73
|
|
00638 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS73
|
|
00639 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS73
|
|
00640 ******************************************************************DTSCS73
|
|
00641 DTSCS73
|
|
00642 P2000-REQUEST-ERROR. DTSCS73
|
|
00643 IF LCCM-MSG DTSCS73
|
|
00644 SET RESP-SEND-MSGONLY TO TRUE DTSCS73
|
|
00645 ELSE DTSCS73
|
|
00646 GO TO S899-ABEND. DTSCS73
|
|
00647 P2000-EXIT. DTSCS73
|
|
00648 EXIT. DTSCS73
|
|
00649 /*****************************************************************DTSCS73
|
|
00650 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS73
|
|
00651 ******************************************************************DTSCS73
|
|
00652 DTSCS73
|
|
00653 P3000-REQUEST-JUMP. DTSCS73
|
|
00654 *----------------------------------------------------- DTSCS73
|
|
00655 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS73
|
|
00656 * BY USER DTSCS73
|
|
00657 *----------------------------------------------------- DTSCS73
|
|
00658 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS73
|
|
00659 DTSCS73
|
|
00660 *----------------------------------------------------- DTSCS73
|
|
00661 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS73
|
|
00662 *----------------------------------------------------- DTSCS73
|
|
00663 IF LCCM-MSG DTSCS73
|
|
00664 SET RESP-SEND-MSGONLY TO TRUE DTSCS73
|
|
00665 SET CURSOR-SET-GOTO TO TRUE DTSCS73
|
|
00666 GO TO P3000-EXIT. DTSCS73
|
|
00667 SKIP3 DTSCS73
|
|
00668 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS73
|
|
00669 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS73
|
|
00670 IF L018-VALID DTSCS73
|
|
00671 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS73
|
|
00672 DTSCS73
|
|
00673 *----------------------------------------------------- DTSCS73
|
|
00674 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS73
|
|
00675 *----------------------------------------------------- DTSCS73
|
|
00676 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS73
|
|
00677 LCCM-SCR-HOLD-AREA. DTSCS73
|
|
00678 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS73
|
|
00679 SET RESP-JUMP TO TRUE. DTSCS73
|
|
00680 P3000-EXIT. DTSCS73
|
|
00681 EXIT. DTSCS73
|
|
00682 /*****************************************************************DTSCS73
|
|
00683 * CLEAR KEY WAS PRESSED *DTSCS73
|
|
00684 ******************************************************************DTSCS73
|
|
00685 DTSCS73
|
|
00686 P4000-REQUEST-CLEAR. DTSCS73
|
|
00687 DTSCS73
|
|
00688 *----------------------------------------------------- DTSCS73
|
|
00689 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS73
|
|
00690 * FIELDS FROM EARLIER REQUESTS DTSCS73
|
|
00691 *----------------------------------------------------- DTSCS73
|
|
00692 IF LCCM-EMP-NO > ZERO DTSCS73
|
|
00693 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS73
|
|
00694 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS73
|
|
00695 DTSCS73
|
|
00696 MOVE ZERO TO LCCM-EMP-NO. DTSCS73
|
|
00697 DTSCS73
|
|
00698 MOVE LOW-VALUES TO LCCM-SCR73-HOLD-AREA. DTSCS73
|
|
00699 DTSCS73
|
|
00700 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73
|
|
00701 DTSCS73
|
|
00702 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73
|
|
00703 DTSCS73
|
|
00704 IF SCR-ACCESS-UPDATE DTSCS73
|
|
00705 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS73
|
|
00706 ELSE DTSCS73
|
|
00707 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS73
|
|
00708 DTSCS73
|
|
00709 SET RESP-SEND-MAP TO TRUE. DTSCS73
|
|
00710 P4000-EXIT. DTSCS73
|
|
00711 EXIT. DTSCS73
|
|
00712 /*****************************************************************DTSCS73
|
|
00713 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS73
|
|
00714 ******************************************************************DTSCS73
|
|
00715 DTSCS73
|
|
00716 P5000-CURSOR-TO-GOTO. DTSCS73
|
|
00717 SET CURSOR-SET-GOTO TO TRUE. DTSCS73
|
|
00718 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS73
|
|
00719 P5000-EXIT. DTSCS73
|
|
00720 EXIT. DTSCS73
|
|
00721 /*****************************************************************DTSCS73
|
|
00722 * INQUIRY WAS REQUESTED *DTSCS73
|
|
00723 ******************************************************************DTSCS73
|
|
00724 DTSCS73
|
|
00725 P6000-REQUEST-INQUIRE. DTSCS73
|
|
00726 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS73
|
|
00727 MOVE LOW-VALUES TO MAP-AREA. DTSCS73
|
|
00728 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS73
|
|
00729 DTSCS73
|
|
00730 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73
|
|
00731 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73
|
|
00732 DTSCS73
|
|
00733 SET RESP-SEND-MAP TO TRUE. DTSCS73
|
|
00734 DTSCS73
|
|
00735 IF SCR-ACCESS-UPDATE DTSCS73
|
|
00736 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS73
|
|
00737 ELSE DTSCS73
|
|
00738 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS73
|
|
00739 DTSCS73
|
|
00740 MOVE LCCM-SCR73-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS73
|
|
00741 MOVE LOW-VALUES TO LCCM-SCR73-HOLD-AREA. DTSCS73
|
|
00742 DTSCS73
|
|
00743 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
00744 IF LCCM-MSG DTSCS73
|
|
00745 GO TO P6000-EXIT. DTSCS73
|
|
00746 DTSCS73
|
|
00747 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS73
|
|
00748 DTSCS73
|
|
00749 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS73
|
|
00750 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS73
|
|
00751 SET MSKL-EVL-88 TO TRUE. DTSCS73
|
|
00752 PERFORM S810-COUNT THRU S810-EXIT. DTSCS73
|
|
00753 DTSCS73
|
|
00754 IF L810-RECORD-CNT = +0 DTSCS73
|
|
00755 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73
|
|
00756 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
00757 GO TO P6000-EXIT. DTSCS73
|
|
00758 DTSCS73
|
|
00759 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS73
|
|
00760 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS73
|
|
00761 DTSCS73
|
|
00762 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS73
|
|
00763 IF LCCM-MSG DTSCS73
|
|
00764 GO TO P6000-EXIT. DTSCS73
|
|
00765 DTSCS73
|
|
00766 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS73
|
|
00767 DTSCS73
|
|
00768 MOVE MEVL-KEY-AREA TO LCCM-SCR73-HOLD-AREA. DTSCS73
|
|
00769 DTSCS73
|
|
00770 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS73
|
|
00771 DTSCS73
|
|
00772 IF SCR-ACCESS-UPDATE DTSCS73
|
|
00773 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73
|
|
00774 P6000-EXIT. DTSCS73
|
|
00775 EXIT. DTSCS73
|
|
00776 EJECT DTSCS73
|
|
00777 DTSCS73
|
|
00778 P6100-LOCATE-REC. DTSCS73
|
|
00779 *------------------------------------------------------------ DTSCS73
|
|
00780 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS73
|
|
00781 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS73
|
|
00782 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS73
|
|
00783 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS73
|
|
00784 * RECORD WITH THE GREATEST MEVL-DATE DTSCS73
|
|
00785 *------------------------------------------------------------ DTSCS73
|
|
00786 DTSCS73
|
|
00787 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS73
|
|
00788 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73
|
|
00789 GO TO P6100-EXIT. DTSCS73
|
|
00790 DTSCS73
|
|
00791 MOVE SCR-REC-KEY-AREA TO MEVL-KEY-AREA. DTSCS73
|
|
00792 DTSCS73
|
|
00793 IF WRK-EMP-NO = MEVL-EMP-NO DTSCS73
|
|
00794 NEXT SENTENCE DTSCS73
|
|
00795 ELSE DTSCS73
|
|
00796 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73
|
|
00797 GO TO P6100-EXIT. DTSCS73
|
|
00798 DTSCS73
|
|
00799 IF LCCM-F05-88 DTSCS73
|
|
00800 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS73
|
|
00801 GO TO P6100-EXIT. DTSCS73
|
|
00802 DTSCS73
|
|
00803 IF LCCM-F06-88 DTSCS73
|
|
00804 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73
|
|
00805 GO TO P6100-EXIT. DTSCS73
|
|
00806 DTSCS73
|
|
00807 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS73
|
|
00808 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS73
|
|
00809 SET MSKL-EVL-88 TO TRUE. DTSCS73
|
|
00810 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS73
|
|
00811 IF L810-NO-REC-88 DTSCS73
|
|
00812 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73
|
|
00813 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
00814 GO TO P6100-EXIT. DTSCS73
|
|
00815 DTSCS73
|
|
00816 MOVE +0 TO WS-REC-NUM. DTSCS73
|
|
00817 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS73
|
|
00818 PERFORM P6190-BROWSE-MEVL THRU P6190-EXIT DTSCS73
|
|
00819 UNTIL (L810-NO-REC-88) DTSCS73
|
|
00820 OR DTSCS73
|
|
00821 (WS-REC-FOUND-IND = 'Y'). DTSCS73
|
|
00822 DTSCS73
|
|
00823 IF L810-NO-REC-88 DTSCS73
|
|
00824 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73
|
|
00825 GO TO P6100-EXIT. DTSCS73
|
|
00826 DTSCS73
|
|
00827 IF LCCM-ENTER-88 DTSCS73
|
|
00828 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS73
|
|
00829 GO TO P6100-EXIT. DTSCS73
|
|
00830 DTSCS73
|
|
00831 IF LCCM-F07-88 DTSCS73
|
|
00832 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS73
|
|
00833 GO TO P6100-EXIT. DTSCS73
|
|
00834 DTSCS73
|
|
00835 IF LCCM-F08-88 DTSCS73
|
|
00836 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS73
|
|
00837 GO TO P6100-EXIT. DTSCS73
|
|
00838 DTSCS73
|
|
00839 GO TO S899-ABEND. DTSCS73
|
|
00840 P6100-EXIT. DTSCS73
|
|
00841 EXIT. DTSCS73
|
|
00842 DTSCS73
|
|
00843 P6110-FIRST-REC. DTSCS73
|
|
00844 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS73
|
|
00845 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS73
|
|
00846 SET MSKL-EVL-88 TO TRUE. DTSCS73
|
|
00847 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS73
|
|
00848 IF L810-NO-REC-88 DTSCS73
|
|
00849 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73
|
|
00850 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
00851 GO TO P6110-EXIT. DTSCS73
|
|
00852 DTSCS73
|
|
00853 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS73
|
|
00854 DTSCS73
|
|
00855 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
00856 DTSCS73
|
|
00857 MOVE +1 TO WS-REC-NUM. DTSCS73
|
|
00858 P6110-EXIT. DTSCS73
|
|
00859 EXIT. DTSCS73
|
|
00860 DTSCS73
|
|
00861 P6120-PREV-REC. DTSCS73
|
|
00862 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS73
|
|
00863 IF L810-NO-REC-88 DTSCS73
|
|
00864 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73
|
|
00865 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
00866 GO TO P6120-EXIT. DTSCS73
|
|
00867 DTSCS73
|
|
00868 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS73
|
|
00869 IF L810-NO-REC-88 DTSCS73
|
|
00870 GO TO P6120-EXIT. DTSCS73
|
|
00871 DTSCS73
|
|
00872 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS73
|
|
00873 DTSCS73
|
|
00874 SUBTRACT 1 FROM WS-REC-NUM. DTSCS73
|
|
00875 DTSCS73
|
|
00876 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
00877 P6120-EXIT. DTSCS73
|
|
00878 EXIT. DTSCS73
|
|
00879 DTSCS73
|
|
00880 P6130-NEXT-REC. DTSCS73
|
|
00881 IF MEVL-KEY-AREA > SCR-REC-KEY-AREA DTSCS73
|
|
00882 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS73
|
|
00883 GO TO P6130-EXIT. DTSCS73
|
|
00884 DTSCS73
|
|
00885 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS73
|
|
00886 DTSCS73
|
|
00887 IF L810-NO-REC-88 DTSCS73
|
|
00888 GO TO P6130-EXIT. DTSCS73
|
|
00889 DTSCS73
|
|
00890 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS73
|
|
00891 DTSCS73
|
|
00892 ADD +1 TO WS-REC-NUM. DTSCS73
|
|
00893 DTSCS73
|
|
00894 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
00895 P6130-EXIT. DTSCS73
|
|
00896 EXIT. DTSCS73
|
|
00897 DTSCS73
|
|
00898 P6140-LAST-REC. DTSCS73
|
|
00899 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS73
|
|
00900 PERFORM S810-READ THRU S810-EXIT. DTSCS73
|
|
00901 IF L810-NO-REC-88 DTSCS73
|
|
00902 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73
|
|
00903 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
00904 GO TO P6140-EXIT. DTSCS73
|
|
00905 DTSCS73
|
|
00906 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
00907 DTSCS73
|
|
00908 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS73
|
|
00909 P6140-EXIT. DTSCS73
|
|
00910 EXIT. DTSCS73
|
|
00911 DTSCS73
|
|
00912 P6190-BROWSE-MEVL. DTSCS73
|
|
00913 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
00914 ADD +1 TO WS-REC-NUM. DTSCS73
|
|
00915 IF MEVL-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS73
|
|
00916 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS73
|
|
00917 ELSE DTSCS73
|
|
00918 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS73
|
|
00919 P6190-EXIT. DTSCS73
|
|
00920 EXIT. DTSCS73
|
|
00921 /*****************************************************************DTSCS73
|
|
00922 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS73
|
|
00923 ******************************************************************DTSCS73
|
|
00924 DTSCS73
|
|
00925 P6900-CONSTRUCT-SCREEN. DTSCS73
|
|
00926 PERFORM P6910-FROM-MEVL THRU P6910-EXIT. DTSCS73
|
|
00927 DTSCS73
|
|
00928 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS73
|
|
00929 P6900-EXIT. DTSCS73
|
|
00930 EXIT. DTSCS73
|
|
00931 DTSCS73
|
|
00932 P6910-FROM-MEVL. DTSCS73
|
|
00933 MOVE MEVL-DATE TO WRK-DISPLAY. DTSCS73
|
|
00934 MOVE WRK-DISPLAY-YR TO MAP-DATE-YR. DTSCS73
|
|
00935 MOVE WRK-DISPLAY-MO TO MAP-DATE-MO. DTSCS73
|
|
00936 MOVE WRK-DISPLAY-DA TO MAP-DATE-DA. DTSCS73
|
|
00937 DTSCS73
|
|
00938 MOVE MEVL-TIME TO WRK-DISPLAY. DTSCS73
|
|
00939 MOVE WRK-DISPLAY-HR TO MAP-TIME-HR. DTSCS73
|
|
00940 MOVE WRK-DISPLAY-MN TO MAP-TIME-MN. DTSCS73
|
|
00941 MOVE WRK-DISPLAY-SC TO MAP-TIME-SC. DTSCS73
|
|
00942 DTSCS73
|
|
00943 IF MEVL-BA-STATUS-88 DTSCS73
|
|
00944 MOVE 'X' TO MAP-STAT DTSCS73
|
|
00945 ELSE DTSCS73
|
|
00946 MOVE '_' TO MAP-STAT. DTSCS73
|
|
00947 DTSCS73
|
|
00948 IF MEVL-BA-ACCOUNTING-88 DTSCS73
|
|
00949 MOVE 'X' TO MAP-REPT DTSCS73
|
|
00950 ELSE DTSCS73
|
|
00951 MOVE '_' TO MAP-REPT. DTSCS73
|
|
00952 DTSCS73
|
|
00953 IF MEVL-BA-COLLECTIONS-88 DTSCS73
|
|
00954 MOVE 'X' TO MAP-COLL DTSCS73
|
|
00955 ELSE DTSCS73
|
|
00956 MOVE '_' TO MAP-COLL. DTSCS73
|
|
00957 DTSCS73
|
|
00958 IF MEVL-BA-RATING-88 DTSCS73
|
|
00959 MOVE 'X' TO MAP-RATING DTSCS73
|
|
00960 ELSE DTSCS73
|
|
00961 MOVE '_' TO MAP-RATING. DTSCS73
|
|
00962 DTSCS73
|
|
00963 IF MEVL-BA-AUDIT-88 DTSCS73
|
|
00964 MOVE 'X' TO MAP-AUDIT DTSCS73
|
|
00965 ELSE DTSCS73
|
|
00966 MOVE '_' TO MAP-AUDIT. DTSCS73
|
|
00967 DTSCS73
|
|
00968 IF MEVL-BA-STATUS-APPRV-88 DTSCS73
|
|
00969 MOVE 'X' TO MAP-APPRV DTSCS73
|
|
00970 ELSE DTSCS73
|
|
00971 MOVE '_' TO MAP-APPRV. DTSCS73
|
|
00972 DTSCS73
|
|
00973 DTSCS73
|
|
00974 IF MEVL-ACT-CALL-EMP-88 DTSCS73
|
|
00975 MOVE 'X' TO MAP-CALL-EMP DTSCS73
|
|
00976 ELSE DTSCS73
|
|
00977 MOVE '_' TO MAP-CALL-EMP. DTSCS73
|
|
00978 IF MEVL-ACT-PROC-CALL-LTR-88 DTSCS73
|
|
00979 MOVE 'X' TO MAP-PROC-CLN DTSCS73
|
|
00980 ELSE DTSCS73
|
|
00981 MOVE '_' TO MAP-PROC-CLN. DTSCS73
|
|
00982 IF MEVL-ACT-CALL-AGNT-88 DTSCS73
|
|
00983 MOVE 'X' TO MAP-CALL-AGNT DTSCS73
|
|
00984 ELSE DTSCS73
|
|
00985 MOVE '_' TO MAP-CALL-AGNT. DTSCS73
|
|
00986 IF MEVL-ACT-SEND-FR500-88 DTSCS73
|
|
00987 MOVE 'X' TO MAP-SEND-500 DTSCS73
|
|
00988 ELSE DTSCS73
|
|
00989 MOVE '_' TO MAP-SEND-500. DTSCS73
|
|
00990 IF MEVL-ACT-LETR-EMP-AGNT-88 OR MEVL-ACT-LETR-AGNT-88 DTSCS73
|
|
00991 MOVE 'X' TO MAP-LETR-EMP-AGNT DTSCS73
|
|
00992 ELSE DTSCS73
|
|
00993 MOVE '_' TO MAP-LETR-EMP-AGNT. DTSCS73
|
|
00994 IF MEVL-ACT-SEND-UC30-88 DTSCS73
|
|
00995 MOVE 'X' TO MAP-SEND-30H DTSCS73
|
|
00996 ELSE DTSCS73
|
|
00997 MOVE '_' TO MAP-SEND-30H. DTSCS73
|
|
00998 IF MEVL-ACT-SEND-UC226-88 DTSCS73
|
|
00999 MOVE 'X' TO MAP-SEND-226 DTSCS73
|
|
01000 ELSE DTSCS73
|
|
01001 MOVE '_' TO MAP-SEND-226. DTSCS73
|
|
01002 IF MEVL-ACT-FLD-VISIT-88 DTSCS73
|
|
01003 MOVE 'X' TO MAP-FLD-VISIT DTSCS73
|
|
01004 ELSE DTSCS73
|
|
01005 MOVE '_' TO MAP-FLD-VISIT. DTSCS73
|
|
01006 IF MEVL-ACT-RSLV-BLK-CLM-88 DTSCS73
|
|
01007 MOVE 'X' TO MAP-RSLV-BC DTSCS73
|
|
01008 ELSE DTSCS73
|
|
01009 MOVE '_' TO MAP-RSLV-BC. DTSCS73
|
|
01010 DTSCS73
|
|
01011 IF MEVL-ACT-SRCH-DUTAS-88 DTSCS73
|
|
01012 MOVE 'X' TO MAP-SRCH-TAX DTSCS73
|
|
01013 ELSE DTSCS73
|
|
01014 MOVE '_' TO MAP-SRCH-TAX. DTSCS73
|
|
01015 IF MEVL-ACT-PRE-AUDIT-88 DTSCS73
|
|
01016 MOVE 'X' TO MAP-PRE-AWU DTSCS73
|
|
01017 ELSE DTSCS73
|
|
01018 MOVE '_' TO MAP-PRE-AWU. DTSCS73
|
|
01019 IF MEVL-ACT-SRCH-EXTRNL-88 DTSCS73
|
|
01020 MOVE 'X' TO MAP-SRCH-EXT DTSCS73
|
|
01021 ELSE DTSCS73
|
|
01022 MOVE '_' TO MAP-SRCH-EXT. DTSCS73
|
|
01023 IF MEVL-ACT-EMP-VISIT-88 DTSCS73
|
|
01024 MOVE 'X' TO MAP-EMP-VISIT DTSCS73
|
|
01025 ELSE DTSCS73
|
|
01026 MOVE '_' TO MAP-EMP-VISIT. DTSCS73
|
|
01027 IF MEVL-ACT-SRCH-TAX-FILE-88 DTSCS73
|
|
01028 MOVE 'X' TO MAP-SRCH-FILE DTSCS73
|
|
01029 ELSE DTSCS73
|
|
01030 MOVE '_' TO MAP-SRCH-FILE. DTSCS73
|
|
01031 DTSCS73
|
|
01032 IF MEVL-ACT-APPRV-SUCC-88 DTSCS73
|
|
01033 MOVE 'X' TO MAP-PRED-SUCC DTSCS73
|
|
01034 ELSE DTSCS73
|
|
01035 MOVE '_' TO MAP-PRED-SUCC. DTSCS73
|
|
01036 DTSCS73
|
|
01037 IF MEVL-ACT-APPRV-INACT-88 DTSCS73
|
|
01038 MOVE 'X' TO MAP-CHNG-SOL DTSCS73
|
|
01039 ELSE DTSCS73
|
|
01040 MOVE '_' TO MAP-CHNG-SOL. DTSCS73
|
|
01041 DTSCS73
|
|
01042 IF MEVL-ACT-APPRV-RATE-88 DTSCS73
|
|
01043 MOVE 'X' TO MAP-CHNG-RATE DTSCS73
|
|
01044 ELSE DTSCS73
|
|
01045 MOVE '_' TO MAP-CHNG-RATE. DTSCS73
|
|
01046 DTSCS73
|
|
01047 IF MEVL-ACT-APPRV-WO-88 DTSCS73
|
|
01048 MOVE 'X' TO MAP-WRITE-OFF DTSCS73
|
|
01049 ELSE DTSCS73
|
|
01050 MOVE '_' TO MAP-WRITE-OFF. DTSCS73
|
|
01051 DTSCS73
|
|
01052 MOVE MEVL-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS73
|
|
01053 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS73
|
|
01054 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS73
|
|
01055 DTSCS73
|
|
01056 MOVE MEVL-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS73
|
|
01057 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS73
|
|
01058 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS73
|
|
01059 DTSCS73
|
|
01060 MOVE MEVL-SOURCE TO MAP-SOURCE. DTSCS73
|
|
01061 DTSCS73
|
|
01062 MOVE MEVL-TEXT TO MAP-TEXT. DTSCS73
|
|
01063 DTSCS73
|
|
01064 P6910-EXIT. DTSCS73
|
|
01065 EXIT. DTSCS73
|
|
01066 DTSCS73
|
|
01067 P6990-PAGE-NUMBER. DTSCS73
|
|
01068 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS73
|
|
01069 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS73
|
|
01070 DTSCS73
|
|
01071 IF WS-REC-NUM = +1 DTSCS73
|
|
01072 IF LAST-REC-NUM = +1 DTSCS73
|
|
01073 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS73
|
|
01074 ELSE DTSCS73
|
|
01075 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS73
|
|
01076 ELSE DTSCS73
|
|
01077 IF WS-REC-NUM = LAST-REC-NUM DTSCS73
|
|
01078 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS73
|
|
01079 P6990-EXIT. DTSCS73
|
|
01080 EXIT. DTSCS73
|
|
01081 /*****************************************************************DTSCS73
|
|
01082 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS73
|
|
01083 ******************************************************************DTSCS73
|
|
01084 DTSCS73
|
|
01085 P7000-REQUEST-EDIT. DTSCS73
|
|
01086 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73
|
|
01087 DTSCS73
|
|
01088 IF LCCM-F09-88 DTSCS73
|
|
01089 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS73
|
|
01090 ELSE DTSCS73
|
|
01091 IF LCCM-F10-88 DTSCS73
|
|
01092 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS73
|
|
01093 ELSE DTSCS73
|
|
01094 IF LCCM-F23-88 DTSCS73
|
|
01095 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS73
|
|
01096 ELSE DTSCS73
|
|
01097 GO TO S899-ABEND. DTSCS73
|
|
01098 DTSCS73
|
|
01099 *------------------------------------------------------ DTSCS73
|
|
01100 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS73
|
|
01101 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS73
|
|
01102 * REMAIN IN 'INQUIRE' STATUS. DTSCS73
|
|
01103 *------------------------------------------------------ DTSCS73
|
|
01104 DTSCS73
|
|
01105 IF LCCM-MSG DTSCS73
|
|
01106 NEXT SENTENCE DTSCS73
|
|
01107 ELSE DTSCS73
|
|
01108 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS73
|
|
01109 IF LCCM-F09-88 DTSCS73
|
|
01110 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS73
|
|
01111 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS73
|
|
01112 ELSE DTSCS73
|
|
01113 IF LCCM-F10-88 DTSCS73
|
|
01114 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS73
|
|
01115 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS73
|
|
01116 ELSE DTSCS73
|
|
01117 IF LCCM-F23-88 DTSCS73
|
|
01118 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS73
|
|
01119 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS73
|
|
01120 DTSCS73
|
|
01121 SET RESP-SEND-MAP TO TRUE. DTSCS73
|
|
01122 P7000-EXIT. DTSCS73
|
|
01123 EXIT. DTSCS73
|
|
01124 /*****************************************************************DTSCS73
|
|
01125 * ADD FUNCTION WAS REQUESTED *DTSCS73
|
|
01126 ******************************************************************DTSCS73
|
|
01127 DTSCS73
|
|
01128 P7100-EDIT-ADD. DTSCS73
|
|
01129 *----------------------------------------------------- DTSCS73
|
|
01130 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS73
|
|
01131 *----------------------------------------------------- DTSCS73
|
|
01132 IF NOT LCCM-SCR-CLEAR DTSCS73
|
|
01133 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS73
|
|
01134 GO TO P7100-EXIT. DTSCS73
|
|
01135 DTSCS73
|
|
01136 *----------------------------------------------------- DTSCS73
|
|
01137 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS73
|
|
01138 *----------------------------------------------------- DTSCS73
|
|
01139 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
01140 IF LCCM-MSG DTSCS73
|
|
01141 GO TO P7100-EXIT. DTSCS73
|
|
01142 DTSCS73
|
|
01143 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS73
|
|
01144 P7100-EXIT. DTSCS73
|
|
01145 EXIT. DTSCS73
|
|
01146 /*****************************************************************DTSCS73
|
|
01147 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS73
|
|
01148 ******************************************************************DTSCS73
|
|
01149 DTSCS73
|
|
01150 P7200-EDIT-MOD. DTSCS73
|
|
01151 *----------------------------------------------------- DTSCS73
|
|
01152 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS73
|
|
01153 * INQUIRED DTSCS73
|
|
01154 *----------------------------------------------------- DTSCS73
|
|
01155 IF NOT LCCM-SCR-INQUIRE DTSCS73
|
|
01156 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS73
|
|
01157 GO TO P7200-EXIT. DTSCS73
|
|
01158 DTSCS73
|
|
01159 *----------------------------------------------------- DTSCS73
|
|
01160 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS73
|
|
01161 *----------------------------------------------------- DTSCS73
|
|
01162 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
01163 IF LCCM-MSG DTSCS73
|
|
01164 GO TO P7200-EXIT. DTSCS73
|
|
01165 DTSCS73
|
|
01166 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS73
|
|
01167 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS73
|
|
01168 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
01169 GO TO P7200-EXIT. DTSCS73
|
|
01170 DTSCS73
|
|
01171 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS73
|
|
01172 DTSCS73
|
|
01173 P7200-EXIT. DTSCS73
|
|
01174 EXIT. DTSCS73
|
|
01175 /*****************************************************************DTSCS73
|
|
01176 * DELETE FUNCTION WAS REQUESTED *DTSCS73
|
|
01177 ******************************************************************DTSCS73
|
|
01178 DTSCS73
|
|
01179 P7300-EDIT-DEL. DTSCS73
|
|
01180 *----------------------------------------------------- DTSCS73
|
|
01181 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS73
|
|
01182 * INQUIRED DTSCS73
|
|
01183 *----------------------------------------------------- DTSCS73
|
|
01184 IF NOT LCCM-SCR-INQUIRE DTSCS73
|
|
01185 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS73
|
|
01186 GO TO P7300-EXIT. DTSCS73
|
|
01187 DTSCS73
|
|
01188 *----------------------------------------------------- DTSCS73
|
|
01189 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS73
|
|
01190 *----------------------------------------------------- DTSCS73
|
|
01191 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
01192 IF LCCM-MSG DTSCS73
|
|
01193 GO TO P7300-EXIT. DTSCS73
|
|
01194 DTSCS73
|
|
01195 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS73
|
|
01196 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS73
|
|
01197 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
01198 GO TO P7300-EXIT. DTSCS73
|
|
01199 DTSCS73
|
|
01200 IF LCCM-OP-ID NOT EQUAL MAP-SOURCE DTSCS73
|
|
01201 MOVE MSG-E736-AREA TO WRK-MSG-AREA DTSCS73
|
|
01202 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS73
|
|
01203 GO TO P7300-EXIT. DTSCS73
|
|
01204 *----------------------------------------------------- DTSCS73
|
|
01205 * DATE AND TIME MAY NOT BE CHANGED DURING THE DEL DTSCS73
|
|
01206 *----------------------------------------------------- DTSCS73
|
|
01207 MOVE LCCM-SCR73-HOLD-AREA TO MEVL-KEY-AREA. DTSCS73
|
|
01208 DTSCS73
|
|
01209 MOVE MAP-DATE-AREA TO L015-S-DATE-AREA. DTSCS73
|
|
01210 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS73
|
|
01211 MOVE MAP-TIME-AREA TO L025-S-TIME-AREA. DTSCS73
|
|
01212 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS73
|
|
01213 DTSCS73
|
|
01214 IF L015-DATE = MEVL-DATE DTSCS73
|
|
01215 AND L025-TIME = MEVL-TIME DTSCS73
|
|
01216 CONTINUE DTSCS73
|
|
01217 ELSE DTSCS73
|
|
01218 MOVE MSG-E732-AREA TO WRK-MSG-AREA DTSCS73
|
|
01219 GO TO P7300-EXIT DTSCS73
|
|
01220 END-IF. DTSCS73
|
|
01221 P7300-EXIT. DTSCS73
|
|
01222 EXIT. DTSCS73
|
|
01223 /*****************************************************************DTSCS73
|
|
01224 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS73
|
|
01225 ******************************************************************DTSCS73
|
|
01226 DTSCS73
|
|
01227 P8000-REQUEST-UPDATE. DTSCS73
|
|
01228 DTSCS73
|
|
01229 IF LCCM-SCR-ADD-LOCKED DTSCS73
|
|
01230 PERFORM P8100-ADD THRU P8100-EXIT DTSCS73
|
|
01231 ELSE DTSCS73
|
|
01232 IF LCCM-SCR-MOD-LOCKED DTSCS73
|
|
01233 PERFORM P8200-MOD THRU P8200-EXIT DTSCS73
|
|
01234 ELSE DTSCS73
|
|
01235 IF LCCM-SCR-DEL-LOCKED DTSCS73
|
|
01236 PERFORM P8300-DEL THRU P8300-EXIT DTSCS73
|
|
01237 ELSE DTSCS73
|
|
01238 GO TO S899-ABEND. DTSCS73
|
|
01239 DTSCS73
|
|
01240 SET RESP-SEND-MAP TO TRUE. DTSCS73
|
|
01241 P8000-EXIT. DTSCS73
|
|
01242 EXIT. DTSCS73
|
|
01243 /*****************************************************************DTSCS73
|
|
01244 * *DTSCS73
|
|
01245 ******************************************************************DTSCS73
|
|
01246 DTSCS73
|
|
01247 P8100-ADD. DTSCS73
|
|
01248 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73
|
|
01249 DTSCS73
|
|
01250 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73
|
|
01251 DTSCS73
|
|
01252 IF LCCM-F12-88 DTSCS73
|
|
01253 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS73
|
|
01254 GO TO P8100-EXIT. DTSCS73
|
|
01255 DTSCS73
|
|
01256 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
01257 DTSCS73
|
|
01258 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS73
|
|
01259 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS73
|
|
01260 IF LCCM-MSG DTSCS73
|
|
01261 GO TO P8100-EXIT. DTSCS73
|
|
01262 DTSCS73
|
|
01263 PERFORM P8110-CONSTRUCT-MEVL THRU P8110-EXIT. DTSCS73
|
|
01264 DTSCS73
|
|
01265 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS73
|
|
01266 DTSCS73
|
|
01267 DTSCS73
|
|
01268 MOVE MEVL-KEY-AREA TO LCCM-SCR73-HOLD-AREA. DTSCS73
|
|
01269 SET LCCM-ENTER-88 TO TRUE. DTSCS73
|
|
01270 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS73
|
|
01271 DTSCS73
|
|
01272 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS73
|
|
01273 DTSCS73
|
|
01274 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73
|
|
01275 P8100-EXIT. DTSCS73
|
|
01276 EXIT. DTSCS73
|
|
01277 DTSCS73
|
|
01278 P8110-CONSTRUCT-MEVL. DTSCS73
|
|
01279 MOVE LOW-VALUES TO MEVL-REC. DTSCS73
|
|
01280 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS73
|
|
01281 SET MEVL-EVL-88 TO TRUE. DTSCS73
|
|
01282 DTSCS73
|
|
01283 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS73
|
|
01284 DTSCS73
|
|
01285 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE. DTSCS73
|
|
01286 MOVE LCCM-CURR-RUN-DATE TO MEVL-CHNG-DATE. DTSCS73
|
|
01287 DTSCS73
|
|
01288 MOVE MAP-DATE-AREA TO L015-S-DATE-AREA. DTSCS73
|
|
01289 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS73
|
|
01290 MOVE L015-DATE TO MEVL-DATE. DTSCS73
|
|
01291 DTSCS73
|
|
01292 MOVE MAP-TIME-AREA TO L025-S-TIME-AREA. DTSCS73
|
|
01293 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS73
|
|
01294 MOVE L025-TIME TO MEVL-TIME. DTSCS73
|
|
01295 DTSCS73
|
|
01296 *** MOVE OF TEXT IS NOW IN P8900 DTSCS73
|
|
01297 *** MOVE MAP-TEXT TO MEVL-TEXT. DTSCS73
|
|
01298 DTSCS73
|
|
01299 MOVE MAP-SOURCE TO MEVL-SOURCE. DTSCS73
|
|
01300 DTSCS73
|
|
01301 PERFORM P8900-EVENT-LOG-VALUES THRU P8900-EXIT. DTSCS73
|
|
01302 DTSCS73
|
|
01303 MOVE MEVL-REC TO MSKL-REC. DTSCS73
|
|
01304 PERFORM S810-WRITE THRU S810-EXIT. DTSCS73
|
|
01305 DTSCS73
|
|
01306 P8110-EXIT. DTSCS73
|
|
01307 EXIT. DTSCS73
|
|
01308 DTSCS73
|
|
01309 /*****************************************************************DTSCS73
|
|
01310 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS73
|
|
01311 ******************************************************************DTSCS73
|
|
01312 DTSCS73
|
|
01313 P8200-MOD. DTSCS73
|
|
01314 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS73
|
|
01315 DTSCS73
|
|
01316 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73
|
|
01317 DTSCS73
|
|
01318 IF LCCM-F12-88 DTSCS73
|
|
01319 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS73
|
|
01320 GO TO P8200-EXIT. DTSCS73
|
|
01321 DTSCS73
|
|
01322 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
01323 DTSCS73
|
|
01324 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS73
|
|
01325 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS73
|
|
01326 IF LCCM-MSG DTSCS73
|
|
01327 GO TO P8200-EXIT. DTSCS73
|
|
01328 DTSCS73
|
|
01329 PERFORM P8210-CONSTRUCT-MEVL THRU P8210-EXIT. DTSCS73
|
|
01330 DTSCS73
|
|
01331 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS73
|
|
01332 DTSCS73
|
|
01333 MOVE MEVL-KEY-AREA TO LCCM-SCR73-HOLD-AREA. DTSCS73
|
|
01334 SET LCCM-ENTER-88 TO TRUE. DTSCS73
|
|
01335 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS73
|
|
01336 DTSCS73
|
|
01337 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS73
|
|
01338 DTSCS73
|
|
01339 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73
|
|
01340 P8200-EXIT. DTSCS73
|
|
01341 EXIT. DTSCS73
|
|
01342 EJECT DTSCS73
|
|
01343 P8210-CONSTRUCT-MEVL. DTSCS73
|
|
01344 MOVE LCCM-SCR73-HOLD-AREA TO MSKL-KEY-AREA. DTSCS73
|
|
01345 DTSCS73
|
|
01346 PERFORM S810-READ THRU S810-EXIT. DTSCS73
|
|
01347 IF L810-NO-REC-88 DTSCS73
|
|
01348 GO TO S899-ABEND. DTSCS73
|
|
01349 DTSCS73
|
|
01350 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
01351 DTSCS73
|
|
01352 MOVE LCCM-CURR-RUN-DATE TO MEVL-CHNG-DATE. DTSCS73
|
|
01353 MOVE MAP-TEXT TO MEVL-TEXT. DTSCS73
|
|
01354 MOVE MAP-SOURCE TO MEVL-SOURCE. DTSCS73
|
|
01355 DTSCS73
|
|
01356 MOVE LCCM-CURR-RUN-DATE TO MEVL-CHNG-DATE. DTSCS73
|
|
01357 DTSCS73
|
|
01358 PERFORM P8900-EVENT-LOG-VALUES THRU P8900-EXIT. DTSCS73
|
|
01359 DTSCS73
|
|
01360 MOVE MAP-DATE-AREA TO L015-S-DATE-AREA. DTSCS73
|
|
01361 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS73
|
|
01362 MOVE MAP-TIME-AREA TO L025-S-TIME-AREA. DTSCS73
|
|
01363 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS73
|
|
01364 DTSCS73
|
|
01365 IF L015-DATE = MEVL-DATE DTSCS73
|
|
01366 AND L025-TIME = MEVL-TIME DTSCS73
|
|
01367 MOVE MEVL-REC TO MSKL-REC DTSCS73
|
|
01368 PERFORM S810-REWRITE THRU S810-EXIT DTSCS73
|
|
01369 ELSE DTSCS73
|
|
01370 PERFORM S810-DELETE THRU S810-EXIT DTSCS73
|
|
01371 MOVE L015-DATE TO MEVL-DATE DTSCS73
|
|
01372 MOVE L025-TIME TO MEVL-TIME DTSCS73
|
|
01373 MOVE MEVL-REC TO MSKL-REC DTSCS73
|
|
01374 PERFORM S810-WRITE THRU S810-EXIT DTSCS73
|
|
01375 END-IF. DTSCS73
|
|
01376 DTSCS73
|
|
01377 P8210-EXIT. DTSCS73
|
|
01378 EXIT. DTSCS73
|
|
01379 /*****************************************************************DTSCS73
|
|
01380 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS73
|
|
01381 ******************************************************************DTSCS73
|
|
01382 DTSCS73
|
|
01383 P8300-DEL. DTSCS73
|
|
01384 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS73
|
|
01385 DTSCS73
|
|
01386 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73
|
|
01387 DTSCS73
|
|
01388 IF LCCM-F12-88 DTSCS73
|
|
01389 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS73
|
|
01390 GO TO P8300-EXIT. DTSCS73
|
|
01391 DTSCS73
|
|
01392 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73
|
|
01393 DTSCS73
|
|
01394 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS73
|
|
01395 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS73
|
|
01396 IF LCCM-MSG DTSCS73
|
|
01397 GO TO P8300-EXIT. DTSCS73
|
|
01398 DTSCS73
|
|
01399 DTSCS73
|
|
01400 MOVE LCCM-SCR73-HOLD-AREA TO MSKL-KEY-AREA. DTSCS73
|
|
01401 PERFORM S810-READ THRU S810-EXIT. DTSCS73
|
|
01402 IF L810-NO-REC-88 DTSCS73
|
|
01403 GO TO S899-ABEND. DTSCS73
|
|
01404 DTSCS73
|
|
01405 MOVE MSKL-REC TO MEVL-REC. DTSCS73
|
|
01406 DTSCS73
|
|
01407 PERFORM S810-DELETE THRU S810-EXIT. DTSCS73
|
|
01408 DTSCS73
|
|
01409 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS73
|
|
01410 DTSCS73
|
|
01411 MOVE LOW-VALUES TO MAP-AREA. DTSCS73
|
|
01412 DTSCS73
|
|
01413 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS73
|
|
01414 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS73
|
|
01415 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS73
|
|
01416 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS73
|
|
01417 DTSCS73
|
|
01418 MOVE MEVL-DATE TO WRK-DISPLAY. DTSCS73
|
|
01419 MOVE WRK-DISPLAY-MO TO MAP-DATE-MO. DTSCS73
|
|
01420 MOVE WRK-DISPLAY-DA TO MAP-DATE-DA. DTSCS73
|
|
01421 MOVE WRK-DISPLAY-YR TO MAP-DATE-YR. DTSCS73
|
|
01422 DTSCS73
|
|
01423 MOVE MEVL-TIME TO WRK-DISPLAY. DTSCS73
|
|
01424 MOVE WRK-DISPLAY-HR TO MAP-TIME-HR. DTSCS73
|
|
01425 MOVE WRK-DISPLAY-MN TO MAP-TIME-MN. DTSCS73
|
|
01426 MOVE WRK-DISPLAY-SC TO MAP-TIME-SC. DTSCS73
|
|
01427 DTSCS73
|
|
01428 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73
|
|
01429 DTSCS73
|
|
01430 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73
|
|
01431 DTSCS73
|
|
01432 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73
|
|
01433 DTSCS73
|
|
01434 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS73
|
|
01435 P8300-EXIT. DTSCS73
|
|
01436 EXIT. DTSCS73
|
|
01437 EJECT DTSCS73
|
|
01438 DTSCS73
|
|
01439 DTSCS73
|
|
01440 P8810-LOCK-EMPLOYER. DTSCS73
|
|
01441 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS73
|
|
01442 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS73
|
|
01443 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS73
|
|
01444 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS73
|
|
01445 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS73
|
|
01446 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS73
|
|
01447 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS73
|
|
01448 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS73
|
|
01449 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS73
|
|
01450 DTSCS73
|
|
01451 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS73
|
|
01452 P8810-EXIT. DTSCS73
|
|
01453 EXIT. DTSCS73
|
|
01454 EJECT DTSCS73
|
|
01455 DTSCS73
|
|
01456 P8900-EVENT-LOG-VALUES. DTSCS73
|
|
01457 EVALUATE TRUE DTSCS73
|
|
01458 WHEN MAP-STAT NOT = '_' AND SPACES DTSCS73
|
|
01459 SET MEVL-BA-STATUS-88 TO TRUE DTSCS73
|
|
01460 DTSCS73
|
|
01461 WHEN MAP-REPT NOT = '_' AND SPACES DTSCS73
|
|
01462 SET MEVL-BA-ACCOUNTING-88 TO TRUE DTSCS73
|
|
01463 DTSCS73
|
|
01464 WHEN MAP-COLL NOT = '_' AND SPACES DTSCS73
|
|
01465 SET MEVL-BA-COLLECTIONS-88 TO TRUE DTSCS73
|
|
01466 DTSCS73
|
|
01467 WHEN MAP-RATING NOT = '_' AND SPACES DTSCS73
|
|
01468 SET MEVL-BA-RATING-88 TO TRUE DTSCS73
|
|
01469 DTSCS73
|
|
01470 WHEN MAP-AUDIT NOT = '_' AND SPACES DTSCS73
|
|
01471 SET MEVL-BA-AUDIT-88 TO TRUE DTSCS73
|
|
01472 DTSCS73
|
|
01473 WHEN MAP-APPRV NOT = '_' AND SPACES DTSCS73
|
|
01474 SET MEVL-BA-STATUS-APPRV-88 TO TRUE DTSCS73
|
|
01475 END-EVALUATE. DTSCS73
|
|
01476 DTSCS73
|
|
01477 EVALUATE TRUE DTSCS73
|
|
01478 WHEN MAP-CALL-EMP > SPACES DTSCS73
|
|
01479 SET MEVL-ACT-CALL-EMP-88 TO TRUE DTSCS73
|
|
01480 DTSCS73
|
|
01481 WHEN MAP-PROC-CLN > SPACES DTSCS73
|
|
01482 SET MEVL-ACT-PROC-CALL-LTR-88 TO TRUE DTSCS73
|
|
01483 DTSCS73
|
|
01484 WHEN MAP-CALL-AGNT > SPACES DTSCS73
|
|
01485 SET MEVL-ACT-CALL-AGNT-88 TO TRUE DTSCS73
|
|
01486 DTSCS73
|
|
01487 WHEN MAP-SEND-500 > SPACES DTSCS73
|
|
01488 SET MEVL-ACT-SEND-FR500-88 TO TRUE DTSCS73
|
|
01489 DTSCS73
|
|
01490 WHEN MAP-LETR-EMP-AGNT > SPACES DTSCS73
|
|
01491 SET MEVL-ACT-LETR-EMP-AGNT-88 TO TRUE DTSCS73
|
|
01492 DTSCS73
|
|
01493 WHEN MAP-SEND-30H > SPACES DTSCS73
|
|
01494 SET MEVL-ACT-SEND-UC30-88 TO TRUE DTSCS73
|
|
01495 DTSCS73
|
|
01496 WHEN MAP-SEND-226 > SPACES DTSCS73
|
|
01497 SET MEVL-ACT-SEND-UC226-88 TO TRUE DTSCS73
|
|
01498 DTSCS73
|
|
01499 WHEN MAP-FLD-VISIT > SPACES DTSCS73
|
|
01500 SET MEVL-ACT-FLD-VISIT-88 TO TRUE DTSCS73
|
|
01501 DTSCS73
|
|
01502 WHEN MAP-RSLV-BC > SPACES DTSCS73
|
|
01503 SET MEVL-ACT-RSLV-BLK-CLM-88 TO TRUE DTSCS73
|
|
01504 DTSCS73
|
|
01505 WHEN MAP-SRCH-TAX > SPACES DTSCS73
|
|
01506 SET MEVL-ACT-SRCH-DUTAS-88 TO TRUE DTSCS73
|
|
01507 DTSCS73
|
|
01508 WHEN MAP-PRE-AWU > SPACES DTSCS73
|
|
01509 SET MEVL-ACT-PRE-AUDIT-88 TO TRUE DTSCS73
|
|
01510 DTSCS73
|
|
01511 WHEN MAP-SRCH-EXT > SPACES DTSCS73
|
|
01512 SET MEVL-ACT-SRCH-EXTRNL-88 TO TRUE DTSCS73
|
|
01513 DTSCS73
|
|
01514 WHEN MAP-EMP-VISIT > SPACES DTSCS73
|
|
01515 SET MEVL-ACT-EMP-VISIT-88 TO TRUE DTSCS73
|
|
01516 DTSCS73
|
|
01517 WHEN MAP-SRCH-FILE > SPACES DTSCS73
|
|
01518 SET MEVL-ACT-SRCH-TAX-FILE-88 TO TRUE DTSCS73
|
|
01519 DTSCS73
|
|
01520 WHEN MAP-PRED-SUCC > SPACES DTSCS73
|
|
01521 SET MEVL-ACT-APPRV-SUCC-88 TO TRUE DTSCS73
|
|
01522 DTSCS73
|
|
01523 WHEN MAP-CHNG-SOL > SPACES DTSCS73
|
|
01524 SET MEVL-ACT-APPRV-INACT-88 TO TRUE DTSCS73
|
|
01525 DTSCS73
|
|
01526 WHEN MAP-CHNG-RATE > SPACES DTSCS73
|
|
01527 SET MEVL-ACT-APPRV-RATE-88 TO TRUE DTSCS73
|
|
01528 DTSCS73
|
|
01529 WHEN MAP-WRITE-OFF > SPACES DTSCS73
|
|
01530 SET MEVL-ACT-APPRV-WO-88 TO TRUE DTSCS73
|
|
01531 END-EVALUATE. DTSCS73
|
|
01532 DTSCS73
|
|
01533 IF MEVL-ACTIVITY-CODE > SPACES DTSCS73
|
|
01534 PERFORM P8910-ACTIVITY-DESC THRU P8910-EXIT DTSCS73
|
|
01535 ELSE DTSCS73
|
|
01536 MOVE MAP-TEXT TO MEVL-TEXT DTSCS73
|
|
01537 END-IF. DTSCS73
|
|
01538 DTSCS73
|
|
01539 P8900-EXIT. DTSCS73
|
|
01540 EXIT. DTSCS73
|
|
01541 DTSCS73
|
|
01542 P8910-ACTIVITY-DESC. DTSCS73
|
|
01543 EVALUATE TRUE DTSCS73
|
|
01544 WHEN MEVL-BUSINESS-AREA = '01' DTSCS73
|
|
01545 MOVE 'STATUS' TO WRK-BUSINESS-AREA DTSCS73
|
|
01546 DTSCS73
|
|
01547 WHEN MEVL-BUSINESS-AREA = '02' DTSCS73
|
|
01548 MOVE 'ACCOUNTING' TO WRK-BUSINESS-AREA DTSCS73
|
|
01549 DTSCS73
|
|
01550 WHEN MEVL-BUSINESS-AREA = '03' DTSCS73
|
|
01551 MOVE 'COLLECTIONS' TO WRK-BUSINESS-AREA DTSCS73
|
|
01552 DTSCS73
|
|
01553 WHEN MEVL-BUSINESS-AREA = '04' DTSCS73
|
|
01554 MOVE 'AUDIT' TO WRK-BUSINESS-AREA DTSCS73
|
|
01555 DTSCS73
|
|
01556 WHEN MEVL-BUSINESS-AREA = '05' DTSCS73
|
|
01557 MOVE 'RATING' TO WRK-BUSINESS-AREA DTSCS73
|
|
01558 DTSCS73
|
|
01559 WHEN MEVL-BUSINESS-AREA = '06' DTSCS73
|
|
01560 MOVE 'APPROVAL' TO WRK-BUSINESS-AREA DTSCS73
|
|
01561 DTSCS73
|
|
01562 END-EVALUATE. DTSCS73
|
|
01563 DTSCS73
|
|
01564 EVALUATE TRUE DTSCS73
|
|
01565 WHEN MEVL-ACTIVITY-CODE = '100' DTSCS73
|
|
01566 MOVE 'CALLED EMPLOYER' TO WRK-ACTIVITY DTSCS73
|
|
01567 DTSCS73
|
|
01568 WHEN MEVL-ACTIVITY-CODE = '101' DTSCS73
|
|
01569 MOVE 'LETTER TO EMPLOYER/AGENT' TO WRK-ACTIVITY DTSCS73
|
|
01570 DTSCS73
|
|
01571 WHEN MEVL-ACTIVITY-CODE = '102' DTSCS73
|
|
01572 MOVE 'CALLED FISCAL AGENT' TO WRK-ACTIVITY DTSCS73
|
|
01573 DTSCS73
|
|
01574 WHEN MEVL-ACTIVITY-CODE = '103' DTSCS73
|
|
01575 MOVE 'LETTER TO FISCAL AGENT' TO WRK-ACTIVITY DTSCS73
|
|
01576 DTSCS73
|
|
01577 WHEN MEVL-ACTIVITY-CODE = '104' DTSCS73
|
|
01578 MOVE 'FIELD VISIT' TO WRK-ACTIVITY DTSCS73
|
|
01579 DTSCS73
|
|
01580 WHEN MEVL-ACTIVITY-CODE = '105' DTSCS73
|
|
01581 MOVE 'SEARCHED DUTAS' TO WRK-ACTIVITY DTSCS73
|
|
01582 DTSCS73
|
|
01583 WHEN MEVL-ACTIVITY-CODE = '106' DTSCS73
|
|
01584 MOVE 'SEARCHED EXTERNAL SOURCES' TO WRK-ACTIVITY DTSCS73
|
|
01585 DTSCS73
|
|
01586 WHEN MEVL-ACTIVITY-CODE = '107' DTSCS73
|
|
01587 MOVE 'SEARCHED TAX FILES' TO WRK-ACTIVITY DTSCS73
|
|
01588 DTSCS73
|
|
01589 WHEN MEVL-ACTIVITY-CODE = '108' DTSCS73
|
|
01590 MOVE 'PROCESSED CALL OR LETTER' TO WRK-ACTIVITY DTSCS73
|
|
01591 DTSCS73
|
|
01592 WHEN MEVL-ACTIVITY-CODE = '109' DTSCS73
|
|
01593 MOVE 'SENT FR-500' TO WRK-ACTIVITY DTSCS73
|
|
01594 DTSCS73
|
|
01595 WHEN MEVL-ACTIVITY-CODE = '110' DTSCS73
|
|
01596 MOVE 'SENT UC-30' TO WRK-ACTIVITY DTSCS73
|
|
01597 DTSCS73
|
|
01598 WHEN MEVL-ACTIVITY-CODE = '111' DTSCS73
|
|
01599 MOVE 'SENT UC-226' TO WRK-ACTIVITY DTSCS73
|
|
01600 DTSCS73
|
|
01601 WHEN MEVL-ACTIVITY-CODE = '112' DTSCS73
|
|
01602 MOVE 'RESOLVED BLOCKED CLAIM' TO WRK-ACTIVITY DTSCS73
|
|
01603 DTSCS73
|
|
01604 WHEN MEVL-ACTIVITY-CODE = '113' DTSCS73
|
|
01605 MOVE 'PRE-AUDIT WRITEUP' TO WRK-ACTIVITY DTSCS73
|
|
01606 DTSCS73
|
|
01607 WHEN MEVL-ACTIVITY-CODE = '114' DTSCS73
|
|
01608 MOVE 'VISIT FROM EMPLOYER' TO WRK-ACTIVITY DTSCS73
|
|
01609 DTSCS73
|
|
01610 WHEN MEVL-ACTIVITY-CODE = '117' DTSCS73
|
|
01611 MOVE 'PREDECESSOR/SUCCESSOR' TO WRK-ACTIVITY DTSCS73
|
|
01612 DTSCS73
|
|
01613 WHEN MEVL-ACTIVITY-CODE = '118' DTSCS73
|
|
01614 MOVE 'INACTIVATE/CHNG SOL' TO WRK-ACTIVITY DTSCS73
|
|
01615 DTSCS73
|
|
01616 WHEN MEVL-ACTIVITY-CODE = '119' DTSCS73
|
|
01617 MOVE 'RATE CHANGE ' TO WRK-ACTIVITY DTSCS73
|
|
01618 DTSCS73
|
|
01619 WHEN MEVL-ACTIVITY-CODE = '120' DTSCS73
|
|
01620 MOVE 'WRITE OFF ' TO WRK-ACTIVITY DTSCS73
|
|
01621 DTSCS73
|
|
01622 END-EVALUATE. DTSCS73
|
|
01623 DTSCS73
|
|
01624 STRING DTSCS73
|
|
01625 WRK-ACTIVITY, DTSCS73
|
|
01626 ': ', DTSCS73
|
|
01627 WRK-BUSINESS-AREA DTSCS73
|
|
01628 DELIMITED BY SIZE DTSCS73
|
|
01629 INTO DTSCS73
|
|
01630 MEVL-TEXT DTSCS73
|
|
01631 END-STRING. DTSCS73
|
|
01632 DTSCS73
|
|
01633 MOVE MEVL-TEXT TO MAP-TEXT. DTSCS73
|
|
01634 DTSCS73
|
|
01635 P8910-EXIT. DTSCS73
|
|
01636 EXIT. DTSCS73
|
|
01637 DTSCS73
|
|
01638 /*****************************************************************DTSCS73
|
|
01639 * LINKS TO UTILITY MODULES DTSCS73
|
|
01640 ******************************************************************DTSCS73
|
|
01641 DTSCS73
|
|
01642 S001-FROM-FED-8. DTSCS73
|
|
01643 SET L001-FROM-FED-8 TO TRUE. DTSCS73
|
|
01644 GO TO S001-DATE. DTSCS73
|
|
01645 DTSCS73
|
|
01646 S001-FROM-ABS-DATE. DTSCS73
|
|
01647 SET L001-FROM-ABS-DAY TO TRUE. DTSCS73
|
|
01648 GO TO S001-DATE. DTSCS73
|
|
01649 DTSCS73
|
|
01650 S001-DATE. DTSCS73
|
|
01651 EXEC CICS LINK DTSCS73
|
|
01652 PROGRAM('DTSCU001') DTSCS73
|
|
01653 COMMAREA(L001-COMM-AREA) DTSCS73
|
|
01654 END-EXEC. DTSCS73
|
|
01655 S001-EXIT. DTSCS73
|
|
01656 EXIT. DTSCS73
|
|
01657 DTSCS73
|
|
01658 S015-DATE-FROM-SCREEN. DTSCS73
|
|
01659 EXEC CICS LINK DTSCS73
|
|
01660 PROGRAM('DTSCU015') DTSCS73
|
|
01661 COMMAREA(L015-COMM-AREA) DTSCS73
|
|
01662 END-EXEC. DTSCS73
|
|
01663 S015-EXIT. DTSCS73
|
|
01664 EXIT. DTSCS73
|
|
01665 DTSCS73
|
|
01666 S018-EMP-NO-FROM-SCREEN. DTSCS73
|
|
01667 EXEC CICS LINK DTSCS73
|
|
01668 PROGRAM('DTSCU018') DTSCS73
|
|
01669 COMMAREA(L018-COMM-AREA) DTSCS73
|
|
01670 END-EXEC. DTSCS73
|
|
01671 S018-EXIT. DTSCS73
|
|
01672 EXIT. DTSCS73
|
|
01673 DTSCS73
|
|
01674 S025-TIME-FROM-SCREEN. DTSCS73
|
|
01675 EXEC CICS LINK DTSCS73
|
|
01676 PROGRAM('DTSCU025') DTSCS73
|
|
01677 COMMAREA(L025-COMM-AREA) DTSCS73
|
|
01678 END-EXEC. DTSCS73
|
|
01679 S025-EXIT. DTSCS73
|
|
01680 EXIT. DTSCS73
|
|
01681 DTSCS73
|
|
01682 S082-OP-ID-LOOKUP. DTSCS73
|
|
01683 EXEC CICS LINK DTSCS73
|
|
01684 PROGRAM('DTSCU082') DTSCS73
|
|
01685 COMMAREA(L082-COMM-AREA) DTSCS73
|
|
01686 END-EXEC. DTSCS73
|
|
01687 DTSCS73
|
|
01688 IF L082-FILE-CLOSED DTSCS73
|
|
01689 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01690 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS73
|
|
01691 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73
|
|
01692 GO TO MAINLINE-EXIT. DTSCS73
|
|
01693 DTSCS73
|
|
01694 S082-EXIT. DTSCS73
|
|
01695 EXIT. DTSCS73
|
|
01696 DTSCS73
|
|
01697 S221-EMP-LOCK. DTSCS73
|
|
01698 SET L221-START-UPDATE TO TRUE. DTSCS73
|
|
01699 GO TO S221-EMP-LOCK-UNLOCK. DTSCS73
|
|
01700 DTSCS73
|
|
01701 S221-EMP-UNLOCK. DTSCS73
|
|
01702 SET L221-END-UPDATE TO TRUE. DTSCS73
|
|
01703 GO TO S221-EMP-LOCK-UNLOCK. DTSCS73
|
|
01704 DTSCS73
|
|
01705 S221-EMP-LOCK-UNLOCK. DTSCS73
|
|
01706 EXEC CICS LINK DTSCS73
|
|
01707 PROGRAM('DTSCU221') DTSCS73
|
|
01708 COMMAREA(L221-COMM-AREA) DTSCS73
|
|
01709 END-EXEC. DTSCS73
|
|
01710 DTSCS73
|
|
01711 IF L221-FILE-CLOSED DTSCS73
|
|
01712 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01713 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS73
|
|
01714 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73
|
|
01715 GO TO MAINLINE-EXIT. DTSCS73
|
|
01716 DTSCS73
|
|
01717 IF L221-NOT-OK DTSCS73
|
|
01718 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS73
|
|
01719 S221-EXIT. DTSCS73
|
|
01720 EXIT. DTSCS73
|
|
01721 DTSCS73
|
|
01722 DTSCS73
|
|
01723 S803-REQ-SCR-ID-EDIT. DTSCS73
|
|
01724 EXEC CICS LINK DTSCS73
|
|
01725 PROGRAM ('DTSCU803') DTSCS73
|
|
01726 COMMAREA (DFHCOMMAREA) DTSCS73
|
|
01727 END-EXEC. DTSCS73
|
|
01728 S803-EXIT. DTSCS73
|
|
01729 EXIT. DTSCS73
|
|
01730 DTSCS73
|
|
01731 S804-INVALID-KEY. DTSCS73
|
|
01732 EXEC CICS LINK DTSCS73
|
|
01733 PROGRAM ('DTSCU804') DTSCS73
|
|
01734 COMMAREA (DFHCOMMAREA) DTSCS73
|
|
01735 END-EXEC. DTSCS73
|
|
01736 S804-EXIT. DTSCS73
|
|
01737 EXIT. DTSCS73
|
|
01738 DTSCS73
|
|
01739 S805-MSG-AREA. DTSCS73
|
|
01740 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS73
|
|
01741 DTSCS73
|
|
01742 EXEC CICS LINK DTSCS73
|
|
01743 PROGRAM ('DTSCU805') DTSCS73
|
|
01744 COMMAREA (L805-COMM-AREA) DTSCS73
|
|
01745 END-EXEC. DTSCS73
|
|
01746 DTSCS73
|
|
01747 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS73
|
|
01748 S805-EXIT. DTSCS73
|
|
01749 EXIT. DTSCS73
|
|
01750 EJECT DTSCS73
|
|
01751 S810-READ. DTSCS73
|
|
01752 SET L810-READ-88 TO TRUE. DTSCS73
|
|
01753 GO TO S810-IO. DTSCS73
|
|
01754 DTSCS73
|
|
01755 S810-START-BROWSE. DTSCS73
|
|
01756 SET L810-START-BROWSE-88 TO TRUE. DTSCS73
|
|
01757 GO TO S810-IO. DTSCS73
|
|
01758 DTSCS73
|
|
01759 S810-READ-NEXT. DTSCS73
|
|
01760 SET L810-READ-NEXT-88 TO TRUE. DTSCS73
|
|
01761 GO TO S810-IO. DTSCS73
|
|
01762 DTSCS73
|
|
01763 S810-READ-PREV. DTSCS73
|
|
01764 SET L810-READ-PREV-88 TO TRUE. DTSCS73
|
|
01765 GO TO S810-IO. DTSCS73
|
|
01766 DTSCS73
|
|
01767 S810-END-BROWSE. DTSCS73
|
|
01768 SET L810-END-BROWSE-88 TO TRUE. DTSCS73
|
|
01769 GO TO S810-IO. DTSCS73
|
|
01770 DTSCS73
|
|
01771 S810-COUNT. DTSCS73
|
|
01772 SET L810-COUNT-88 TO TRUE. DTSCS73
|
|
01773 GO TO S810-IO. DTSCS73
|
|
01774 DTSCS73
|
|
01775 S810-REWRITE. DTSCS73
|
|
01776 SET L810-REWRITE-88 TO TRUE. DTSCS73
|
|
01777 GO TO S810-IO. DTSCS73
|
|
01778 DTSCS73
|
|
01779 S810-WRITE. DTSCS73
|
|
01780 SET L810-WRITE-88 TO TRUE. DTSCS73
|
|
01781 GO TO S810-IO. DTSCS73
|
|
01782 DTSCS73
|
|
01783 S810-DELETE. DTSCS73
|
|
01784 SET L810-DELETE-88 TO TRUE. DTSCS73
|
|
01785 GO TO S810-IO. DTSCS73
|
|
01786 DTSCS73
|
|
01787 S810-IO. DTSCS73
|
|
01788 DTSCS73
|
|
01789 EXEC CICS LINK DTSCS73
|
|
01790 PROGRAM ('DTSCU810') DTSCS73
|
|
01791 COMMAREA (L810-COMM-AREA) DTSCS73
|
|
01792 END-EXEC. DTSCS73
|
|
01793 DTSCS73
|
|
01794 IF L810-FILE-CLOSED-88 DTSCS73
|
|
01795 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01796 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS73
|
|
01797 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73
|
|
01798 GO TO MAINLINE-EXIT. DTSCS73
|
|
01799 S810-EXIT. DTSCS73
|
|
01800 EXIT. DTSCS73
|
|
01801 EJECT DTSCS73
|
|
01802 S851-SCREEN-PROCESSING. DTSCS73
|
|
01803 EXEC CICS LINK DTSCS73
|
|
01804 PROGRAM ('DTSCU851') DTSCS73
|
|
01805 COMMAREA (L851-COMM-AREA) DTSCS73
|
|
01806 END-EXEC. DTSCS73
|
|
01807 S851-EXIT. DTSCS73
|
|
01808 EXIT. DTSCS73
|
|
01809 DTSCS73
|
|
01810 S899-ABEND. DTSCS73
|
|
01811 EXEC CICS ABEND DTSCS73
|
|
01812 ABCODE(WRK-ABEND-CD) DTSCS73
|
|
01813 END-EXEC. DTSCS73
|
|
01814 S899-EXIT. DTSCS73
|
|
01815 EXIT. DTSCS73
|
|
01816 /*****************************************************************DTSCS73
|
|
01817 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS73
|
|
01818 ******************************************************************DTSCS73
|
|
01819 DTSCS73
|
|
01820 S1000-SCREEN-EDITS. DTSCS73
|
|
01821 DTSCS73
|
|
01822 DTSCS73
|
|
01823 PERFORM S1200-EVENT-DATE THRU S1200-EXIT. DTSCS73
|
|
01824 PERFORM S1300-EVENT-TIME THRU S1300-EXIT. DTSCS73
|
|
01825 PERFORM S1400-TEXT THRU S1400-EXIT. DTSCS73
|
|
01826 PERFORM S1500-INITIATING-OP THRU S1500-EXIT. DTSCS73
|
|
01827 PERFORM S1600-EVENT-SECTION THRU S1600-EXIT. DTSCS73
|
|
01828 PERFORM S1700-EVENT-WORK-LOG THRU S1700-EXIT. DTSCS73
|
|
01829 DTSCS73
|
|
01830 IF LCCM-MSG DTSCS73
|
|
01831 GO TO S1000-EXIT. DTSCS73
|
|
01832 DTSCS73
|
|
01833 PERFORM S2000-MISC-EDITS THRU S2000-EXIT. DTSCS73
|
|
01834 PERFORM S2100-CROSS-EDITS THRU S2100-EXIT. DTSCS73
|
|
01835 S1000-EXIT. EXIT. DTSCS73
|
|
01836 EJECT DTSCS73
|
|
01837 DTSCS73
|
|
01838 S1100-EDIT-KEY. DTSCS73
|
|
01839 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS73
|
|
01840 S1100-EXIT. EXIT. DTSCS73
|
|
01841 /*****************************************************************DTSCS73
|
|
01842 * DTSCS73
|
|
01843 ******************************************************************DTSCS73
|
|
01844 S1101-EMP-NO. DTSCS73
|
|
01845 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS73
|
|
01846 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS73
|
|
01847 DTSCS73
|
|
01848 IF L018-NO-ENTRY DTSCS73
|
|
01849 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73
|
|
01850 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
01851 GO TO S1101-EXIT. DTSCS73
|
|
01852 DTSCS73
|
|
01853 IF L018-NOT-VALID DTSCS73
|
|
01854 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS73
|
|
01855 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
01856 GO TO S1101-EXIT. DTSCS73
|
|
01857 DTSCS73
|
|
01858 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS73
|
|
01859 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS73
|
|
01860 S1101-EXIT. EXIT. DTSCS73
|
|
01861 DTSCS73
|
|
01862 S1110-READ-MPRF. DTSCS73
|
|
01863 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS73
|
|
01864 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS73
|
|
01865 SET MPRF-PRF-88 TO TRUE. DTSCS73
|
|
01866 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS73
|
|
01867 PERFORM S810-READ THRU S810-EXIT. DTSCS73
|
|
01868 IF L810-NO-REC-88 DTSCS73
|
|
01869 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS73
|
|
01870 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73
|
|
01871 ELSE DTSCS73
|
|
01872 MOVE MSKL-REC TO MPRF-REC DTSCS73
|
|
01873 SET WRK-MPRF-YES-88 TO TRUE. DTSCS73
|
|
01874 S1110-EXIT. DTSCS73
|
|
01875 EXIT. DTSCS73
|
|
01876 DTSCS73
|
|
01877 S1199-ERROR. DTSCS73
|
|
01878 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS73
|
|
01879 MAP-EMP-NO-2-A. DTSCS73
|
|
01880 IF LCCM-NO-MSG DTSCS73
|
|
01881 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01882 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS73
|
|
01883 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
01884 S1199-EXIT. EXIT. DTSCS73
|
|
01885 DTSCS73
|
|
01886 /*****************************************************************DTSCS73
|
|
01887 * *DTSCS73
|
|
01888 ******************************************************************DTSCS73
|
|
01889 S1200-EVENT-DATE. DTSCS73
|
|
01890 MOVE LCCM-TASK-START-DATE TO WRK-DISPLAY DTSCS73
|
|
01891 L015-DATE DTSCS73
|
|
01892 MOVE WRK-DISPLAY-YR TO MAP-DATE-YR DTSCS73
|
|
01893 MOVE WRK-DISPLAY-MO TO MAP-DATE-MO DTSCS73
|
|
01894 MOVE WRK-DISPLAY-DA TO MAP-DATE-DA. DTSCS73
|
|
01895 S1200-EXIT. DTSCS73
|
|
01896 EXIT. DTSCS73
|
|
01897 S1201-ERROR. DTSCS73
|
|
01898 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS73
|
|
01899 TO MAP-DATE-MO-A DTSCS73
|
|
01900 MAP-DATE-DA-A DTSCS73
|
|
01901 MAP-DATE-YR-A. DTSCS73
|
|
01902 IF LCCM-NO-MSG DTSCS73
|
|
01903 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01904 MOVE CATB-CURSOR TO MAP-DATE-MO-L DTSCS73
|
|
01905 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
01906 DTSCS73
|
|
01907 S1201-EXIT. EXIT. DTSCS73
|
|
01908 /*****************************************************************DTSCS73
|
|
01909 * *DTSCS73
|
|
01910 ******************************************************************DTSCS73
|
|
01911 S1300-EVENT-TIME. DTSCS73
|
|
01912 MOVE LCCM-TASK-START-TIME TO WRK-DISPLAY DTSCS73
|
|
01913 L025-TIME DTSCS73
|
|
01914 MOVE WRK-DISPLAY-HR TO MAP-TIME-HR DTSCS73
|
|
01915 MOVE WRK-DISPLAY-MN TO MAP-TIME-MN DTSCS73
|
|
01916 MOVE WRK-DISPLAY-SC TO MAP-TIME-SC. DTSCS73
|
|
01917 S1300-EXIT. DTSCS73
|
|
01918 EXIT. DTSCS73
|
|
01919 DTSCS73
|
|
01920 S1301-ERROR. DTSCS73
|
|
01921 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS73
|
|
01922 TO MAP-TIME-HR-A DTSCS73
|
|
01923 MAP-TIME-MN-A DTSCS73
|
|
01924 MAP-TIME-SC-A. DTSCS73
|
|
01925 IF LCCM-NO-MSG DTSCS73
|
|
01926 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01927 MOVE CATB-CURSOR TO MAP-TIME-HR-L DTSCS73
|
|
01928 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
01929 DTSCS73
|
|
01930 S1301-EXIT. EXIT. DTSCS73
|
|
01931 /*****************************************************************DTSCS73
|
|
01932 * *DTSCS73
|
|
01933 ******************************************************************DTSCS73
|
|
01934 S1400-TEXT. DTSCS73
|
|
01935 INSPECT MAP-TEXT DTSCS73
|
|
01936 CONVERTING LOW-VALUES TO SPACES. DTSCS73
|
|
01937 DTSCS73
|
|
01938 **************************************** DTSCS73
|
|
01939 * THE FOLLOWING EDIT MOVED TO S2100-CROSS-EDITS DTSCS73
|
|
01940 **************************************** DTSCS73
|
|
01941 * IF MAP-TEXT = SPACES DTSCS73
|
|
01942 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73
|
|
01943 * PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS73
|
|
01944 S1400-EXIT. EXIT. DTSCS73
|
|
01945 DTSCS73
|
|
01946 S1401-ERROR. DTSCS73
|
|
01947 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73
|
|
01948 TO MAP-TEXT-A. DTSCS73
|
|
01949 IF LCCM-NO-MSG DTSCS73
|
|
01950 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01951 MOVE CATB-CURSOR TO MAP-TEXT-L DTSCS73
|
|
01952 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
01953 S1401-EXIT. EXIT. DTSCS73
|
|
01954 /*****************************************************************DTSCS73
|
|
01955 * *DTSCS73
|
|
01956 ******************************************************************DTSCS73
|
|
01957 S1500-INITIATING-OP. DTSCS73
|
|
01958 MOVE SPACES TO MAP-SOURCE-DESC DTSCS73
|
|
01959 IF MAP-SOURCE EQUAL LOW-VALUES OR SPACES DTSCS73
|
|
01960 MOVE LCCM-OP-ID TO MAP-SOURCE DTSCS73
|
|
01961 MOVE LCCM-OP-NAME TO MAP-SOURCE-DESC DTSCS73
|
|
01962 ELSE DTSCS73
|
|
01963 IF LCCM-OP-ID NOT EQUAL MAP-SOURCE DTSCS73
|
|
01964 MOVE MSG-E736-AREA TO WRK-MSG-AREA DTSCS73
|
|
01965 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS73
|
|
01966 S1500-EXIT. EXIT. DTSCS73
|
|
01967 DTSCS73
|
|
01968 S1501-ERROR. DTSCS73
|
|
01969 * MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73
|
|
01970 * TO MAP-SOURCE-A. DTSCS73
|
|
01971 IF LCCM-NO-MSG DTSCS73
|
|
01972 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
01973 MOVE CATB-CURSOR TO MAP-SOURCE-L DTSCS73
|
|
01974 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
01975 S1501-EXIT. EXIT. DTSCS73
|
|
01976 ******************************************************************DTSCS73
|
|
01977 S1600-EVENT-SECTION. DTSCS73
|
|
01978 INSPECT MAP-STAT DTSCS73
|
|
01979 CONVERTING '_' TO SPACES. DTSCS73
|
|
01980 DTSCS73
|
|
01981 INSPECT MAP-COLL DTSCS73
|
|
01982 CONVERTING '_' TO SPACES. DTSCS73
|
|
01983 DTSCS73
|
|
01984 INSPECT MAP-REPT DTSCS73
|
|
01985 CONVERTING '_' TO SPACES. DTSCS73
|
|
01986 DTSCS73
|
|
01987 INSPECT MAP-RATING DTSCS73
|
|
01988 CONVERTING '_' TO SPACES. DTSCS73
|
|
01989 DTSCS73
|
|
01990 INSPECT MAP-AUDIT DTSCS73
|
|
01991 CONVERTING '_' TO SPACES. DTSCS73
|
|
01992 DTSCS73
|
|
01993 INSPECT MAP-APPRV DTSCS73
|
|
01994 CONVERTING '_' TO SPACES. DTSCS73
|
|
01995 DTSCS73
|
|
01996 MOVE ZEROS TO WRK-EVENT-SECTION-IND. DTSCS73
|
|
01997 DTSCS73
|
|
01998 IF MAP-STAT > SPACES DTSCS73
|
|
01999 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73
|
|
02000 ELSE DTSCS73
|
|
02001 MOVE '_' TO MAP-STAT. DTSCS73
|
|
02002 IF MAP-REPT > SPACES DTSCS73
|
|
02003 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73
|
|
02004 ELSE DTSCS73
|
|
02005 MOVE '_' TO MAP-REPT. DTSCS73
|
|
02006 DTSCS73
|
|
02007 IF MAP-COLL > SPACES DTSCS73
|
|
02008 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73
|
|
02009 ELSE DTSCS73
|
|
02010 MOVE '_' TO MAP-COLL. DTSCS73
|
|
02011 DTSCS73
|
|
02012 IF MAP-RATING > SPACES DTSCS73
|
|
02013 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73
|
|
02014 ELSE DTSCS73
|
|
02015 MOVE '_' TO MAP-RATING. DTSCS73
|
|
02016 DTSCS73
|
|
02017 IF MAP-AUDIT > SPACES DTSCS73
|
|
02018 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73
|
|
02019 ELSE DTSCS73
|
|
02020 MOVE '_' TO MAP-AUDIT. DTSCS73
|
|
02021 DTSCS73
|
|
02022 IF MAP-APPRV > SPACES DTSCS73
|
|
02023 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73
|
|
02024 ELSE DTSCS73
|
|
02025 MOVE '_' TO MAP-APPRV. DTSCS73
|
|
02026 DTSCS73
|
|
02027 IF WRK-EVENT-SECTION-IND > 1 DTSCS73
|
|
02028 MOVE MSG-E734-AREA TO WRK-MSG-AREA DTSCS73
|
|
02029 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS73
|
|
02030 GO TO S1600-EXIT. DTSCS73
|
|
02031 DTSCS73
|
|
02032 IF WRK-EVENT-SECTION-IND = ZEROS DTSCS73
|
|
02033 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73
|
|
02034 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS73
|
|
02035 DTSCS73
|
|
02036 S1600-EXIT. EXIT. DTSCS73
|
|
02037 DTSCS73
|
|
02038 S1601-ERROR. DTSCS73
|
|
02039 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73
|
|
02040 TO MAP-STAT-A DTSCS73
|
|
02041 MAP-REPT-A DTSCS73
|
|
02042 MAP-COLL-A DTSCS73
|
|
02043 MAP-RATING-A DTSCS73
|
|
02044 MAP-APPRV-A DTSCS73
|
|
02045 MAP-AUDIT-A. DTSCS73
|
|
02046 IF LCCM-NO-MSG DTSCS73
|
|
02047 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
02048 MOVE CATB-CURSOR TO MAP-STAT-L DTSCS73
|
|
02049 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
02050 S1601-EXIT. EXIT. DTSCS73
|
|
02051 ******************************************************************DTSCS73
|
|
02052 S1700-EVENT-WORK-LOG. DTSCS73
|
|
02053 DTSCS73
|
|
02054 MOVE ZEROS TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02055 DTSCS73
|
|
02056 INSPECT MAP-CALL-EMP DTSCS73
|
|
02057 CONVERTING '_' TO SPACES. DTSCS73
|
|
02058 INSPECT MAP-PROC-CLN DTSCS73
|
|
02059 CONVERTING '_' TO SPACES. DTSCS73
|
|
02060 INSPECT MAP-CALL-AGNT DTSCS73
|
|
02061 CONVERTING '_' TO SPACES. DTSCS73
|
|
02062 INSPECT MAP-SEND-500 DTSCS73
|
|
02063 CONVERTING '_' TO SPACES. DTSCS73
|
|
02064 INSPECT MAP-LETR-EMP-AGNT DTSCS73
|
|
02065 CONVERTING '_' TO SPACES. DTSCS73
|
|
02066 INSPECT MAP-SEND-30H DTSCS73
|
|
02067 CONVERTING '_' TO SPACES. DTSCS73
|
|
02068 INSPECT MAP-SEND-226 DTSCS73
|
|
02069 CONVERTING '_' TO SPACES. DTSCS73
|
|
02070 INSPECT MAP-FLD-VISIT DTSCS73
|
|
02071 CONVERTING '_' TO SPACES. DTSCS73
|
|
02072 INSPECT MAP-RSLV-BC DTSCS73
|
|
02073 CONVERTING '_' TO SPACES. DTSCS73
|
|
02074 INSPECT MAP-SRCH-TAX DTSCS73
|
|
02075 CONVERTING '_' TO SPACES. DTSCS73
|
|
02076 INSPECT MAP-PRE-AWU DTSCS73
|
|
02077 CONVERTING '_' TO SPACES. DTSCS73
|
|
02078 INSPECT MAP-SRCH-EXT DTSCS73
|
|
02079 CONVERTING '_' TO SPACES. DTSCS73
|
|
02080 INSPECT MAP-EMP-VISIT DTSCS73
|
|
02081 CONVERTING '_' TO SPACES. DTSCS73
|
|
02082 INSPECT MAP-SRCH-FILE DTSCS73
|
|
02083 CONVERTING '_' TO SPACES. DTSCS73
|
|
02084 INSPECT MAP-PRED-SUCC DTSCS73
|
|
02085 CONVERTING '_' TO SPACES. DTSCS73
|
|
02086 INSPECT MAP-CHNG-SOL DTSCS73
|
|
02087 CONVERTING '_' TO SPACES. DTSCS73
|
|
02088 INSPECT MAP-CHNG-RATE DTSCS73
|
|
02089 CONVERTING '_' TO SPACES. DTSCS73
|
|
02090 INSPECT MAP-WRITE-OFF DTSCS73
|
|
02091 CONVERTING '_' TO SPACES. DTSCS73
|
|
02092 DTSCS73
|
|
02093 IF MAP-CALL-EMP > SPACES DTSCS73
|
|
02094 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02095 DTSCS73
|
|
02096 IF MAP-PROC-CLN > SPACES DTSCS73
|
|
02097 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02098 DTSCS73
|
|
02099 IF MAP-CALL-AGNT > SPACES DTSCS73
|
|
02100 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02101 DTSCS73
|
|
02102 IF MAP-SEND-500 > SPACES DTSCS73
|
|
02103 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02104 DTSCS73
|
|
02105 IF MAP-LETR-EMP-AGNT > SPACES DTSCS73
|
|
02106 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02107 DTSCS73
|
|
02108 IF MAP-SEND-30H > SPACES DTSCS73
|
|
02109 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02110 DTSCS73
|
|
02111 IF MAP-SEND-226 > SPACES DTSCS73
|
|
02112 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02113 DTSCS73
|
|
02114 IF MAP-FLD-VISIT > SPACES DTSCS73
|
|
02115 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02116 DTSCS73
|
|
02117 IF MAP-RSLV-BC > SPACES DTSCS73
|
|
02118 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02119 DTSCS73
|
|
02120 IF MAP-SRCH-TAX > SPACES DTSCS73
|
|
02121 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02122 DTSCS73
|
|
02123 IF MAP-PRE-AWU > SPACES DTSCS73
|
|
02124 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02125 DTSCS73
|
|
02126 IF MAP-SRCH-EXT > SPACES DTSCS73
|
|
02127 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02128 DTSCS73
|
|
02129 IF MAP-EMP-VISIT > SPACES DTSCS73
|
|
02130 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02131 DTSCS73
|
|
02132 IF MAP-SRCH-FILE > SPACES DTSCS73
|
|
02133 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02134 DTSCS73
|
|
02135 IF MAP-PRED-SUCC > SPACES DTSCS73
|
|
02136 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02137 DTSCS73
|
|
02138 IF MAP-CHNG-SOL > SPACES DTSCS73
|
|
02139 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02140 DTSCS73
|
|
02141 IF MAP-CHNG-RATE > SPACES DTSCS73
|
|
02142 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02143 DTSCS73
|
|
02144 IF MAP-WRITE-OFF > SPACES DTSCS73
|
|
02145 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73
|
|
02146 DTSCS73
|
|
02147 IF WRK-EVENT-WORK-IND > 1 DTSCS73
|
|
02148 MOVE MSG-E735-AREA TO WRK-MSG-AREA DTSCS73
|
|
02149 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS73
|
|
02150 DTSCS73
|
|
02151 ** DEFAULT MAP-APPRV TO 'X' IF MAP-PRED-SUCC OR DTSCS73
|
|
02152 ** MAP-CHNG-SOL OR MAP-CHNG-RATE ARE SELECTED. DTSCS73
|
|
02153 IF MAP-PRED-SUCC > SPACES DTSCS73
|
|
02154 OR MAP-CHNG-SOL > SPACES DTSCS73
|
|
02155 OR MAP-CHNG-RATE > SPACES DTSCS73
|
|
02156 OR MAP-WRITE-OFF > SPACES DTSCS73
|
|
02157 MOVE 'X' TO MAP-APPRV DTSCS73
|
|
02158 MOVE '_' TO MAP-STAT DTSCS73
|
|
02159 MOVE '_' TO MAP-COLL DTSCS73
|
|
02160 MOVE '_' TO MAP-REPT DTSCS73
|
|
02161 MOVE '_' TO MAP-RATING DTSCS73
|
|
02162 MOVE '_' TO MAP-AUDIT DTSCS73
|
|
02163 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPRV-A DTSCS73
|
|
02164 END-IF. DTSCS73
|
|
02165 DTSCS73
|
|
02166 *** S2100 CHECKS WHETHER ANYTHING HAS BEEN ENTERED IN DTSCS73
|
|
02167 *** THE TEXT LINE. IT MAY BE BLANK ONLY IF AN EVENT DTSCS73
|
|
02168 *** HAS BEEN SELECTED. DTSCS73
|
|
02169 *** IF WRK-EVENT-WORK-IND = ZEROS DTSCS73
|
|
02170 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73
|
|
02171 *** PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS73
|
|
02172 DTSCS73
|
|
02173 S1700-EXIT. EXIT. DTSCS73
|
|
02174 DTSCS73
|
|
02175 S1701-ERROR. DTSCS73
|
|
02176 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73
|
|
02177 TO MAP-CALL-EMP-A DTSCS73
|
|
02178 MAP-PROC-CLN-A DTSCS73
|
|
02179 MAP-CALL-AGNT-A DTSCS73
|
|
02180 MAP-SEND-500-A DTSCS73
|
|
02181 MAP-LETR-EMP-AGNT-A DTSCS73
|
|
02182 MAP-SEND-30H-A DTSCS73
|
|
02183 MAP-WRITE-OFF-A DTSCS73
|
|
02184 MAP-SEND-226-A DTSCS73
|
|
02185 MAP-FLD-VISIT-A DTSCS73
|
|
02186 MAP-RSLV-BC-A DTSCS73
|
|
02187 MAP-SRCH-TAX-A DTSCS73
|
|
02188 MAP-PRE-AWU-A DTSCS73
|
|
02189 MAP-SRCH-EXT-A DTSCS73
|
|
02190 MAP-EMP-VISIT-A DTSCS73
|
|
02191 MAP-SRCH-FILE-A DTSCS73
|
|
02192 MAP-CHNG-RATE-A DTSCS73
|
|
02193 MAP-CHNG-SOL-A DTSCS73
|
|
02194 MAP-APPRV-A DTSCS73
|
|
02195 MAP-PRED-SUCC-A. DTSCS73
|
|
02196 DTSCS73
|
|
02197 IF NOT SCR-ACCESS-SUPERVISOR DTSCS73
|
|
02198 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS73
|
|
02199 MAP-CHNG-RATE-A DTSCS73
|
|
02200 MAP-WRITE-OFF-A DTSCS73
|
|
02201 MAP-CHNG-SOL-A DTSCS73
|
|
02202 MAP-APPRV-A DTSCS73
|
|
02203 MAP-PRED-SUCC-A. DTSCS73
|
|
02204 DTSCS73
|
|
02205 IF LCCM-NO-MSG DTSCS73
|
|
02206 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73
|
|
02207 MOVE CATB-CURSOR TO MAP-CALL-EMP-L DTSCS73
|
|
02208 SET CURSOR-SET-YES TO TRUE. DTSCS73
|
|
02209 S1701-EXIT. EXIT. DTSCS73
|
|
02210 /*****************************************************************DTSCS73
|
|
02211 DTSCS73
|
|
02212 /*****************************************************************DTSCS73
|
|
02213 * CHECK FOR DUPLICATES *DTSCS73
|
|
02214 ******************************************************************DTSCS73
|
|
02215 S2000-MISC-EDITS. DTSCS73
|
|
02216 IF LCCM-F09-88 DTSCS73
|
|
02217 MOVE LOW-VALUES TO MEVL-KEY-AREA DTSCS73
|
|
02218 MOVE WRK-EMP-NO TO MEVL-EMP-NO DTSCS73
|
|
02219 SET MEVL-EVL-88 TO TRUE DTSCS73
|
|
02220 MOVE L015-DATE TO MEVL-DATE DTSCS73
|
|
02221 MOVE L025-TIME TO MEVL-TIME DTSCS73
|
|
02222 ELSE DTSCS73
|
|
02223 MOVE LCCM-SCR73-HOLD-AREA TO MEVL-KEY-AREA DTSCS73
|
|
02224 IF MEVL-DATE = L015-DATE DTSCS73
|
|
02225 AND MEVL-TIME = L025-TIME DTSCS73
|
|
02226 GO TO S2000-EXIT DTSCS73
|
|
02227 ELSE DTSCS73
|
|
02228 MOVE L015-DATE TO MEVL-DATE DTSCS73
|
|
02229 MOVE L025-TIME TO MEVL-TIME DTSCS73
|
|
02230 END-IF DTSCS73
|
|
02231 END-IF. DTSCS73
|
|
02232 DTSCS73
|
|
02233 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. DTSCS73
|
|
02234 PERFORM S810-READ THRU S810-EXIT. DTSCS73
|
|
02235 IF L810-OK-88 DTSCS73
|
|
02236 IF LCCM-F09-88 DTSCS73
|
|
02237 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS73
|
|
02238 ELSE DTSCS73
|
|
02239 MOVE MSG-E731-AREA TO WRK-MSG-AREA DTSCS73
|
|
02240 END-IF DTSCS73
|
|
02241 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS73
|
|
02242 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS73
|
|
02243 END-IF. DTSCS73
|
|
02244 S2000-EXIT. EXIT. DTSCS73
|
|
02245 DTSCS73
|
|
02246 S2100-CROSS-EDITS. DTSCS73
|
|
02247 IF MAP-TEXT = SPACES DTSCS73
|
|
02248 IF WRK-EVENT-SECTION-IND > 0 DTSCS73
|
|
02249 AND WRK-EVENT-WORK-IND > 0 DTSCS73
|
|
02250 NEXT SENTENCE DTSCS73
|
|
02251 ELSE DTSCS73
|
|
02252 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73
|
|
02253 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS73
|
|
02254 END-IF DTSCS73
|
|
02255 END-IF. DTSCS73
|
|
02256 DTSCS73
|
|
02257 S2100-EXIT. EXIT. DTSCS73
|
|
02258 DTSCS73
|
|
02259 /*****************************************************************DTSCS73
|
|
02260 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS73
|
|
02261 ******************************************************************DTSCS73
|
|
02262 S5100-SET-LOCK-ATTRB. DTSCS73
|
|
02263 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS73
|
|
02264 WRK-ATB-NUM. DTSCS73
|
|
02265 DTSCS73
|
|
02266 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS73
|
|
02267 DTSCS73
|
|
02268 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS73
|
|
02269 MAP-EMP-NO-2-A DTSCS73
|
|
02270 MAP-GOTO-A. DTSCS73
|
|
02271 S5100-EXIT. DTSCS73
|
|
02272 EXIT. DTSCS73
|
|
02273 DTSCS73
|
|
02274 ******************************************************************DTSCS73
|
|
02275 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS73
|
|
02276 ******************************************************************DTSCS73
|
|
02277 S5200-SET-UPDATE-ATTRB. DTSCS73
|
|
02278 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS73
|
|
02279 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS73
|
|
02280 DTSCS73
|
|
02281 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS73
|
|
02282 S5200-EXIT. DTSCS73
|
|
02283 EXIT. DTSCS73
|
|
02284 DTSCS73
|
|
02285 ******************************************************************DTSCS73
|
|
02286 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS73
|
|
02287 ******************************************************************DTSCS73
|
|
02288 S5300-SET-INQ-ATTRB. DTSCS73
|
|
02289 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS73
|
|
02290 WRK-ATB-NUM. DTSCS73
|
|
02291 DTSCS73
|
|
02292 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS73
|
|
02293 S5300-EXIT. DTSCS73
|
|
02294 EXIT. DTSCS73
|
|
02295 DTSCS73
|
|
02296 S5900-SET-ATTRB. DTSCS73
|
|
02297 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS73
|
|
02298 MAP-EMP-NO-2-A. DTSCS73
|
|
02299 DTSCS73
|
|
02300 MOVE WRK-ATB-AN TO DTSCS73
|
|
02301 MAP-SOURCE-A DTSCS73
|
|
02302 MAP-TEXT-A DTSCS73
|
|
02303 MAP-STAT-A DTSCS73
|
|
02304 MAP-COLL-A DTSCS73
|
|
02305 MAP-REPT-A DTSCS73
|
|
02306 MAP-RATING-A DTSCS73
|
|
02307 MAP-AUDIT-A DTSCS73
|
|
02308 MAP-CALL-EMP-A DTSCS73
|
|
02309 MAP-PROC-CLN-A DTSCS73
|
|
02310 MAP-CALL-AGNT-A DTSCS73
|
|
02311 MAP-SEND-500-A DTSCS73
|
|
02312 MAP-LETR-EMP-AGNT-A DTSCS73
|
|
02313 MAP-SEND-30H-A DTSCS73
|
|
02314 MAP-WRITE-OFF-A DTSCS73
|
|
02315 MAP-SEND-226-A DTSCS73
|
|
02316 MAP-FLD-VISIT-A DTSCS73
|
|
02317 MAP-RSLV-BC-A DTSCS73
|
|
02318 MAP-SRCH-TAX-A DTSCS73
|
|
02319 MAP-PRE-AWU-A DTSCS73
|
|
02320 MAP-SRCH-EXT-A DTSCS73
|
|
02321 MAP-EMP-VISIT-A DTSCS73
|
|
02322 MAP-SRCH-FILE-A DTSCS73
|
|
02323 MAP-PRED-SUCC-A DTSCS73
|
|
02324 MAP-CHNG-SOL-A DTSCS73
|
|
02325 MAP-APPRV-A DTSCS73
|
|
02326 MAP-CHNG-RATE-A. DTSCS73
|
|
02327 DTSCS73
|
|
02328 IF NOT SCR-ACCESS-SUPERVISOR DTSCS73
|
|
02329 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS73
|
|
02330 MAP-WRITE-OFF-A DTSCS73
|
|
02331 MAP-PRED-SUCC-A DTSCS73
|
|
02332 MAP-CHNG-SOL-A DTSCS73
|
|
02333 MAP-APPRV-A DTSCS73
|
|
02334 MAP-CHNG-RATE-A. DTSCS73
|
|
02335 DTSCS73
|
|
02336 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS73
|
|
02337 MAP-SOURCE-A DTSCS73
|
|
02338 MAP-DATE-MO-A DTSCS73
|
|
02339 MAP-DATE-DA-A DTSCS73
|
|
02340 MAP-DATE-YR-A DTSCS73
|
|
02341 MAP-TIME-HR-A DTSCS73
|
|
02342 MAP-TIME-MN-A DTSCS73
|
|
02343 MAP-TIME-SC-A DTSCS73
|
|
02344 MAP-PRIMARY-NAME-A DTSCS73
|
|
02345 MAP-CURR-PAGE-A DTSCS73
|
|
02346 MAP-LAST-PAGE-A DTSCS73
|
|
02347 MAP-CHNG-DATE-A DTSCS73
|
|
02348 MAP-ESTB-DATE-A. DTSCS73
|
|
02349 DTSCS73
|
|
02350 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS73
|
|
02351 S5900-EXIT. DTSCS73
|
|
02352 EXIT. DTSCS73
|
|
02353 EJECT DTSCS73
|
|
02354 /*****************************************************************DTSCS73
|
|
02355 * MAP ROUTINES *DTSCS73
|
|
02356 ******************************************************************DTSCS73
|
|
02357 S9100-RECEIVE. DTSCS73
|
|
02358 SET L851-RECEIVE-88 TO TRUE. DTSCS73
|
|
02359 DTSCS73
|
|
02360 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS73
|
|
02361 DTSCS73
|
|
02362 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS73
|
|
02363 DTSCS73
|
|
02364 MOVE L851-AID TO LCCM-AID. DTSCS73
|
|
02365 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS73
|
|
02366 S9100-EXIT. DTSCS73
|
|
02367 EXIT. DTSCS73
|
|
02368 DTSCS73
|
|
02369 S9200-SEND-DATAONLY. DTSCS73
|
|
02370 MOVE LOW-VALUES TO MAP-AREA. DTSCS73
|
|
02371 DTSCS73
|
|
02372 IF LCCM-NO-MSG DTSCS73
|
|
02373 NEXT SENTENCE DTSCS73
|
|
02374 ELSE DTSCS73
|
|
02375 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS73
|
|
02376 DTSCS73
|
|
02377 IF CURSOR-SET-GOTO DTSCS73
|
|
02378 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS73
|
|
02379 ELSE DTSCS73
|
|
02380 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS73
|
|
02381 DTSCS73
|
|
02382 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS73
|
|
02383 DTSCS73
|
|
02384 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS73
|
|
02385 DTSCS73
|
|
02386 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS73
|
|
02387 S9200-EXIT. DTSCS73
|
|
02388 EXIT. DTSCS73
|
|
02389 DTSCS73
|
|
02390 S9300-SEND-MAP. DTSCS73
|
|
02391 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS73
|
|
02392 MOVE SPACES TO MAP-SYS-TIME. DTSCS73
|
|
02393 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS73
|
|
02394 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS73
|
|
02395 DTSCS73
|
|
02396 IF SCR-ACCESS-UPDATE DTSCS73
|
|
02397 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS73
|
|
02398 ELSE DTSCS73
|
|
02399 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS73
|
|
02400 DTSCS73
|
|
02401 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS73
|
|
02402 DTSCS73
|
|
02403 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS73
|
|
02404 DTSCS73
|
|
02405 IF CURSOR-SET-NO DTSCS73
|
|
02406 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS73
|
|
02407 DTSCS73
|
|
02408 SET L851-SEND-88 TO TRUE. DTSCS73
|
|
02409 DTSCS73
|
|
02410 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS73
|
|
02411 DTSCS73
|
|
02412 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS73
|
|
02413 S9300-EXIT. DTSCS73
|
|
02414 EXIT. DTSCS73
|
|
02415 DTSCS73
|
|
02416 S9310-UPDATE-FKEYS. DTSCS73
|
|
02417 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS73
|
|
02418 DTSCS73
|
|
02419 DTSCS73
|
|
02420 IF LCCM-SCR-CLEAR DTSCS73
|
|
02421 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS73
|
|
02422 ELSE DTSCS73
|
|
02423 IF LCCM-SCR-INQUIRE DTSCS73
|
|
02424 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS73
|
|
02425 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS73
|
|
02426 ELSE DTSCS73
|
|
02427 IF LCCM-SCR-UPDATE-LOCKED DTSCS73
|
|
02428 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS73
|
|
02429 MAP-KEY-LAST DTSCS73
|
|
02430 MAP-KEY-BACK DTSCS73
|
|
02431 MAP-KEY-FWRD. DTSCS73
|
|
02432 S9310-EXIT. DTSCS73
|
|
02433 EXIT. DTSCS73
|
|
02434 DTSCS73
|
|
02435 S9320-INQUIRY-FKEYS. DTSCS73
|
|
02436 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS73
|
|
02437 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS73
|
|
02438 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS73
|
|
02439 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS73
|
|
02440 DTSCS73
|
|
02441 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS73
|
|
02442 MAP-KEY-MOD DTSCS73
|
|
02443 MAP-KEY-DEL. DTSCS73
|
|
02444 DTSCS73
|
|
02445 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS73
|
|
02446 S9320-EXIT. DTSCS73
|
|
02447 EXIT. DTSCS73
|
|
02448 DTSCS73
|
|
02449 *S9321-JUMP-KEYS. DTSCS73
|
|
02450 *****MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS73
|
|
02451 *****MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS73
|
|
02452 *****MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS73
|
|
02453 *****MOVE CFKD-EVL-INQ TO MAP-KEY-EVL-INQ. DTSCS73
|
|
02454 *S9321-EXIT. DTSCS73
|
|
02455 *****EXIT. DTSCS73
|
|
02456 ***** DTSCS73
|
|
02457 S9330-DSCR-FIELDS. DTSCS73
|
|
02458 IF WRK-MPRF-YES-88 DTSCS73
|
|
02459 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS73
|
|
02460 END-IF. DTSCS73
|
|
02461 DTSCS73
|
|
02462 IF MAP-SOURCE = LOW-VALUES OR SPACES DTSCS73
|
|
02463 MOVE LOW-VALUES TO MAP-SOURCE-DESC DTSCS73
|
|
02464 ELSE DTSCS73
|
|
02465 IF MAP-SOURCE = LCCM-OP-ID DTSCS73
|
|
02466 MOVE LCCM-OP-NAME TO MAP-SOURCE-DESC DTSCS73
|
|
02467 ELSE DTSCS73
|
|
02468 MOVE MAP-SOURCE TO L082-OP-ID DTSCS73
|
|
02469 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS73
|
|
02470 MOVE L082-NAME TO MAP-SOURCE-DESC. DTSCS73
|
|
02471 DTSCS73
|
|
02472 DTSCS73
|
|
02473 S9330-EXIT. EXIT. DTSCS73
|
|
02474 DTSCS73
|
|
02475 S9900-PREPARE-SEND. DTSCS73
|
|
02476 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS73
|
|
02477 LCCM-SCR-ID. DTSCS73
|
|
02478 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS73
|
|
02479 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS73
|
|
02480 S9900-EXIT. DTSCS73
|
|
02481 EXIT. DTSCS73
|