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