00001  IDENTIFICATION DIVISION.                                         01/23/01
00002  PROGRAM-ID.             DTSCS12.                                 DTSCS12
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV061
00004  DATE-WRITTEN.           OCTOBER 1998.                            DTSCS12
00005  DATE-COMPILED.                                                   DTSCS12
00006      SKIP3                                                        DTSCS12
00007 *****                                                             DTSCS12
00008 *                                                                 DTSCS12
00009 *    FUNCTION:  REGISTRATION SEARCHES                             DTSCS12
00010 *               SCREEN PROCESSOR.                                 DTSCS12
00011 *                                                                 DTSCS12
00012 *                                                                 DTSCS12
00013 *    MODIFICATION LOG:                                            DTSCS12
00014 *                                                                 DTSCS12
00015 *    10/20/1998  INITIAL DEVELOPMENT. MODIFIED FROM MACCS12.      DTSCS12
00016 *                WORK ORDER:                      PROGRAMMER: GD  DTSCS12
00017 *                                                                 DTSCS12
00018 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS12
00019 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS12
00020 *                WORK ORDER:                      PROGRAMMER: XXX DTSCS12
00021 *                                                                 DTSCS12
00022 *                                                                 DTSCS12
00023 *  DESCRIPTION:                                                   DTSCS12
00024 *                                                                 DTSCS12
00025 *                                                                 DTSCS12
00026 *    CLEAR:                                                       DTSCS12
00027 *                                                                 DTSCS12
00028 *      FIELD DISPLAYED :NONE.  UPROTECT MAP-EMP-NAME,             DTSCS12
00029 *       MAP-OPO-NAME, MAP-OPO-SSN, AND MAP-FEIN, MAP-BTN.         DTSCS12
00030 *                                                                 DTSCS12
00031 *    JUMP:                                                        DTSCS12
00032 *                                                                 DTSCS12
00033 *                                                                 DTSCS12
00034 *    INQUIRY:                                                     DTSCS12
00035 *                                                                 DTSCS12
00036 *      CONTROL FIELD(S): MAP-EMP-NAME, MAP-OPO-NAME,              DTSCS12
00037 *                        MAP-OPO-SSN, MAP-FEIN AND MAP-BTN        DTSCS12
00038 *                        (MUTUALLY EXCLUSIVE).                    DTSCS12
00039 *                                                                 DTSCS12
00040 *      JUMP IN: IF LCCM-EMP-NO = LCCM-SCR12-HOLD-AREA EMP-NO      DTSCS12
00041 *                 START A SEARCH AT THE AIX INDEX RECORD WHOSE    DTSCS12
00042 *                 KEY IS IN LCCM-SCR12-HOLD-AREA                  DTSCS12
00043 *               ELSE                                              DTSCS12
00044 *                 CLEAR.                                          DTSCS12
00045 *                                                                 DTSCS12
00046 *      ENTER: REDISPLAY SAME STUFF.                               DTSCS12
00047 *                                                                 DTSCS12
00048 *      F07, F08: DO NOT BOTHER TO 'WRAP' PAGING.  SEE SCREEN      DTSCS12
00049 *                DESCRIPTION FOR 'BREAK' POINTS.                  DTSCS12
00050 *                                                                 DTSCS12
00051 *      JUMP OUT: IF A LINE NO IS BEING SELECTED:                  DTSCS12
00052 *                  UPDATE LCCM-EMP-NO                             DTSCS12
00053 *                  STORE AIX RECORD REPRESENTING LINE NO          DTSCS12
00054 *                    SELECTED IN LCCM-SCR12-HOLD-AREA             DTSCS12
00055 *                  IF (EMPLOYER NAME SEARCH IS IN PROGRESS)       DTSCS12
00056 *                         AND                                     DTSCS12
00057 *                     (BENEFIT ALTERNATE NAME SELECTED)           DTSCS12
00058 *                         AND                                     DTSCS12
00059 *                     (JUMP TO SCREEN '79' REQUESTED)             DTSCS12
00060 *                      CONSTRUCT LCCM-SCR79-HOLD-AREA             DTSCS12
00061 *                  ELSE                                           DTSCS12
00062 *                  IF (EMPLOYER NAME SEARCH IS IN PROGRESS)       DTSCS12
00063 *                         AND                                     DTSCS12
00064 *                     (TAX ALTERNATE NAME SELECTED)               DTSCS12
00065 *                         AND                                     DTSCS12
00066 *                     (JUMP TO SCREEN '16' REQUESTED)             DTSCS12
00067 *                      CONSTRUCT LCCM-SCR16-HOLD-AREA             DTSCS12
00068 *                  ELSE                                           DTSCS12
00069 *                  IF (OPO-NAME SEARCH IS IN PROGRESS)            DTSCS12
00070 *                         AND                                     DTSCS12
00071 *                     (JUMP TO SCREEN '15' REQUESTED)             DTSCS12
00072 *                      CONSTRUCT LCCM-SCR15-HOLD-AREA             DTSCS12
00073 *                  ELSE                                           DTSCS12
00074 *                  IF (OPO-SSN SEARCH IS IN PROGRESS)             DTSCS12
00075 *                         AND                                     DTSCS12
00076 *                     (JUMP TO SCREEN '15' REQUESTED)             DTSCS12
00077 *                      CONSTRUCT LCCM-SCR15-HOLD-AREA.            DTSCS12
00078 *                                                                 DTSCS12
00079 *      PROTECT THE FOUR 'CONTROL' FIELDS DURING A SEARCH -        DTSCS12
00080 *      LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED.      DTSCS12
00081 *      THE USER MUST PRESS THE CLEAR KEY BEFORE RESTARTING        DTSCS12
00082 *      A SEARCH.                                                  DTSCS12
00083 *                                                                 DTSCS12
00084 *      DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE         DTSCS12
00085 *      LCCM-SCR-HOLD-AREA TO HOLD THE FROM 1 TO 12 AIX            DTSCS12
00086 *      RECORDS FROM WHICH THE 1 TO 12 LINES OF THE DISPLAY        DTSCS12
00087 *      WERE CONSTRUCTED.  WHEN THE USER SELECTS A 'LINE NO',      DTSCS12
00088 *      THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA IS USED       DTSCS12
00089 *      TO DETERMINE WHICH EMPLOYER WAS SELECTED.                  DTSCS12
00090 *                                                                 DTSCS12
00091 *      DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE         DTSCS12
00092 *      THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA TO            DTSCS12
00093 *      CONTROL PAGING.                                            DTSCS12
00094 *                                                                 DTSCS12
00095 *                                                                 DTSCS12
00096 *    UPDATE:                                                      DTSCS12
00097 *                                                                 DTSCS12
00098 *      NONE.                                                      DTSCS12
00099 *                                                                 DTSCS12
00100 *                                                                 DTSCS12
00101 *    RECORDS READ:                                                DTSCS12
00102 *                                                                 DTSCS12
00103 *      MASTER:                                                    DTSCS12
00104 *                                                                 DTSCS12
00105 *        MPRF                                                     DTSCS12
00106 *        MTAD                                                     DTSCS12
00107 *        MOPO                                                     DTSCS12
00108 *        MBAA                                                     DTSCS12
00109 *        MTAA                                                     DTSCS12
00110 *                                                                 DTSCS12
00111 *                                                                 DTSCS12
00112 *      ALTERNATE INDEX:                                           DTSCS12
00113 *                                                                 DTSCS12
00114 *        IBTB                                                     DTSCS12
00115 *        IOPN                                                     DTSCS12
00116 *        IOPS                                                     DTSCS12
00117 *        IEIN                                                     DTSCS12
00118 *        IBTN                                                     DTSCS12
00119 *                                                                 DTSCS12
00120 *                                                                 DTSCS12
00121 *      REFERENCE:                                                 DTSCS12
00122 *                                                                 DTSCS12
00123 *        NONE.                                                    DTSCS12
00124 *                                                                 DTSCS12
00125 *                                                                 DTSCS12
00126 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS12
00127 *                                                                 DTSCS12
00128 *        NONE.                                                    DTSCS12
00129 *                                                                 DTSCS12
00130 *                                                                 DTSCS12
00131 *    RECORDS UPDATED:                                             DTSCS12
00132 *                                                                 DTSCS12
00133 *      MASTER:                                                    DTSCS12
00134 *                                                                 DTSCS12
00135 *        NONE.                                                    DTSCS12
00136 *                                                                 DTSCS12
00137 *                                                                 DTSCS12
00138 *      REFERENCE:                                                 DTSCS12
00139 *                                                                 DTSCS12
00140 *        NONE.                                                    DTSCS12
00141 *                                                                 DTSCS12
00142 *                                                                 DTSCS12
00143 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS12
00144 *                                                                 DTSCS12
00145 *        NONE.                                                    DTSCS12
00146 *                                                                 DTSCS12
00147 *                                                                 DTSCS12
00148 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS12
00149 *                                                                 DTSCS12
00150 *      NONE.                                                      DTSCS12
00151 *                                                                 DTSCS12
00152 *                                                                 DTSCS12
00153 *    TEMPORARY STORAGE USAGE:                                     DTSCS12
00154 *                                                                 DTSCS12
00155 *      NONE.                                                      DTSCS12
00156 *                                                                 DTSCS12
00157 *                                                                 DTSCS12
00158 *    MODULES LINKED TO:                                           DTSCS12
00159 *                                                                 DTSCS12
00160 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS12
00161 *      DTSCU013  COUNT (INTEGER) FROM SCREEN FORMAT/EDIT.         DTSCS12
00162 *      DTSCU017  FEIN FROM SCREEN FORMAT/EDIT.                    DTSCS12
00163 *      DTSCU020  SOCIAL SECURITY NUMBER FROM SCREEN FORMAT/EDIT.  DTSCS12
00164 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS12
00165 *      DTSCU821  ALTERNATE INDEX FILE INPUT/OUTPUT.               DTSCS12
00166 *                                                                 DTSCS12
00167 *****                                                             DTSCS12
00168                                                                   DTSCS12
00169  ENVIRONMENT DIVISION.                                            DTSCS12
00170                                                                   DTSCS12
00171  DATA DIVISION.                                                   DTSCS12
00172                                                                   DTSCS12
00173  WORKING-STORAGE SECTION.                                         DTSCS12
001735 77  PAN-VALET PICTURE X(24) VALUE '061DTSCS12   01/23/01'.       DTSCS12
00174                                                                   DTSCS12
00175 ************************************************************      DTSCS12
00176 * THE TABLE BELOW CONTAINS DATA FROM THE LCCM-SCR-HOLD-AREA       DTSCS12
00177 ************************************************************      DTSCS12
00178  01  WRK-SCR-HOLD-AREA.                                           DTSCS12
00179      05  WRK-SCR-HOLD-PROG-NAME         PIC  X(07).               DTSCS12
00180      05  WRK-SCR-HOLD-KEY-CTR           PIC S9(04) COMP.          DTSCS12
00181      05  WRK-SCR-HOLD-KEY-AREA          PIC  X(768).              DTSCS12
00182      05  FILLER REDEFINES WRK-SCR-HOLD-KEY-AREA.                  DTSCS12
00183          10  WRK-SCR-HOLD-KEY OCCURS 12 TIMES.                    DTSCS12
00184              15  WRK-SCR-HOLD-REC-TYPE  PIC S9(04) COMP.          DTSCS12
00185              15  FILLER                 PIC  X(62).               DTSCS12
00186                                                                   DTSCS12
00187 ************************************************************      DTSCS12
00188 * THE PROGRAM STORES AIX KEYS AND FORMARTED MAP LINES IN THE      DTSCS12
00189 * TABLE BELOW DURING PAGE BACK OPERATIONS.  BUILDING A TABLE      DTSCS12
00190 * BY READING BACKWARDS ORDERS THE LINES IN REVERSE ORDER          DTSCS12
00191 * (HIGHEST KEY TO LOWEST).  TO BUILD THE SCREEN HOLD AREA         DTSCS12
00192 * AND THE MAP, THE PROGRAM READS THE TABLE ENTRIES IN             DTSCS12
00193 * REVERSE ORDER.                                                  DTSCS12
00194 ************************************************************      DTSCS12
00195  01  WRK-PAGE-BACK-AREA.                                          DTSCS12
00196      05  WRK-PAGE-BACK-CTR                 PIC S9(04) COMP.       DTSCS12
00197      05  WRK-PAGE-BACK-DATA-AREA           PIC  X(1716).          DTSCS12
00198      05  FILLER REDEFINES WRK-PAGE-BACK-DATA-AREA.                DTSCS12
00199          10  WRK-PAGE-BACK-ENTRY OCCURS 12 TIMES.                 DTSCS12
00200              15  WRK-PAGE-BACK-KEY         PIC  X(64).            DTSCS12
00201              15  WRK-PAGE-BACK-LINE        PIC  X(79).            DTSCS12
00202              15  FILLER REDEFINES WRK-PAGE-BACK-LINE.             DTSCS12
00203                  20  WRK-PAGE-BACK-LINE-NO PIC X(02).             DTSCS12
00204                  20  FILLER                PIC X(77).             DTSCS12
00205                                                                   DTSCS12
00206  01  WRK-AREA.                                                    DTSCS12
00207      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S12 '.    DTSCS12
00208                                                                   DTSCS12
00209      05  WRK-MOD-NAME                PIC  X(07)  VALUE 'DTSCS12'. DTSCS12
00210                                                                   DTSCS12
00211      05  WRK-FATAL-ERROR-IND         PIC X(01).                   DTSCS12
00212          88  WRK-FATAL-ERROR-YES             VALUE 'Y'.           DTSCS12
00213          88  WRK-FATAL-ERROR-NO              VALUE 'N'.           DTSCS12
00214                                                                   DTSCS12
00215      05  WRK-SCR-ID.                                              DTSCS12
00216          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 12.        DTSCS12
00217                                                                   DTSCS12
00218      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '10'.      DTSCS12
00219      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS12
00220          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS12
00221          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS12
00222                                                                   DTSCS12
00223      05  CURSOR-SET-IND              PIC X(01).                   DTSCS12
00224          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS12
00225          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS12
00226          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS12
00227                                                                   DTSCS12
00228      05  REQ-IND                     PIC X(01).                   DTSCS12
00229          88  REQ-ERROR                       VALUE 'O'.           DTSCS12
00230          88  REQ-JUMP                        VALUE 'J'.           DTSCS12
00231          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS12
00232          88  REQ-CLEAR                       VALUE 'C'.           DTSCS12
00233          88  REQ-EDIT                        VALUE 'E'.           DTSCS12
00234          88  REQ-UPDATE                      VALUE 'U'.           DTSCS12
00235          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS12
00236                                                                   DTSCS12
00237      05  RESP-IND                    PIC X(01).                   DTSCS12
00238          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS12
00239          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS12
00240          88  RESP-JUMP                       VALUE 'J'.           DTSCS12
00241          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS12
00242                                                                   DTSCS12
00243      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS12
00244                                                                   DTSCS12
00245      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS12
00246      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS12
00247                                                                   DTSCS12
00248 **************************************************************    DTSCS12
00249 *  DATA ELEMENT BELOW USED TO DETERMINE IF REQUESTED SCREEN       DTSCS12
00250 *  IS VALID FOR THE AIX KEY OF THE LINE SELECTED.                 DTSCS12
00251 **************************************************************    DTSCS12
00252      05  WRK-VALID-SCREEN            PIC  X(02).                  DTSCS12
00253          88  VALID-BTB-PRIMARY-NAME-SCR      VALUE '11'.          DTSCS12
00254          88  VALID-BTB-ENTITY-NAME-SCR       VALUE '11'.          DTSCS12
00255          88  VALID-BTB-TAX-ALT-NAME-SCR      VALUE '11' '16'.     DTSCS12
00256          88  VALID-BTB-BEN-ALT-NAME-SCR      VALUE '11' '79'.     DTSCS12
00257          88  VALID-OPS-SCR                   VALUE '15' '11'.     DTSCS12
00258          88  VALID-OPN-SCR                   VALUE '15' '11'.     DTSCS12
00259          88  VALID-EIN-SCR                   VALUE '11'.          DTSCS12
00260          88  VALID-BTN-SCR                   VALUE '11'.          DTSCS12
00261                                                                   DTSCS12
00262                                                                   DTSCS12
00263 **************************************************************    DTSCS12
00264 *  MAXIMUM NUMBER OF LINES THAT MAY BE DISPLAYED ON ONE PAGE.     DTSCS12
00265 **************************************************************    DTSCS12
00266      05  MAX-LINES                   PIC S9(04) COMP VALUE +12.   DTSCS12
00267                                                                   DTSCS12
00268 **************************************************************    DTSCS12
00269 * THE DATA ELEMENT BELOW INDICATES WHETHER AN AIX KEY FROM        DTSCS12
00270 * A PREVIOUS TASK HAS BEEN FOUND.                                 DTSCS12
00271 * WRK-AIX-TBL-KEY-FND INDICATES THAT THE LCCM-SCR-HOLD AREA       DTSCS12
00272 * CONTAINS THE AIX KEYS USED TO BUILD THE PREVIOUS DISPLAY.       DTSCS12
00273 * THIS IMPLIES THAT THE USER IS IN THE MIDDLE OF A SEARCH         DTSCS12
00274 * AND IS PAGING THROUGH THE SCREENS.                              DTSCS12
00275 * WRK-JUMP-IN-KEY-FND INDICATES THAT THE LCCM-SCR12-HOLD-AREA     DTSCS12
00276 * CONTAINS A KEY THAT MATCHES LCCM-EMP-NO.  THIS MEANS THE USER   DTSCS12
00277 * HAS SELECTED A LINE FROM SCREEN 12, JUMPED TO ANOTHER SCREEN    DTSCS12
00278 * FOR A DETAILED VIEW OF THE RECORD, THEN RETURNED TO SCR 12.     DTSCS12
00279 ***************************************************************   DTSCS12
00280      05  WRK-KEY-FOUND-IND           PIC  X(01).                  DTSCS12
00281          88  WRK-AIX-TBL-KEY-FND     VALUE '1'.                   DTSCS12
00282          88  WRK-JUMP-IN-KEY-FND     VALUE '2'.                   DTSCS12
00283          88  WRK-KEY-FOUND-YES       VALUE '1' '2'.               DTSCS12
00284          88  WRK-KEY-FOUND-NO        VALUE '0'.                   DTSCS12
00285                                                                   DTSCS12
00286      05  WRK-NUM-SRCH-FLDS-ENTERED   PIC S9(04)  COMP.            DTSCS12
00287                                                                   DTSCS12
00288      05  WRK-CTR                     PIC S9(04)  COMP.            DTSCS12
00289                                                                   DTSCS12
00290      05  WRK-SUB                     PIC S9(04)  COMP.            DTSCS12
00291      05  WRK-SUB-DISP                PIC  Z9.                     DTSCS12
00292                                                                   DTSCS12
00293      05  WRK-SUB2                    PIC S9(04)  COMP.            DTSCS12
00294                                                                   DTSCS12
00295      05  WRK-SCREEN-DATA-LINE.                                    DTSCS12
00296          10  WRK-LINE-NO             PIC  X(02).                  DTSCS12
00297          10  FILLER                  PIC  X(02).                  DTSCS12
00298          10  WRK-NAME                PIC  X(42).                  DTSCS12
00299          10  FILLER                  PIC  X(02).                  DTSCS12
00300          10  WRK-CITY                PIC  X(12).                  DTSCS12
00301          10  FILLER                  PIC  X(02).                  DTSCS12
00302          10  WRK-ST                  PIC  X(02).                  DTSCS12
00303          10  FILLER                  PIC  X(02).                  DTSCS12
00304          10  WRK-EMP-NO-1            PIC  X(03).                  DTSCS12
00305          10  FILLER                  PIC  X(01).                  DTSCS12
00306          10  WRK-EMP-NO-2            PIC  X(03).                  DTSCS12
00307          10  FILLER                  PIC  X(02).                  DTSCS12
00308          10  WRK-EMP-STATUS          PIC  X(01).                  DTSCS12
00309          10  FILLER                  PIC  X(02).                  DTSCS12
00310          10  WRK-TYPE                PIC  X(01).                  DTSCS12
00311                                                                   DTSCS12
00312 ************************************************************      DTSCS12
00313 * THE FOLLOWING FIELDS CONTAIN THE STARTING AND ENDING AIX        DTSCS12
00314 * KEYS FOR THE CURRENT SCREEN DISPLAY.                            DTSCS12
00315 * THE STARTING KEY IS BUILT INITIALLY FROM THE S1000 EDITS        DTSCS12
00316 * AND REPLACED BY THE ACTUAL AIX KEY DURING INQUIRY               DTSCS12
00317 * PROCESSING IN P6000.                                            DTSCS12
00318 * THE INQUIRY PROCESS MOVES THIS KEY TO LCCM-SCR12-HOLD-AREA.     DTSCS12
00319 *                                                                 DTSCS12
00320 * THE ENDING KEY IS THE LAST ENTRY IN THE AIX TABLE STORED        DTSCS12
00321 * IN LCCM-SCR-HOLD-AREA.  IT IS USED TO SET THE STARTING          DTSCS12
00322 * POINT WHEN PAGING FORWARD.                                      DTSCS12
00323 ************************************************************      DTSCS12
00324      05  WRK-STARTING-SEARCH-KEY     PIC X(64).                   DTSCS12
00325      05  WRK-ENDING-SEARCH-KEY       PIC X(64).                   DTSCS12
00326                                                                   DTSCS12
00327      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS12
00328      05  WRK-EMP-NO-DISP             PIC 9(07).                   DTSCS12
00329      05  FILLER REDEFINES WRK-EMP-NO-DISP.                        DTSCS12
00330          10  FILLER                  PIC X.                       DTSCS12
00331          10  WRK-EMP-NO-DISP-1       PIC 9(03).                   DTSCS12
00332          10  WRK-EMP-NO-DISP-2       PIC 9(03).                   DTSCS12
00333                                                                   DTSCS12
00334      05  WRK-FEIN                    PIC 9(09)   COMP-3.          DTSCS12
00335      05  WRK-FEIN-DISP               PIC 9(09).                   DTSCS12
00336      05  FILLER REDEFINES WRK-FEIN-DISP.                          DTSCS12
00337          10  WRK-FEIN-DISP-1         PIC 9(02).                   DTSCS12
00338          10  WRK-FEIN-DISP-2         PIC 9(07).                   DTSCS12
00339                                                                   DTSCS12
00340      05  WRK-SSN                     PIC S9(09)   COMP-3.         DTSCS12
00341      05  WRK-SSN-DISP                PIC 9(09).                   DTSCS12
00342      05  FILLER REDEFINES WRK-SSN-DISP.                           DTSCS12
00343          10  WRK-SSN-DISP-1          PIC 9(03).                   DTSCS12
00344          10  WRK-SSN-DISP-2          PIC 9(02).                   DTSCS12
00345          10  WRK-SSN-DISP-3          PIC 9(04).                   DTSCS12
00346                                                                   DTSCS12
00347      05  WRK-BTN                     PIC S9(09)   COMP-3.         DTSCS12
00348      05  WRK-BTN-DISP                PIC 9(09).                   DTSCS12
00349                                                                   DTSCS12
00350      05  WRK-ID-NO                   PIC S9(03)  COMP-3.          DTSCS12
00351                                                                   DTSCS12
00352                                                                   DTSCS12
00353      05  HOLD-ISKL-KEY-AREA          PIC X(64).                   DTSCS12
00354                                                                   DTSCS12
00355  01  MSG-LITERALS.                                                DTSCS12
00356      05  MSG-E121-AREA.                                           DTSCS12
00357          10  FILLER                  PIC  X(04)  VALUE 'E121'.    DTSCS12
00358          10  FILLER                  PIC  X(30)                   DTSCS12
00359                VALUE 'ENTER 1 SEARCH FIELD.         '.            DTSCS12
00360          10  FILLER                  PIC  X(30)                   DTSCS12
00361                VALUE '                              '.            DTSCS12
00362                                                                   DTSCS12
00363      05  MSG-E122-AREA.                                           DTSCS12
00364          10  FILLER                  PIC  X(04)  VALUE 'E122'.    DTSCS12
00365          10  FILLER                  PIC  X(30)                   DTSCS12
00366                VALUE 'ENTRY OF ONLY 1 SEARCH FIELD A'.            DTSCS12
00367          10  FILLER                  PIC  X(30)                   DTSCS12
00368                VALUE 'LLOWED                        '.            DTSCS12
00369                                                                   DTSCS12
00370      05  MSG-E123-AREA.                                           DTSCS12
00371          10  FILLER                  PIC  X(04)  VALUE 'E123'.    DTSCS12
00372          10  MSG-EMP-NO-IN-ERR       PIC 999B999.                 DTSCS12
00373          10  FILLER                  PIC X(50) VALUE              DTSCS12
00374          ' ALTERNATE INDEX FILE ERROR - CONTACT DP'.              DTSCS12
00375                                                                   DTSCS12
00376      05  MSG-E124-AREA.                                           DTSCS12
00377          10  FILLER                  PIC  X(04)  VALUE 'E124'.    DTSCS12
00378          10  FILLER                  PIC  X(30)                   DTSCS12
00379                VALUE 'SCREEN 11 IS ONLY VALID SELECT'.            DTSCS12
00380          10  FILLER                  PIC  X(30)                   DTSCS12
00381                VALUE 'ION FOR THIS LINE             '.            DTSCS12
00382                                                                   DTSCS12
00383      05  MSG-E125-AREA.                                           DTSCS12
00384          10  FILLER                  PIC  X(04)  VALUE 'E125'.    DTSCS12
00385          10  FILLER                  PIC  X(30)                   DTSCS12
00386                VALUE 'SCREENS 11 AND 79 ARE THE ONLY'.            DTSCS12
00387          10  FILLER                  PIC  X(30)                   DTSCS12
00388                VALUE 'VALID SELECTIONS FOR THIS LINE'.            DTSCS12
00389                                                                   DTSCS12
00390      05  MSG-E126-AREA.                                           DTSCS12
00391          10  FILLER                  PIC  X(04)  VALUE 'E126'.    DTSCS12
00392          10  FILLER                  PIC  X(30)                   DTSCS12
00393                VALUE 'SCREENS 11 AND 16 ARE THE ONLY'.            DTSCS12
00394          10  FILLER                  PIC  X(30)                   DTSCS12
00395                VALUE 'VALID SELECTIONS FOR THIS LINE'.            DTSCS12
00396                                                                   DTSCS12
00397      05  MSG-E127-AREA.                                           DTSCS12
00398          10  FILLER                  PIC  X(04)  VALUE 'E127'.    DTSCS12
00399          10  FILLER                  PIC  X(30)                   DTSCS12
00400                VALUE 'SCREENS 11 AND 15 ARE THE ONLY'.            DTSCS12
00401          10  FILLER                  PIC  X(30)                   DTSCS12
00402                VALUE 'VALID SELECTIONS FOR THIS LINE'.            DTSCS12
00403                                                                   DTSCS12
00404      EJECT                                                        DTSCS12
00405  01  L001-COMM-AREA.                                              DTSCS12
00406  ++INCLUDE DTSIL001                                               DTSCS12
00407      EJECT                                                        DTSCS12
00408  01  L013-COMM-AREA.                                              DTSCS12
00409  ++INCLUDE DTSIL013                                               DTSCS12
00410      EJECT                                                        DTSCS12
00411  01  L017-COMM-AREA.                                              DTSCS12
00412  ++INCLUDE DTSIL017                                               DTSCS12
00413      EJECT                                                        DTSCS12
00414  01  L020-COMM-AREA.                                              DTSCS12
00415  ++INCLUDE DTSIL020                                               DTSCS12
00416      EJECT                                                        DTSCS12
00417  01  L027-COMM-AREA.                                              DTSCS12
00418  ++INCLUDE DTSIL027                                               DTSCS12
00419      EJECT                                                        DTSCS12
00420  01  L805-COMM-AREA.                                              DTSCS12
00421  ++INCLUDE DTSIL805                                               DTSCS12
00422      EJECT                                                        DTSCS12
00423  01  L810-COMM-AREA.                                              DTSCS12
00424      05  L810-CONTROL-BLOCK.                                      DTSCS12
00425  ++INCLUDE DTSIL810                                               DTSCS12
00426      EJECT                                                        DTSCS12
00427      05  MSKL-REC.                                                DTSCS12
00428  ++INCLUDE DTSIMSKL                                               DTSCS12
00429      EJECT                                                        DTSCS12
00430  01  MPRF-REC.                                                    DTSCS12
00431  ++INCLUDE DTSIMPRF                                               DTSCS12
00432      EJECT                                                        DTSCS12
00433  01  MTAD-REC.                                                    DTSCS12
00434  ++INCLUDE DTSIMTAD                                               DTSCS12
00435      EJECT                                                        DTSCS12
00436  01  MTAA-REC.                                                    DTSCS12
00437  ++INCLUDE DTSIMTAA                                               DTSCS12
00438      EJECT                                                        DTSCS12
00439  01  MOPO-REC.                                                    DTSCS12
00440  ++INCLUDE DTSIMOPO                                               DTSCS12
00441      EJECT                                                        DTSCS12
00442  01  MBAA-REC.                                                    DTSCS12
00443  ++INCLUDE DTSIMBAA                                               DTSCS12
00444      EJECT                                                        DTSCS12
00445  01  L821-COMM-AREA.                                              DTSCS12
00446      05  L821-CONTROL-BLOCK.                                      DTSCS12
00447  ++INCLUDE DTSIL821                                               DTSCS12
00448                                                                   DTSCS12
00449      05  ISKL-REC.                                                DTSCS12
00450  ++INCLUDE DTSIISKL                                               DTSCS12
00451      05  FILLER REDEFINES ISKL-REC.                               DTSCS12
00452  ++INCLUDE DTSIIBTB                                               DTSCS12
00453      05  FILLER REDEFINES ISKL-REC.                               DTSCS12
00454  ++INCLUDE DTSIIOPN                                               DTSCS12
00455      05  FILLER REDEFINES ISKL-REC.                               DTSCS12
00456  ++INCLUDE DTSIIOPS                                               DTSCS12
00457      05  FILLER REDEFINES ISKL-REC.                               DTSCS12
00458  ++INCLUDE DTSIIEIN                                               DTSCS12
00459      05  FILLER REDEFINES ISKL-REC.                               DTSCS12
00460  ++INCLUDE DTSIIBTN                                               DTSCS12
00461      EJECT                                                        DTSCS12
00462                                                                   DTSCS12
00463  01  L851-COMM-AREA.                                              DTSCS12
00464  ++INCLUDE DTSIL851                                               DTSCS12
00465      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS12
00466  ++INCLUDE DTSIS12                                                DTSCS12
00467      EJECT                                                        DTSCS12
00468  01  CATB-LITERALS.                                               DTSCS12
00469  ++INCLUDE DTSICATB                                               DTSCS12
00470                                                                   DTSCS12
00471  01  CFKD-LITERALS.                                               DTSCS12
00472  ++INCLUDE DTSICFKD                                               DTSCS12
00473                                                                   DTSCS12
00474  01  CECD-LITERALS.                                               DTSCS12
00475  ++INCLUDE DTSICECD                                               DTSCS12
00476                                                                   DTSCS12
00477  01  CPCD-LITERALS.                                               DTSCS12
00478  ++INCLUDE DTSICPCD                                               DTSCS12
00479      EJECT                                                        DTSCS12
00480  LINKAGE SECTION.                                                 DTSCS12
00481                                                                   DTSCS12
00482  01  DFHCOMMAREA.                                                 DTSCS12
00483  ++INCLUDE DTSILCCM                                               DTSCS12
00484                                                                   DTSCS12
00485              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS12
00486                  20  LCCM-SCR-HOLD-PROG-NAME   PIC X(07).         DTSCS12
00487                  20  LCCM-SCR-HOLD-KEY-CTR     PIC S9(04) COMP.   DTSCS12
00488                  20  LCCM-SCR-HOLD-KEY-AREA    PIC X(768).        DTSCS12
00489                  20  FILLER REDEFINES LCCM-SCR-HOLD-KEY-AREA.     DTSCS12
00490                      25  LCCM-SCR-HOLD-KEY   OCCURS 12 TIMES      DTSCS12
00491                                                PIC  X(64).        DTSCS12
00492      EJECT                                                        DTSCS12
00493 ******************************************************************DTSCS12
00494 *                                                                *DTSCS12
00495 ******************************************************************DTSCS12
00496                                                                   DTSCS12
00497  PROCEDURE DIVISION.                                              DTSCS12
00498                                                                   DTSCS12
00499      SET WRK-FATAL-ERROR-NO TO TRUE.                              DTSCS12
00500      SET WRK-KEY-FOUND-NO   TO TRUE.                              DTSCS12
00501                                                                   DTSCS12
00502      MOVE +0             TO WRK-EMP-NO.                           DTSCS12
00503                                                                   DTSCS12
00504      MOVE +0             TO WRK-CTR                               DTSCS12
00505                             WRK-SUB                               DTSCS12
00506                             WRK-SUB2.                             DTSCS12
00507                                                                   DTSCS12
00508      MOVE LOW-VALUES     TO WRK-STARTING-SEARCH-KEY               DTSCS12
00509                             WRK-ENDING-SEARCH-KEY.                DTSCS12
00510                                                                   DTSCS12
00511      MOVE LOW-VALUES     TO MAP-AREA.                             DTSCS12
00512                                                                   DTSCS12
00513      SET CURSOR-SET-NO   TO TRUE.                                 DTSCS12
00514                                                                   DTSCS12
00515      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS12
00516        TO SCR-ACCESS-IND.                                         DTSCS12
00517                                                                   DTSCS12
00518      MOVE SPACE TO REQ-IND.                                       DTSCS12
00519                                                                   DTSCS12
00520      MOVE SPACES TO LCCM-REQ-SCR-ID.                              DTSCS12
00521                                                                   DTSCS12
00522      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS12
00523                                                                   DTSCS12
00524 *-----------------------------------------------------            DTSCS12
00525 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS12
00526 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS12
00527 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS12
00528 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS12
00529 *                                                                 DTSCS12
00530 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS12
00531 *    PROCESSED.                                                   DTSCS12
00532 *                                                                 DTSCS12
00533 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS12
00534 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS12
00535 *    WORK STATION OPERATOR.                                       DTSCS12
00536 *-----------------------------------------------------            DTSCS12
00537                                                                   DTSCS12
00538      MOVE SPACE TO RESP-IND.                                      DTSCS12
00539                                                                   DTSCS12
00540      IF REQ-ERROR                                                 DTSCS12
00541         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS12
00542      ELSE                                                         DTSCS12
00543      IF REQ-JUMP                                                  DTSCS12
00544         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS12
00545      ELSE                                                         DTSCS12
00546      IF REQ-CLEAR                                                 DTSCS12
00547         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS12
00548      ELSE                                                         DTSCS12
00549      IF REQ-CURSOR-TO-GOTO                                        DTSCS12
00550         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS12
00551      ELSE                                                         DTSCS12
00552      IF REQ-INQUIRE                                               DTSCS12
00553         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS12
00554      ELSE                                                         DTSCS12
00555         GO TO S899-ABEND.                                         DTSCS12
00556                                                                   DTSCS12
00557      IF WRK-FATAL-ERROR-YES                                       DTSCS12
00558          GO TO MAINLINE-EXIT.                                     DTSCS12
00559 *-----------------------------------------------------            DTSCS12
00560 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS12
00561 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS12
00562 *-----------------------------------------------------            DTSCS12
00563                                                                   DTSCS12
00564      IF RESP-SEND-MAP                                             DTSCS12
00565          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS12
00566          SET LCCM-END-TASK-88 TO TRUE                             DTSCS12
00567      ELSE                                                         DTSCS12
00568      IF RESP-SEND-MSGONLY                                         DTSCS12
00569          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS12
00570          SET LCCM-END-TASK-88 TO TRUE                             DTSCS12
00571      ELSE                                                         DTSCS12
00572      IF RESP-JUMP                                                 DTSCS12
00573          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS12
00574      ELSE                                                         DTSCS12
00575      IF RESP-CURSOR-TO-GOTO                                       DTSCS12
00576          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS12
00577          SET LCCM-END-TASK-88 TO TRUE                             DTSCS12
00578      ELSE                                                         DTSCS12
00579          GO TO S899-ABEND.                                        DTSCS12
00580                                                                   DTSCS12
00581  MAINLINE-EXIT.                                                   DTSCS12
00582                                                                   DTSCS12
00583      EXEC CICS                                                    DTSCS12
00584          RETURN                                                   DTSCS12
00585      END-EXEC.                                                    DTSCS12
00586                                                                   DTSCS12
00587      GOBACK.                                                      DTSCS12
00588      EJECT                                                        DTSCS12
00589 /*****************************************************************DTSCS12
00590 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS12
00591 ******************************************************************DTSCS12
00592  P1000-ANALYZE-REQUEST.                                           DTSCS12
00593 *-----------------------------------------------------            DTSCS12
00594 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS12
00595 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS12
00596 *     REPLACED WITH ENTER)                                        DTSCS12
00597 *     SET LCCM-SCR-HOLD-AREA TO LOW-VALUES.  THIS AREA            DTSCS12
00598 *     CONTAINS THE AIX KEYS FOR THE CURRENT DISPLAY.              DTSCS12
00599 *     THE LCCM-SCR12-HOLD-AREA CONTAINS EITHER THE                DTSCS12
00600 *     AIX KEY ASSOCIATED WITH LINE 1 OF THE CURRENT DISPLAY       DTSCS12
00601 *     OR THE KEY OF THE LINE THE USER SELECTED.                   DTSCS12
00602 *     THE SYSTEM RETAINS THIS KEY WHEN THE USER JUMPS             DTSCS12
00603 *     TO ANOTHER SCREEN, AND USES IT TO RECREATE THE              DTSCS12
00604 *     THE DISPLAY IF THE USER RETURNS TO SCREEN 12.               DTSCS12
00605 *-----------------------------------------------------            DTSCS12
00606      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS12
00607         SET LCCM-ENTER-88 TO TRUE                                 DTSCS12
00608         MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA                      DTSCS12
00609         IF LCCM-SCR12-HOLD-AREA = LOW-VALUES OR SPACES            DTSCS12
00610             SET REQ-CLEAR TO TRUE                                 DTSCS12
00611             GO TO P1000-EXIT                                      DTSCS12
00612         ELSE                                                      DTSCS12
00613             PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT         DTSCS12
00614             IF WRK-KEY-FOUND-YES                                  DTSCS12
00615                 SET REQ-INQUIRE TO TRUE                           DTSCS12
00616                 GO TO P1000-EXIT                                  DTSCS12
00617             ELSE                                                  DTSCS12
00618                 SET REQ-CLEAR TO TRUE                             DTSCS12
00619                 GO TO P1000-EXIT.                                 DTSCS12
00620                                                                   DTSCS12
00621 *-----------------------------------------------------            DTSCS12
00622 *      MAP IS RECEIVED                                            DTSCS12
00623 *-----------------------------------------------------            DTSCS12
00624      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS12
00625                                                                   DTSCS12
00626 *-----------------------------------------------------            DTSCS12
00627 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS12
00628 *    WORK STATION                                                 DTSCS12
00629 *-----------------------------------------------------            DTSCS12
00630      IF LCCM-CLEAR-88                                             DTSCS12
00631         SET REQ-CLEAR TO TRUE                                     DTSCS12
00632         GO TO P1000-EXIT.                                         DTSCS12
00633                                                                   DTSCS12
00634 *-----------------------------------------------------            DTSCS12
00635 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS12
00636 *-----------------------------------------------------            DTSCS12
00637      IF LCCM-PA2-88                                               DTSCS12
00638          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS12
00639          GO TO P1000-EXIT.                                        DTSCS12
00640                                                                   DTSCS12
00641 *-----------------------------------------------------            DTSCS12
00642 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS12
00643 *-----------------------------------------------------            DTSCS12
00644      IF LCCM-PA-88                                                DTSCS12
00645        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS12
00646        SET REQ-ERROR TO TRUE                                      DTSCS12
00647        GO TO P1000-EXIT.                                          DTSCS12
00648                                                                   DTSCS12
00649 *-----------------------------------------------------            DTSCS12
00650 *    F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A                 DTSCS12
00651 *    REQUEST TO CLEAR THE SCREEN                                  DTSCS12
00652 *-----------------------------------------------------            DTSCS12
00653      IF LCCM-F12-88                                               DTSCS12
00654         MOVE LOW-VALUES TO MAP-AREA                               DTSCS12
00655         SET REQ-CLEAR TO TRUE                                     DTSCS12
00656         GO TO P1000-EXIT.                                         DTSCS12
00657                                                                   DTSCS12
00658 *-----------------------------------------------------            DTSCS12
00659 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS12
00660 *-----------------------------------------------------            DTSCS12
00661      IF LCCM-F03-88                                               DTSCS12
00662         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS12
00663         SET REQ-JUMP TO TRUE                                      DTSCS12
00664         GO TO P1000-EXIT.                                         DTSCS12
00665                                                                   DTSCS12
00666 *-----------------------------------------------------            DTSCS12
00667 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS12
00668 *-----------------------------------------------------            DTSCS12
00669      IF LCCM-F04-88                                               DTSCS12
00670         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS12
00671         SET REQ-JUMP TO TRUE                                      DTSCS12
00672         GO TO P1000-EXIT.                                         DTSCS12
00673                                                                   DTSCS12
00674 *-----------------------------------------------------            DTSCS12
00675 *    IF CORRESPONDENCE KEY PRESSED, JUMP TO                       DTSCS12
00676 *    CORRESPONDENCE INQUIRY/UPDATE SCREEN.                        DTSCS12
00677 *-----------------------------------------------------            DTSCS12
00678      IF LCCM-F14-88                                               DTSCS12
00679         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS12
00680         SET REQ-JUMP TO TRUE                                      DTSCS12
00681         GO TO P1000-EXIT.                                         DTSCS12
00682                                                                   DTSCS12
00683 *-----------------------------------------------------            DTSCS12
00684 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS12
00685 *    REQUESTED SCREEN TYPE                                        DTSCS12
00686 *-----------------------------------------------------            DTSCS12
00687      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS12
00688         NEXT SENTENCE                                             DTSCS12
00689      ELSE                                                         DTSCS12
00690        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS12
00691        SET REQ-JUMP TO TRUE                                       DTSCS12
00692        GO TO P1000-EXIT.                                          DTSCS12
00693                                                                   DTSCS12
00694 *-----------------------------------------------------            DTSCS12
00695 *    SET REQ-JUMP TO TRUE IF USER HAS ENTERED                     DTSCS12
00696 *    MAP-LINE-NUMBER OR MAP-SCREEN-ID.                            DTSCS12
00697 *-----------------------------------------------------            DTSCS12
00698      IF  (MAP-SCREEN-ID  = LOW-VALUES OR SPACES)                  DTSCS12
00699      AND (MAP-LINE-NUMBER = LOW-VALUES OR SPACES)                 DTSCS12
00700         NEXT SENTENCE                                             DTSCS12
00701      ELSE                                                         DTSCS12
00702         SET REQ-JUMP TO TRUE                                      DTSCS12
00703         GO TO P1000-EXIT.                                         DTSCS12
00704                                                                   DTSCS12
00705 *-----------------------------------------------------            DTSCS12
00706 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS12
00707 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS12
00708 *-----------------------------------------------------            DTSCS12
00709      IF LCCM-F07-88                                               DTSCS12
00710      OR LCCM-F08-88                                               DTSCS12
00711      OR LCCM-ENTER-88                                             DTSCS12
00712          SET REQ-INQUIRE TO TRUE                                  DTSCS12
00713          GO TO P1000-EXIT.                                        DTSCS12
00714                                                                   DTSCS12
00715 *-----------------------------------------------------            DTSCS12
00716 *     ANY OTHER KEY IS INVALID                                    DTSCS12
00717 *-----------------------------------------------------            DTSCS12
00718      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS12
00719      SET REQ-ERROR TO TRUE.                                       DTSCS12
00720  P1000-EXIT.                                                      DTSCS12
00721      EXIT.                                                        DTSCS12
00722                                                                   DTSCS12
00723 ******************************************************************DTSCS12
00724 *      JUMP IN: IF LCCM-EMP-NO = LCCM-SCR12-HOLD-AREA EMP-NO      DTSCS12
00725 *                 START A SEARCH AT THE AIX INDEX RECORD WHOSE    DTSCS12
00726 *                 KEY IS IN LCCM-SCR12-HOLD-AREA                  DTSCS12
00727 *               ELSE                                              DTSCS12
00728 *                 CLEAR.                                          DTSCS12
00729 *                                                                 DTSCS12
00730 ******************************************************************DTSCS12
00731                                                                   DTSCS12
00732  P1200-CHECK-HOLD-AREA.                                           DTSCS12
00733                                                                   DTSCS12
00734      MOVE LCCM-SCR12-HOLD-AREA TO ISKL-KEY-AREA.                  DTSCS12
00735      IF ISKL-BTB-88                                               DTSCS12
00736         IF IBTB-EMP-NO = LCCM-EMP-NO                              DTSCS12
00737            SET WRK-JUMP-IN-KEY-FND TO TRUE                        DTSCS12
00738         ELSE                                                      DTSCS12
00739            SET WRK-KEY-FOUND-NO TO TRUE                           DTSCS12
00740      ELSE                                                         DTSCS12
00741      IF ISKL-OPN-88                                               DTSCS12
00742         IF IOPN-EMP-NO = LCCM-EMP-NO                              DTSCS12
00743            SET WRK-JUMP-IN-KEY-FND TO TRUE                        DTSCS12
00744         ELSE                                                      DTSCS12
00745            SET WRK-KEY-FOUND-NO TO TRUE                           DTSCS12
00746      ELSE                                                         DTSCS12
00747      IF ISKL-OPS-88                                               DTSCS12
00748         IF IOPS-EMP-NO = LCCM-EMP-NO                              DTSCS12
00749            SET WRK-JUMP-IN-KEY-FND TO TRUE                        DTSCS12
00750         ELSE                                                      DTSCS12
00751            SET WRK-KEY-FOUND-NO TO TRUE                           DTSCS12
00752      ELSE                                                         DTSCS12
00753      IF ISKL-EIN-88                                               DTSCS12
00754         IF IEIN-EMP-NO = LCCM-EMP-NO                              DTSCS12
00755            SET WRK-JUMP-IN-KEY-FND TO TRUE                        DTSCS12
00756         ELSE                                                      DTSCS12
00757            SET WRK-KEY-FOUND-NO TO TRUE                           DTSCS12
00758      ELSE                                                         DTSCS12
00759      IF ISKL-BTN-88                                               DTSCS12
00760         IF IBTN-EMP-NO = LCCM-EMP-NO                              DTSCS12
00761            SET WRK-JUMP-IN-KEY-FND TO TRUE                        DTSCS12
00762         ELSE                                                      DTSCS12
00763            SET WRK-KEY-FOUND-NO TO TRUE                           DTSCS12
00764      ELSE                                                         DTSCS12
00765         SET WRK-KEY-FOUND-NO TO TRUE.                             DTSCS12
00766                                                                   DTSCS12
00767      IF WRK-KEY-FOUND-YES                                         DTSCS12
00768         MOVE LCCM-SCR12-HOLD-AREA TO                              DTSCS12
00769                              WRK-STARTING-SEARCH-KEY.             DTSCS12
00770  P1200-EXIT.                                                      DTSCS12
00771      EXIT.                                                        DTSCS12
00772 /*****************************************************************DTSCS12
00773 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS12
00774 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS12
00775 ******************************************************************DTSCS12
00776                                                                   DTSCS12
00777  P2000-REQUEST-ERROR.                                             DTSCS12
00778      IF LCCM-MSG                                                  DTSCS12
00779         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS12
00780      ELSE                                                         DTSCS12
00781         GO TO S899-ABEND.                                         DTSCS12
00782  P2000-EXIT.                                                      DTSCS12
00783      EXIT.                                                        DTSCS12
00784 /*****************************************************************DTSCS12
00785 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS12
00786 ******************************************************************DTSCS12
00787                                                                   DTSCS12
00788  P3000-REQUEST-JUMP.                                              DTSCS12
00789 *-----------------------------------------------------            DTSCS12
00790 *   IF THERE IS A VALUE IN LCCM-REQ-SCR-ID (THE FIELD             DTSCS12
00791 *   IS INITIALIZED TO SPACES ON ENTRY TO THE PROGRAM)             DTSCS12
00792 *   THE USER HAS PRESSED F3 OR F4 OR HAS ENTERED A                DTSCS12
00793 *   VALUE IN MAP-GOTO.                                            DTSCS12
00794 *-----------------------------------------------------            DTSCS12
00795      IF LCCM-REQ-SCR-ID NOT = SPACES                              DTSCS12
00796         PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT               DTSCS12
00797         IF LCCM-MSG                                               DTSCS12
00798            PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT            DTSCS12
00799            SET RESP-SEND-MSGONLY TO TRUE                          DTSCS12
00800            SET CURSOR-SET-GOTO TO TRUE                            DTSCS12
00801            GO TO P3000-EXIT                                       DTSCS12
00802         ELSE                                                      DTSCS12
00803            GO TO P3000-CLEANUP.                                   DTSCS12
00804                                                                   DTSCS12
00805 *-----------------------------------------------------            DTSCS12
00806 *   IF LCCM-REQ-SCR-ID = SPACES, THE USER HAS ENTERED             DTSCS12
00807 *   A VALUE IN THE SELECT LINE NO FIELD.                          DTSCS12
00808 *   EDIT LCCM-SCR-HOLD-AREA FOR VALIDITY: THE AIX KEYS            DTSCS12
00809 *   IN THIS AREA CORRESPOND TO THE LINES DISPLAYED AND            DTSCS12
00810 *   ENABLE THE SYSTEM TO FIND THE DETAILED DATA FOR               DTSCS12
00811 *   THE LINE SELECTED.                                            DTSCS12
00812 *-----------------------------------------------------            DTSCS12
00813      PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT.           DTSCS12
00814      IF WRK-KEY-FOUND-NO                                          DTSCS12
00815         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS12
00816         PERFORM P3900-MAP-LINE-ERROR THRU P3900-EXIT              DTSCS12
00817         SET RESP-SEND-MAP     TO TRUE                             DTSCS12
00818         GO TO P3000-EXIT.                                         DTSCS12
00819                                                                   DTSCS12
00820      PERFORM P3100-SELECTION-LINE-EDIT THRU P3100-EXIT.           DTSCS12
00821      IF LCCM-MSG                                                  DTSCS12
00822         SET RESP-SEND-MAP     TO TRUE                             DTSCS12
00823         GO TO P3000-EXIT.                                         DTSCS12
00824                                                                   DTSCS12
00825      PERFORM P3200-SELECT-SCREEN       THRU P3200-EXIT.           DTSCS12
00826      IF LCCM-MSG                                                  DTSCS12
00827         SET RESP-SEND-MAP TO TRUE                                 DTSCS12
00828         GO TO P3000-EXIT.                                         DTSCS12
00829                                                                   DTSCS12
00830      PERFORM P3300-BUILD-KEY-FOR-JUMP THRU P3300-EXIT.            DTSCS12
00831      MOVE ISKL-KEY-AREA       TO LCCM-SCR12-HOLD-AREA.            DTSCS12
00832                                                                   DTSCS12
00833                                                                   DTSCS12
00834  P3000-CLEANUP.                                                   DTSCS12
00835 *-----------------------------------------------------            DTSCS12
00836 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS12
00837 *-----------------------------------------------------            DTSCS12
00838      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS12
00839                         LCCM-SCR-HOLD-AREA.                       DTSCS12
00840      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS12
00841      SET RESP-JUMP TO TRUE.                                       DTSCS12
00842  P3000-EXIT.                                                      DTSCS12
00843      EXIT.                                                        DTSCS12
00844                                                                   DTSCS12
00845 ******************************************************************DTSCS12
00846 * LINE NUMBER IS REQUIRED.  NUMBER ENTERED CANNOT BE GREATER      DTSCS12
00847 * WRK-SCR-HOLD-KEY-CTR (NUMBER OF ENTRIES IN TABLE CORRESPONDS    DTSCS12
00848 * TO NUMBER OF LINES ON SCREEN). THIS PARAGRAPH RETURNS L013-CNT. DTSCS12
00849 ******************************************************************DTSCS12
00850  P3100-SELECTION-LINE-EDIT.                                       DTSCS12
00851      MOVE +1                   TO L013-MIN-CNT.                   DTSCS12
00852      MOVE WRK-SCR-HOLD-KEY-CTR TO L013-MAX-CNT.                   DTSCS12
00853      MOVE MAP-LINE-NUMBER-AREA TO L013-S-CNT-AREA.                DTSCS12
00854      PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT.               DTSCS12
00855      IF L013-NO-ENTRY                                             DTSCS12
00856         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS12
00857         PERFORM P3900-MAP-LINE-ERROR THRU P3900-EXIT              DTSCS12
00858      ELSE                                                         DTSCS12
00859      IF L013-NOT-VALID                                            DTSCS12
00860         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS12
00861         PERFORM P3900-MAP-LINE-ERROR THRU P3900-EXIT.             DTSCS12
00862  P3100-EXIT.                                                      DTSCS12
00863      EXIT.                                                        DTSCS12
00864                                                                   DTSCS12
00865  P3200-SELECT-SCREEN.                                             DTSCS12
00866      MOVE ZERO TO WRK-EMP-NO                                      DTSCS12
00867                   WRK-ID-NO.                                      DTSCS12
00868                                                                   DTSCS12
00869      MOVE WRK-SCR-HOLD-KEY (L013-CNT) TO ISKL-KEY-AREA.           DTSCS12
00870                                                                   DTSCS12
00871      IF MAP-SCREEN-ID = LOW-VALUES OR SPACES OR WRK-SCR-ID        DTSCS12
00872         PERFORM P3210-DEFAULT-SCR-ID    THRU P3210-EXIT           DTSCS12
00873      ELSE                                                         DTSCS12
00874         MOVE MAP-SCREEN-ID TO LCCM-REQ-SCR-ID                     DTSCS12
00875         PERFORM S803-REQ-SCR-ID-EDIT    THRU S803-EXIT            DTSCS12
00876         IF LCCM-MSG                                               DTSCS12
00877            PERFORM P3210-DEFAULT-SCR-ID THRU P3210-EXIT.          DTSCS12
00878                                                                   DTSCS12
00879      PERFORM P3220-EDIT-SCR-ID          THRU P3220-EXIT.          DTSCS12
00880  P3200-EXIT.                                                      DTSCS12
00881      EXIT.                                                        DTSCS12
00882                                                                   DTSCS12
00883  P3210-DEFAULT-SCR-ID.                                            DTSCS12
00884      IF ISKL-BTB-88                                               DTSCS12
00885         IF IBTB-NAME-BEN-ALT-88                                   DTSCS12
00886            MOVE '79'    TO LCCM-REQ-SCR-ID                        DTSCS12
00887         ELSE                                                      DTSCS12
00888            MOVE '11'    TO LCCM-REQ-SCR-ID                        DTSCS12
00889         END-IF                                                    DTSCS12
00890      ELSE                                                         DTSCS12
00891         MOVE '11'       TO LCCM-REQ-SCR-ID.                       DTSCS12
00892  P3210-EXIT.                                                      DTSCS12
00893      EXIT.                                                        DTSCS12
00894                                                                   DTSCS12
00895  P3220-EDIT-SCR-ID.                                               DTSCS12
00896      MOVE LCCM-REQ-SCR-ID TO WRK-VALID-SCREEN.                    DTSCS12
00897                                                                   DTSCS12
00898      IF ISKL-BTB-88                                               DTSCS12
00899         PERFORM P3221-EDIT-BTB THRU P3221-EXIT                    DTSCS12
00900      ELSE                                                         DTSCS12
00901      IF ISKL-OPN-88                                               DTSCS12
00902 *&      IF VALID-OPN-SCR                                          DTSCS12
00903            MOVE IOPN-EMP-NO TO WRK-EMP-NO                         DTSCS12
00904            MOVE IOPN-ID-NO  TO WRK-ID-NO                          DTSCS12
00905 *&      ELSE                                                      DTSCS12
00906 *&         MOVE MSG-E127-AREA TO WRK-MSG-AREA                     DTSCS12
00907 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00908 *&      END-IF                                                    DTSCS12
00909      ELSE                                                         DTSCS12
00910      IF ISKL-OPS-88                                               DTSCS12
00911 *&      IF VALID-OPS-SCR                                          DTSCS12
00912            MOVE IOPS-EMP-NO TO WRK-EMP-NO                         DTSCS12
00913            MOVE IOPS-ID-NO  TO WRK-ID-NO                          DTSCS12
00914 *&      ELSE                                                      DTSCS12
00915 *&         MOVE MSG-E127-AREA TO WRK-MSG-AREA                     DTSCS12
00916 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00917 *&      END-IF                                                    DTSCS12
00918      ELSE                                                         DTSCS12
00919      IF ISKL-EIN-88                                               DTSCS12
00920 *&      IF VALID-EIN-SCR                                          DTSCS12
00921            MOVE IEIN-EMP-NO TO WRK-EMP-NO                         DTSCS12
00922            MOVE ZERO        TO WRK-ID-NO                          DTSCS12
00923 *&      ELSE                                                      DTSCS12
00924 *&         MOVE MSG-E124-AREA TO WRK-MSG-AREA                     DTSCS12
00925 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00926 *&      END-IF                                                    DTSCS12
00927      ELSE                                                         DTSCS12
00928      IF ISKL-BTN-88                                               DTSCS12
00929 *&      IF VALID-BTN-SCR                                          DTSCS12
00930            MOVE IBTN-EMP-NO TO WRK-EMP-NO                         DTSCS12
00931            MOVE ZERO        TO WRK-ID-NO                          DTSCS12
00932 *&      ELSE                                                      DTSCS12
00933 *&         MOVE MSG-E124-AREA TO WRK-MSG-AREA                     DTSCS12
00934 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00935 *&      END-IF                                                    DTSCS12
00936      ELSE                                                         DTSCS12
00937         MOVE MSG-E124-AREA TO WRK-MSG-AREA                        DTSCS12
00938         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT.        DTSCS12
00939                                                                   DTSCS12
00940  P3220-EXIT.                                                      DTSCS12
00941      EXIT.                                                        DTSCS12
00942                                                                   DTSCS12
00943  P3221-EDIT-BTB.                                                  DTSCS12
00944      IF IBTB-NAME-PRIMARY-88                                      DTSCS12
00945 *&      IF VALID-BTB-PRIMARY-NAME-SCR                             DTSCS12
00946            MOVE IBTB-EMP-NO TO WRK-EMP-NO                         DTSCS12
00947            MOVE IBTB-ID-NO  TO WRK-ID-NO                          DTSCS12
00948 *&      ELSE                                                      DTSCS12
00949 *&         MOVE MSG-E124-AREA TO WRK-MSG-AREA                     DTSCS12
00950 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00951      ELSE                                                         DTSCS12
00952      IF IBTB-NAME-ENTITY-88                                       DTSCS12
00953 *&      IF VALID-BTB-ENTITY-NAME-SCR                              DTSCS12
00954            MOVE IBTB-EMP-NO TO WRK-EMP-NO                         DTSCS12
00955            MOVE IBTB-ID-NO  TO WRK-ID-NO                          DTSCS12
00956 *&      ELSE                                                      DTSCS12
00957 *&         MOVE MSG-E124-AREA TO WRK-MSG-AREA                     DTSCS12
00958 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00959      ELSE                                                         DTSCS12
00960      IF IBTB-NAME-TAX-ALT-88                                      DTSCS12
00961 *&      IF VALID-BTB-TAX-ALT-NAME-SCR                             DTSCS12
00962            MOVE IBTB-EMP-NO TO WRK-EMP-NO                         DTSCS12
00963            MOVE IBTB-ID-NO  TO WRK-ID-NO                          DTSCS12
00964 *&      ELSE                                                      DTSCS12
00965 *&         MOVE MSG-E126-AREA TO WRK-MSG-AREA                     DTSCS12
00966 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00967      ELSE                                                         DTSCS12
00968      IF IBTB-NAME-BEN-ALT-88                                      DTSCS12
00969 *&      IF VALID-BTB-BEN-ALT-NAME-SCR                             DTSCS12
00970            MOVE IBTB-EMP-NO TO WRK-EMP-NO                         DTSCS12
00971            MOVE IBTB-ID-NO  TO WRK-ID-NO                          DTSCS12
00972 *&      ELSE                                                      DTSCS12
00973 *&         MOVE MSG-E125-AREA TO WRK-MSG-AREA                     DTSCS12
00974 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT      DTSCS12
00975      ELSE                                                         DTSCS12
00976 *&      IF VALID-BTB-PRIMARY-NAME-SCR                             DTSCS12
00977            MOVE IBTB-EMP-NO TO WRK-EMP-NO                         DTSCS12
00978            MOVE IBTB-ID-NO  TO WRK-ID-NO.                         DTSCS12
00979 *&      ELSE                                                      DTSCS12
00980 *&         MOVE MSG-E124-AREA TO WRK-MSG-AREA                     DTSCS12
00981 *&         PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT.     DTSCS12
00982  P3221-EXIT.                                                      DTSCS12
00983      EXIT.                                                        DTSCS12
00984                                                                   DTSCS12
00985  P3300-BUILD-KEY-FOR-JUMP.                                        DTSCS12
00986      IF WRK-EMP-NO NOT = ZERO                                     DTSCS12
00987         MOVE WRK-EMP-NO TO LCCM-EMP-NO.                           DTSCS12
00988                                                                   DTSCS12
00989      IF LCCM-REQ-SCR-ID = '15'                                    DTSCS12
00990         PERFORM P3310-JUMP-TO-SCR-15 THRU P3310-EXIT              DTSCS12
00991      ELSE                                                         DTSCS12
00992      IF LCCM-REQ-SCR-ID = '16'                                    DTSCS12
00993         PERFORM P3320-JUMP-TO-SCR-16 THRU P3320-EXIT              DTSCS12
00994      ELSE                                                         DTSCS12
00995      IF LCCM-REQ-SCR-ID = '79'                                    DTSCS12
00996         PERFORM P3330-JUMP-TO-SCR-79 THRU P3330-EXIT.             DTSCS12
00997  P3300-EXIT.                                                      DTSCS12
00998      EXIT.                                                        DTSCS12
00999                                                                   DTSCS12
01000  P3310-JUMP-TO-SCR-15.                                            DTSCS12
01001      MOVE LOW-VALUES TO LCCM-SCR15-HOLD-AREA.                     DTSCS12
01002                                                                   DTSCS12
01003      MOVE LOW-VALUES TO MOPO-KEY-AREA.                            DTSCS12
01004                                                                   DTSCS12
01005      SET MOPO-OPO-88 TO TRUE.                                     DTSCS12
01006                                                                   DTSCS12
01007      MOVE WRK-EMP-NO TO MOPO-EMP-NO.                              DTSCS12
01008      MOVE WRK-ID-NO  TO MOPO-ID-NO.                               DTSCS12
01009                                                                   DTSCS12
01010      MOVE MOPO-KEY-AREA TO LCCM-SCR15-HOLD-AREA.                  DTSCS12
01011                                                                   DTSCS12
01012  P3310-EXIT.                                                      DTSCS12
01013      EXIT.                                                        DTSCS12
01014                                                                   DTSCS12
01015  P3320-JUMP-TO-SCR-16.                                            DTSCS12
01016      MOVE LOW-VALUES TO LCCM-SCR16-HOLD-AREA.                     DTSCS12
01017                                                                   DTSCS12
01018      MOVE LOW-VALUES TO MTAA-KEY-AREA.                            DTSCS12
01019                                                                   DTSCS12
01020      SET MTAA-TAA-88 TO TRUE.                                     DTSCS12
01021                                                                   DTSCS12
01022      MOVE WRK-EMP-NO        TO MTAA-EMP-NO.                       DTSCS12
01023      MOVE WRK-ID-NO         TO MTAA-ID-NO.                        DTSCS12
01024                                                                   DTSCS12
01025      MOVE MTAA-KEY-AREA TO LCCM-SCR16-HOLD-AREA.                  DTSCS12
01026                                                                   DTSCS12
01027  P3320-EXIT.                                                      DTSCS12
01028      EXIT.                                                        DTSCS12
01029                                                                   DTSCS12
01030  P3330-JUMP-TO-SCR-79.                                            DTSCS12
01031      MOVE LOW-VALUES TO LCCM-SCR79-HOLD-AREA.                     DTSCS12
01032                                                                   DTSCS12
01033      MOVE LOW-VALUES TO MBAA-KEY-AREA.                            DTSCS12
01034                                                                   DTSCS12
01035      SET MBAA-BAA-88 TO TRUE.                                     DTSCS12
01036                                                                   DTSCS12
01037      MOVE WRK-EMP-NO        TO MBAA-EMP-NO.                       DTSCS12
01038      MOVE WRK-ID-NO         TO MBAA-ID-NO.                        DTSCS12
01039                                                                   DTSCS12
01040      MOVE MBAA-KEY-AREA TO LCCM-SCR79-HOLD-AREA.                  DTSCS12
01041  P3330-EXIT.                                                      DTSCS12
01042      EXIT.                                                        DTSCS12
01043                                                                   DTSCS12
01044 /**************************************************************** DTSCS12
01045 *  SCREEN SELECT AND LINE NUMBER ERROR ROUTINES                   DTSCS12
01046 ***************************************************************** DTSCS12
01047  P3900-MAP-LINE-ERROR.                                            DTSCS12
01048      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS12
01049      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LINE-NUMBER-A         DTSCS12
01050                                         MAP-SCREEN-ID-A.          DTSCS12
01051      SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01052      MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA.              DTSCS12
01053      MOVE CATB-CURSOR              TO MAP-LINE-NUMBER-L.          DTSCS12
01054  P3900-EXIT. EXIT.                                                DTSCS12
01055                                                                   DTSCS12
01056  P3910-SELECT-SCREEN-ERROR.                                       DTSCS12
01057      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS12
01058      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SCREEN-ID-A            DTSCS12
01059                                        MAP-LINE-NUMBER-A.         DTSCS12
01060      SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01061      MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA.              DTSCS12
01062      MOVE CATB-CURSOR              TO MAP-SCREEN-ID-L.            DTSCS12
01063  P3910-EXIT. EXIT.                                                DTSCS12
01064 /*****************************************************************DTSCS12
01065 * CLEAR KEY WAS PRESSED                                          *DTSCS12
01066 ******************************************************************DTSCS12
01067                                                                   DTSCS12
01068  P4000-REQUEST-CLEAR.                                             DTSCS12
01069      PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT.               DTSCS12
01070                                                                   DTSCS12
01071 *&   IF WRK-TS-FOUND-YES                                          DTSCS12
01072 *&     MOVE LCCM-SCR12-HOLD-AREA    TO ISKL-KEY-AREA              DTSCS12
01073 *&     IF ISKL-BTB-88                                             DTSCS12
01074 *&        MOVE CATB-CURSOR TO MAP-EMP-NAME-L                      DTSCS12
01075 *&     ELSE                                                       DTSCS12
01076 *&     IF ISKL-OPN-88                                             DTSCS12
01077 *&        MOVE CATB-CURSOR TO MAP-OPO-NAME-L                      DTSCS12
01078 *&     ELSE                                                       DTSCS12
01079 *&     IF ISKL-OPS-88                                             DTSCS12
01080 *&        MOVE CATB-CURSOR TO MAP-SSN-1-L                         DTSCS12
01081 *&     ELSE                                                       DTSCS12
01082 *&     IF ISKL-EIN-88                                             DTSCS12
01083 *&        MOVE CATB-CURSOR TO MAP-FEIN-1-L                        DTSCS12
01084 *&     ELSE                                                       DTSCS12
01085 *&     IF ISKL-BTN-88                                             DTSCS12
01086 *&        MOVE CATB-CURSOR TO MAP-BTN-L                           DTSCS12
01087 *&   ELSE                                                         DTSCS12
01088 *&      MOVE CATB-CURSOR TO MAP-EMP-NAME-L.                       DTSCS12
01089                                                                   DTSCS12
01090 *&   SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01091 *&   MOVE 'N' TO WRK-TS-FOUND-IND.                                DTSCS12
01092 *-----------------------------------------------------            DTSCS12
01093 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS12
01094 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS12
01095 *-----------------------------------------------------            DTSCS12
01096      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS12
01097                                                                   DTSCS12
01098      MOVE LOW-VALUES TO LCCM-SCR12-HOLD-AREA                      DTSCS12
01099                         LCCM-SCR-HOLD-AREA.                       DTSCS12
01100      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS12
01101                                                                   DTSCS12
01102      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS12
01103                                                                   DTSCS12
01104      SET RESP-SEND-MAP TO TRUE.                                   DTSCS12
01105  P4000-EXIT.                                                      DTSCS12
01106      EXIT.                                                        DTSCS12
01107 /*****************************************************************DTSCS12
01108 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS12
01109 ******************************************************************DTSCS12
01110                                                                   DTSCS12
01111  P5000-CURSOR-TO-GOTO.                                            DTSCS12
01112      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS12
01113      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS12
01114  P5000-EXIT.                                                      DTSCS12
01115      EXIT.                                                        DTSCS12
01116 /*****************************************************************DTSCS12
01117 * INQUIRY WAS REQUESTED                                          *DTSCS12
01118 ******************************************************************DTSCS12
01119                                                                   DTSCS12
01120  P6000-REQUEST-INQUIRE.                                           DTSCS12
01121      MOVE LOW-VALUES    TO MAP-TABLE.                             DTSCS12
01122      MOVE LCCM-TASK-START-ABSTIME    TO LCCM-SCR-ABSTIME.         DTSCS12
01123      SET RESP-SEND-MAP  TO TRUE.                                  DTSCS12
01124                                                                   DTSCS12
01125 *************************************************************     DTSCS12
01126 * IF P1200 HAS NOT FOUND A STARTING KEY IN LCCM-SCR12-HOLD,       DTSCS12
01127 * CHECK WHETHER THE AIX TABLE FROM A PREVIOUS TASK EXISTS         DTSCS12
01128 * IN LCCM-SCR-HOLD-AREA. IF A VALID AIX TABLE EXISTS, SET         DTSCS12
01129 * WRK-AIX-TBL-KEY-FND TO TRUE.                                    DTSCS12
01130 ************************************************************      DTSCS12
01131      IF WRK-KEY-FOUND-NO                                          DTSCS12
01132         PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT.        DTSCS12
01133                                                                   DTSCS12
01134      MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA                         DTSCS12
01135                        WRK-SCR-HOLD-AREA                          DTSCS12
01136                        WRK-PAGE-BACK-AREA                         DTSCS12
01137                        LCCM-SCR12-HOLD-AREA.                      DTSCS12
01138      MOVE +0 TO WRK-SCR-HOLD-KEY-CTR.                             DTSCS12
01139      MOVE WRK-MOD-NAME TO WRK-SCR-HOLD-PROG-NAME.                 DTSCS12
01140                                                                   DTSCS12
01141      IF LCCM-SCR-CLEAR                                            DTSCS12
01142      OR WRK-KEY-FOUND-NO                                          DTSCS12
01143         PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT                DTSCS12
01144         IF LCCM-MSG                                               DTSCS12
01145            PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT          DTSCS12
01146            GO TO P6000-EXIT.                                      DTSCS12
01147                                                                   DTSCS12
01148      IF LCCM-F08-88                                               DTSCS12
01149         IF WRK-AIX-TBL-KEY-FND                                    DTSCS12
01150            MOVE WRK-ENDING-SEARCH-KEY   TO ISKL-KEY-AREA          DTSCS12
01151         ELSE                                                      DTSCS12
01152            MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA          DTSCS12
01153      ELSE                                                         DTSCS12
01154         MOVE WRK-STARTING-SEARCH-KEY    TO ISKL-KEY-AREA.         DTSCS12
01155                                                                   DTSCS12
01156 *******************************************************           DTSCS12
01157 * SET WRK-FEIN, WRK-SSN, WRK-BTN.  THESE FIELDS ARE               DTSCS12
01158 * USED DURING THE READ TO DETERMINE WHEN TO RETURN                DTSCS12
01159 * L821-NO-REC-88.                                                 DTSCS12
01160 *******************************************************           DTSCS12
01161                                                                   DTSCS12
01162      IF ISKL-OPS-88                                               DTSCS12
01163         MOVE IOPS-SSN TO WRK-SSN                                  DTSCS12
01164      ELSE                                                         DTSCS12
01165      IF ISKL-EIN-88                                               DTSCS12
01166         MOVE IEIN-FEIN TO WRK-FEIN                                DTSCS12
01167      ELSE                                                         DTSCS12
01168      IF ISKL-BTN-88                                               DTSCS12
01169         MOVE IBTN-DC-BUSINESS-TAX-ACCT-NO TO WRK-BTN.             DTSCS12
01170                                                                   DTSCS12
01171      PERFORM S821-START-BROWSE       THRU S821-EXIT.              DTSCS12
01172      IF L821-NO-REC-88                                            DTSCS12
01173         PERFORM P6001-SRCH-CRITERIA-ERR THRU P6001-EXIT           DTSCS12
01174         GO TO P6000-EXIT.                                         DTSCS12
01175                                                                   DTSCS12
01176      IF LCCM-ENTER-88                                             DTSCS12
01177          PERFORM P6100-NO-PAGE THRU P6100-EXIT                    DTSCS12
01178      ELSE                                                         DTSCS12
01179      IF LCCM-F07-88                                               DTSCS12
01180          PERFORM P6200-PAGE-BACK THRU P6200-EXIT                  DTSCS12
01181      ELSE                                                         DTSCS12
01182      IF LCCM-F08-88                                               DTSCS12
01183          PERFORM P6300-PAGE-NEXT THRU P6300-EXIT                  DTSCS12
01184      ELSE                                                         DTSCS12
01185          GO TO S899-ABEND.                                        DTSCS12
01186                                                                   DTSCS12
01187      IF WRK-FATAL-ERROR-YES                                       DTSCS12
01188          GO TO P6000-EXIT.                                        DTSCS12
01189                                                                   DTSCS12
01190      IF WRK-SCR-HOLD-KEY-CTR > 0                                  DTSCS12
01191         MOVE WRK-SCR-HOLD-AREA        TO LCCM-SCR-HOLD-AREA       DTSCS12
01192         PERFORM S5300-SET-INQ-ATTRB   THRU S5300-EXIT             DTSCS12
01193         MOVE WRK-SCR-HOLD-KEY (1)     TO LCCM-SCR12-HOLD-AREA     DTSCS12
01194         MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A          DTSCS12
01195         MOVE CATB-UNPROT-BRT-NUM-MDTON                            DTSCS12
01196                                       TO MAP-LINE-NUMBER-A        DTSCS12
01197         MOVE CATB-CURSOR              TO MAP-LINE-NUMBER-L        DTSCS12
01198         SET CURSOR-SET-YES            TO TRUE                     DTSCS12
01199      ELSE                                                         DTSCS12
01200         PERFORM P6001-SRCH-CRITERIA-ERR THRU P6001-EXIT           DTSCS12
01201         GO TO P6000-EXIT.                                         DTSCS12
01202                                                                   DTSCS12
01203      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS12
01204  P6000-EXIT.                                                      DTSCS12
01205      EXIT.                                                        DTSCS12
01206                                                                   DTSCS12
01207  P6001-SRCH-CRITERIA-ERR.                                         DTSCS12
01208      MOVE EMSG-SEARCH-CRITERIA       TO LCCM-MSG-ID               DTSCS12
01209      PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT.               DTSCS12
01210                                                                   DTSCS12
01211      IF ISKL-BTB-88                                               DTSCS12
01212         MOVE CATB-CURSOR TO MAP-EMP-NAME-L                        DTSCS12
01213      ELSE                                                         DTSCS12
01214      IF ISKL-OPN-88                                               DTSCS12
01215         MOVE CATB-CURSOR TO MAP-OPO-NAME-L                        DTSCS12
01216      ELSE                                                         DTSCS12
01217      IF ISKL-OPS-88                                               DTSCS12
01218         MOVE CATB-CURSOR TO MAP-SSN-1-L                           DTSCS12
01219      ELSE                                                         DTSCS12
01220      IF ISKL-EIN-88                                               DTSCS12
01221         MOVE CATB-CURSOR TO MAP-FEIN-1-L                          DTSCS12
01222      ELSE                                                         DTSCS12
01223      IF ISKL-BTN-88                                               DTSCS12
01224         MOVE CATB-CURSOR TO MAP-BTN-L                             DTSCS12
01225      ELSE                                                         DTSCS12
01226         MOVE CATB-CURSOR TO MAP-EMP-NAME-L.                       DTSCS12
01227      IF LCCM-MSG                                                  DTSCS12
01228         SET CURSOR-SET-YES TO TRUE.                               DTSCS12
01229  P6001-EXIT.                                                      DTSCS12
01230      EXIT.                                                        DTSCS12
01231                                                                   DTSCS12
01232 /*****************************************************************DTSCS12
01233 * ENTER KEY WAS PRESSED.  THE STARTING KEY HAS BEEN SET IN       *DTSCS12
01234 * P6000, AND THE FIRST RECORD RETURNED FROM A START BROWSE.      *DTSCS12
01235 ******************************************************************DTSCS12
01236  P6100-NO-PAGE.                                                   DTSCS12
01237                                                                   DTSCS12
01238      PERFORM P6500-SET-SEARCH-FIELDS THRU P6500-EXIT.             DTSCS12
01239      PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT                   DTSCS12
01240         VARYING WRK-SUB FROM 1 BY 1                               DTSCS12
01241           UNTIL WRK-SUB > MAX-LINES                               DTSCS12
01242           OR L821-NO-REC-88                                       DTSCS12
01243           OR WRK-FATAL-ERROR-YES.                                 DTSCS12
01244                                                                   DTSCS12
01245  P6100-EXIT.                                                      DTSCS12
01246      EXIT.                                                        DTSCS12
01247                                                                   DTSCS12
01248 /*****************************************************************DTSCS12
01249 *                                                                *DTSCS12
01250 ******************************************************************DTSCS12
01251  P6200-PAGE-BACK.                                                 DTSCS12
01252      PERFORM S821-READ-PREV         THRU S821-EXIT.               DTSCS12
01253      IF L821-NO-REC-88                                            DTSCS12
01254 *       MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA             DTSCS12
01255 *       PERFORM S821-START-BROWSE       THRU S821-EXIT            DTSCS12
01256 *       IF L821-NO-REC-88                                         DTSCS12
01257            MOVE EMSG-NO-RECORD       TO LCCM-MSG-ID               DTSCS12
01258            GO TO P6200-EXIT.                                      DTSCS12
01259 *       ELSE                                                      DTSCS12
01260 *          MOVE PMSG-FIRST-PAGE      TO LCCM-MSG-ID.              DTSCS12
01261                                                                   DTSCS12
01262      PERFORM S821-READ-PREV         THRU S821-EXIT.               DTSCS12
01263      IF L821-NO-REC-88                                            DTSCS12
01264         MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA             DTSCS12
01265         PERFORM S821-START-BROWSE       THRU S821-EXIT            DTSCS12
01266         IF L821-NO-REC-88                                         DTSCS12
01267            MOVE EMSG-NO-RECORD       TO LCCM-MSG-ID               DTSCS12
01268            GO TO P6200-EXIT                                       DTSCS12
01269         ELSE                                                      DTSCS12
01270            MOVE PMSG-FIRST-PAGE      TO LCCM-MSG-ID               DTSCS12
01271            PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT             DTSCS12
01272               VARYING WRK-SUB FROM 1 BY 1                         DTSCS12
01273                 UNTIL WRK-SUB > MAX-LINES                         DTSCS12
01274                   OR L821-NO-REC-88                               DTSCS12
01275                   OR WRK-FATAL-ERROR-YES                          DTSCS12
01276            GO TO P6200-EXIT.                                      DTSCS12
01277                                                                   DTSCS12
01278                                                                   DTSCS12
01279      PERFORM P6800-SCAN-AIX-BACK THRU P6800-EXIT                  DTSCS12
01280         VARYING WRK-SUB FROM 1 BY 1                               DTSCS12
01281           UNTIL WRK-SUB > MAX-LINES                               DTSCS12
01282             OR L821-NO-REC-88                                     DTSCS12
01283             OR WRK-FATAL-ERROR-YES.                               DTSCS12
01284                                                                   DTSCS12
01285      IF L821-NO-REC-88                                            DTSCS12
01286         MOVE PMSG-FIRST-PAGE      TO LCCM-MSG-ID.                 DTSCS12
01287                                                                   DTSCS12
01288      MOVE WRK-PAGE-BACK-CTR    TO WRK-SCR-HOLD-KEY-CTR.           DTSCS12
01289      MOVE ZERO TO WRK-SUB2.                                       DTSCS12
01290      PERFORM P6210-BUILD-MAP     THRU P6210-EXIT                  DTSCS12
01291         VARYING WRK-SUB FROM WRK-PAGE-BACK-CTR BY -1              DTSCS12
01292           UNTIL WRK-SUB < +1.                                     DTSCS12
01293  P6200-EXIT.                                                      DTSCS12
01294      EXIT.                                                        DTSCS12
01295                                                                   DTSCS12
01296  P6210-BUILD-MAP.                                                 DTSCS12
01297      ADD +1                    TO WRK-SUB2.                       DTSCS12
01298      MOVE WRK-PAGE-BACK-KEY (WRK-SUB)                             DTSCS12
01299                            TO WRK-SCR-HOLD-KEY (WRK-SUB2).        DTSCS12
01300      MOVE WRK-SUB2         TO WRK-SUB-DISP                        DTSCS12
01301      MOVE WRK-SUB-DISP     TO WRK-PAGE-BACK-LINE-NO (WRK-SUB).    DTSCS12
01302      MOVE WRK-PAGE-BACK-LINE (WRK-SUB)                            DTSCS12
01303                            TO MAP-LINE-DATA (WRK-SUB2).           DTSCS12
01304  P6210-EXIT.                                                      DTSCS12
01305      EXIT.                                                        DTSCS12
01306                                                                   DTSCS12
01307 /*****************************************************************DTSCS12
01308 *                                                                *DTSCS12
01309 ******************************************************************DTSCS12
01310  P6300-PAGE-NEXT.                                                 DTSCS12
01311      PERFORM S821-READ-NEXT         THRU S821-EXIT.               DTSCS12
01312      IF L821-NO-REC-88                                            DTSCS12
01313         MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA             DTSCS12
01314         PERFORM S821-START-BROWSE       THRU S821-EXIT            DTSCS12
01315         IF L821-NO-REC-88                                         DTSCS12
01316            MOVE EMSG-NO-RECORD       TO LCCM-MSG-ID               DTSCS12
01317            GO TO P6300-EXIT                                       DTSCS12
01318         ELSE                                                      DTSCS12
01319            MOVE PMSG-LAST-PAGE        TO LCCM-MSG-ID.             DTSCS12
01320                                                                   DTSCS12
01321      PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT                   DTSCS12
01322         VARYING WRK-SUB FROM 1 BY 1                               DTSCS12
01323           UNTIL WRK-SUB > MAX-LINES                               DTSCS12
01324             OR L821-NO-REC-88                                     DTSCS12
01325             OR WRK-FATAL-ERROR-YES.                               DTSCS12
01326                                                                   DTSCS12
01327      IF L821-NO-REC-88                                            DTSCS12
01328         MOVE PMSG-LAST-PAGE        TO LCCM-MSG-ID.                DTSCS12
01329  P6300-EXIT.                                                      DTSCS12
01330      EXIT.                                                        DTSCS12
01331                                                                   DTSCS12
01332  P6500-SET-SEARCH-FIELDS.                                         DTSCS12
01333      IF ISKL-BTB-88                                               DTSCS12
01334         MOVE IBTB-NAME TO MAP-EMP-NAME                            DTSCS12
01335      ELSE                                                         DTSCS12
01336      IF ISKL-EIN-88                                               DTSCS12
01337         MOVE IEIN-FEIN TO WRK-FEIN-DISP                           DTSCS12
01338         MOVE WRK-FEIN-DISP-1 TO MAP-FEIN-1                        DTSCS12
01339         MOVE WRK-FEIN-DISP-2 TO MAP-FEIN-2                        DTSCS12
01340      ELSE                                                         DTSCS12
01341      IF ISKL-OPN-88                                               DTSCS12
01342         MOVE IOPN-NAME TO MAP-OPO-NAME                            DTSCS12
01343      ELSE                                                         DTSCS12
01344      IF ISKL-OPS-88                                               DTSCS12
01345         MOVE IOPS-SSN TO WRK-SSN-DISP                             DTSCS12
01346         MOVE WRK-SSN-DISP-1 TO MAP-SSN-1                          DTSCS12
01347         MOVE WRK-SSN-DISP-2 TO MAP-SSN-2                          DTSCS12
01348         MOVE WRK-SSN-DISP-3 TO MAP-SSN-3                          DTSCS12
01349      ELSE                                                         DTSCS12
01350      IF ISKL-BTN-88                                               DTSCS12
01351         MOVE IBTN-DC-BUSINESS-TAX-ACCT-NO TO WRK-BTN-DISP         DTSCS12
01352         MOVE WRK-BTN-DISP TO MAP-BTN.                             DTSCS12
01353  P6500-EXIT.                                                      DTSCS12
01354      EXIT.                                                        DTSCS12
01355                                                                   DTSCS12
01356  P6700-SCAN-AIX-FWD.                                              DTSCS12
01357      PERFORM P6900-FORMAT-LINE THRU P6900-EXIT.                   DTSCS12
01358      IF WRK-FATAL-ERROR-YES                                       DTSCS12
01359         GO TO P6700-EXIT                                          DTSCS12
01360      ELSE                                                         DTSCS12
01361         MOVE ISKL-KEY-AREA        TO WRK-SCR-HOLD-KEY (WRK-SUB)   DTSCS12
01362         MOVE WRK-SUB              TO WRK-SUB-DISP                 DTSCS12
01363         MOVE WRK-SUB-DISP         TO WRK-LINE-NO                  DTSCS12
01364         MOVE SPACES               TO MAP-LINE-DATA (WRK-SUB)      DTSCS12
01365         MOVE WRK-SCREEN-DATA-LINE TO MAP-LINE-DATA (WRK-SUB)      DTSCS12
01366         MOVE WRK-SUB              TO WRK-SCR-HOLD-KEY-CTR.        DTSCS12
01367                                                                   DTSCS12
01368      PERFORM S821-READ-NEXT THRU S821-EXIT.                       DTSCS12
01369  P6700-EXIT.                                                      DTSCS12
01370      EXIT.                                                        DTSCS12
01371  P6800-SCAN-AIX-BACK.                                             DTSCS12
01372      PERFORM P6900-FORMAT-LINE THRU P6900-EXIT.                   DTSCS12
01373      IF WRK-FATAL-ERROR-YES                                       DTSCS12
01374         GO TO P6800-EXIT                                          DTSCS12
01375      ELSE                                                         DTSCS12
01376         MOVE ISKL-KEY-AREA  TO WRK-PAGE-BACK-KEY (WRK-SUB)        DTSCS12
01377         MOVE SPACES         TO WRK-PAGE-BACK-LINE (WRK-SUB)       DTSCS12
01378         MOVE WRK-SCREEN-DATA-LINE                                 DTSCS12
01379                             TO WRK-PAGE-BACK-LINE (WRK-SUB)       DTSCS12
01380         MOVE WRK-SUB        TO WRK-PAGE-BACK-CTR.                 DTSCS12
01381                                                                   DTSCS12
01382      PERFORM S821-READ-PREV THRU S821-EXIT.                       DTSCS12
01383  P6800-EXIT.                                                      DTSCS12
01384      EXIT.                                                        DTSCS12
01385 /*****************************************************************DTSCS12
01386 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS12
01387 ******************************************************************DTSCS12
01388  P6900-FORMAT-LINE.                                               DTSCS12
01389                                                                   DTSCS12
01390      MOVE SPACES TO WRK-SCREEN-DATA-LINE.                         DTSCS12
01391                                                                   DTSCS12
01392      IF ISKL-BTB-88                                               DTSCS12
01393          MOVE IBTB-EMP-NO TO WRK-EMP-NO                           DTSCS12
01394      ELSE                                                         DTSCS12
01395      IF ISKL-OPN-88                                               DTSCS12
01396          MOVE IOPN-EMP-NO TO WRK-EMP-NO                           DTSCS12
01397      ELSE                                                         DTSCS12
01398      IF ISKL-OPS-88                                               DTSCS12
01399          MOVE IOPS-EMP-NO TO WRK-EMP-NO                           DTSCS12
01400      ELSE                                                         DTSCS12
01401      IF ISKL-EIN-88                                               DTSCS12
01402          MOVE IEIN-EMP-NO TO WRK-EMP-NO                           DTSCS12
01403      ELSE                                                         DTSCS12
01404      IF ISKL-BTN-88                                               DTSCS12
01405          MOVE IBTN-EMP-NO TO WRK-EMP-NO                           DTSCS12
01406      ELSE                                                         DTSCS12
01407          MOVE +0 TO WRK-EMP-NO.                                   DTSCS12
01408                                                                   DTSCS12
01409      PERFORM P6970-READ-PRF THRU P6970-EXIT.                      DTSCS12
01410      IF WRK-FATAL-ERROR-YES                                       DTSCS12
01411          GO TO P6900-EXIT.                                        DTSCS12
01412                                                                   DTSCS12
01413      PERFORM P6980-READ-TAD THRU P6980-EXIT.                      DTSCS12
01414      IF WRK-FATAL-ERROR-YES                                       DTSCS12
01415          GO TO P6900-EXIT.                                        DTSCS12
01416                                                                   DTSCS12
01417      IF ISKL-BTB-88                                               DTSCS12
01418         PERFORM P6910-FORMAT-FROM-BTB THRU P6910-EXIT             DTSCS12
01419      ELSE                                                         DTSCS12
01420      IF ISKL-OPN-88                                               DTSCS12
01421      OR ISKL-OPS-88                                               DTSCS12
01422         PERFORM P6920-FORMAT-FROM-OPO THRU P6920-EXIT             DTSCS12
01423      ELSE                                                         DTSCS12
01424         PERFORM P6930-FORMAT-FROM-PRF-TAD THRU P6930-EXIT.        DTSCS12
01425                                                                   DTSCS12
01426      IF WRK-FATAL-ERROR-YES                                       DTSCS12
01427          GO TO P6900-EXIT.                                        DTSCS12
01428                                                                   DTSCS12
01429      MOVE WRK-EMP-NO                 TO WRK-EMP-NO-DISP.          DTSCS12
01430      MOVE WRK-EMP-NO-DISP-1          TO WRK-EMP-NO-1.             DTSCS12
01431      MOVE WRK-EMP-NO-DISP-2          TO WRK-EMP-NO-2.             DTSCS12
01432                                                                   DTSCS12
01433      MOVE MPRF-EMP-STATUS            TO WRK-EMP-STATUS.           DTSCS12
01434                                                                   DTSCS12
01435                                                                   DTSCS12
01436                                                                   DTSCS12
01437  P6900-EXIT. EXIT.                                                DTSCS12
01438                                                                   DTSCS12
01439  P6910-FORMAT-FROM-BTB.                                           DTSCS12
01440      MOVE IBTB-NAME TO WRK-NAME.                                  DTSCS12
01441                                                                   DTSCS12
01442      IF IBTB-NAME-BEN-ALT-88                                      DTSCS12
01443         MOVE 'B' TO WRK-TYPE                                      DTSCS12
01444         PERFORM P6911-READ-BAA THRU P6911-EXIT                    DTSCS12
01445         IF WRK-FATAL-ERROR-YES                                    DTSCS12
01446            GO TO P6910-EXIT                                       DTSCS12
01447         ELSE                                                      DTSCS12
01448            MOVE MBAA-CITY            TO WRK-CITY                  DTSCS12
01449            MOVE MBAA-ST              TO WRK-ST                    DTSCS12
01450            GO TO P6910-EXIT                                       DTSCS12
01451         END-IF                                                    DTSCS12
01452      ELSE                                                         DTSCS12
01453         MOVE MTAD-CITY               TO WRK-CITY                  DTSCS12
01454         MOVE MTAD-ST                 TO WRK-ST                    DTSCS12
01455         IF IBTB-NAME-PRIMARY-88                                   DTSCS12
01456            MOVE 'P' TO WRK-TYPE                                   DTSCS12
01457         ELSE                                                      DTSCS12
01458         IF IBTB-NAME-ENTITY-88                                    DTSCS12
01459            MOVE 'E' TO WRK-TYPE                                   DTSCS12
01460         ELSE                                                      DTSCS12
01461         IF IBTB-NAME-TAX-ALT-88                                   DTSCS12
01462            MOVE 'A' TO WRK-TYPE                                   DTSCS12
01463         ELSE                                                      DTSCS12
01464            GO TO S899-ABEND.                                      DTSCS12
01465  P6910-EXIT.                                                      DTSCS12
01466      EXIT.                                                        DTSCS12
01467                                                                   DTSCS12
01468  P6911-READ-BAA.                                                  DTSCS12
01469      MOVE LOW-VALUES                 TO MBAA-KEY-AREA.            DTSCS12
01470      MOVE IBTB-EMP-NO                TO MBAA-EMP-NO.              DTSCS12
01471      MOVE IBTB-ID-NO                 TO MBAA-ID-NO.               DTSCS12
01472      SET MBAA-BAA-88                 TO TRUE.                     DTSCS12
01473      MOVE MBAA-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS12
01474      PERFORM S810-READ               THRU S810-EXIT.              DTSCS12
01475      IF L810-NO-REC-88                                            DTSCS12
01476         MOVE IBTB-EMP-NO         TO MSG-EMP-NO-IN-ERR             DTSCS12
01477         MOVE MSG-E123-AREA       TO LCCM-MSG-AREA                 DTSCS12
01478         SET LCCM-REQ-SCR-SF-88 TO TRUE                            DTSCS12
01479         SET LCCM-LINK-SCREEN-88 TO TRUE                           DTSCS12
01480         SET WRK-FATAL-ERROR-YES TO TRUE                           DTSCS12
01481         GO TO P6911-EXIT.                                         DTSCS12
01482                                                                   DTSCS12
01483      MOVE MSKL-REC                   TO MBAA-REC.                 DTSCS12
01484  P6911-EXIT.                                                      DTSCS12
01485      EXIT.                                                        DTSCS12
01486                                                                   DTSCS12
01487  P6920-FORMAT-FROM-OPO.                                           DTSCS12
01488      MOVE MTAD-CITY               TO WRK-CITY.                    DTSCS12
01489      MOVE MTAD-ST                 TO WRK-ST.                      DTSCS12
01490                                                                   DTSCS12
01491      IF ISKL-OPN-88                                               DTSCS12
01492         STRING                                                    DTSCS12
01493             IOPN-NAME                 DELIMITED BY '  '           DTSCS12
01494             '; '                      DELIMITED BY SIZE           DTSCS12
01495             MPRF-PRIMARY-NAME         DELIMITED BY SIZE           DTSCS12
01496           INTO                                                    DTSCS12
01497             WRK-NAME                                              DTSCS12
01498      ELSE                                                         DTSCS12
01499      IF ISKL-OPS-88                                               DTSCS12
01500         PERFORM P6921-READ-OPO THRU P6921-EXIT                    DTSCS12
01501         IF WRK-FATAL-ERROR-YES                                    DTSCS12
01502             GO TO P6920-EXIT                                      DTSCS12
01503         END-IF                                                    DTSCS12
01504         STRING                                                    DTSCS12
01505             MOPO-NAME              DELIMITED BY '  '              DTSCS12
01506             '; '                   DELIMITED BY SIZE              DTSCS12
01507             MPRF-PRIMARY-NAME      DELIMITED BY SIZE              DTSCS12
01508           INTO                                                    DTSCS12
01509             WRK-NAME.                                             DTSCS12
01510  P6920-EXIT.                                                      DTSCS12
01511      EXIT.                                                        DTSCS12
01512                                                                   DTSCS12
01513  P6921-READ-OPO.                                                  DTSCS12
01514      MOVE LOW-VALUES                 TO MOPO-KEY-AREA.            DTSCS12
01515      MOVE IOPS-EMP-NO                TO MOPO-EMP-NO.              DTSCS12
01516      MOVE IOPS-ID-NO                 TO MOPO-ID-NO.               DTSCS12
01517      SET MOPO-OPO-88                 TO TRUE.                     DTSCS12
01518      MOVE MOPO-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS12
01519      PERFORM S810-READ               THRU S810-EXIT.              DTSCS12
01520      IF L810-NO-REC-88                                            DTSCS12
01521         MOVE IOPS-EMP-NO         TO MSG-EMP-NO-IN-ERR             DTSCS12
01522         MOVE MSG-E123-AREA       TO LCCM-MSG-AREA                 DTSCS12
01523         SET LCCM-REQ-SCR-SF-88 TO TRUE                            DTSCS12
01524         SET LCCM-LINK-SCREEN-88 TO TRUE                           DTSCS12
01525         SET WRK-FATAL-ERROR-YES TO TRUE                           DTSCS12
01526         GO TO P6921-EXIT.                                         DTSCS12
01527                                                                   DTSCS12
01528      MOVE MSKL-REC                   TO MOPO-REC.                 DTSCS12
01529  P6921-EXIT.                                                      DTSCS12
01530      EXIT.                                                        DTSCS12
01531                                                                   DTSCS12
01532  P6930-FORMAT-FROM-PRF-TAD.                                       DTSCS12
01533      MOVE MPRF-PRIMARY-NAME TO WRK-NAME.                          DTSCS12
01534      MOVE MTAD-CITY         TO WRK-CITY.                          DTSCS12
01535      MOVE MTAD-ST           TO WRK-ST.                            DTSCS12
01536  P6930-EXIT.                                                      DTSCS12
01537      EXIT.                                                        DTSCS12
01538                                                                   DTSCS12
01539                                                                   DTSCS12
01540  P6970-READ-PRF.                                                  DTSCS12
01541      MOVE LOW-VALUES                 TO MPRF-KEY-AREA.            DTSCS12
01542      MOVE WRK-EMP-NO                 TO MPRF-EMP-NO.              DTSCS12
01543      SET MPRF-PRF-88                 TO TRUE.                     DTSCS12
01544      MOVE MPRF-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS12
01545      PERFORM S810-READ               THRU S810-EXIT.              DTSCS12
01546      IF L810-NO-REC-88                                            DTSCS12
01547         MOVE WRK-EMP-NO          TO MSG-EMP-NO-IN-ERR             DTSCS12
01548         MOVE MSG-E123-AREA       TO LCCM-MSG-AREA                 DTSCS12
01549         SET LCCM-REQ-SCR-SF-88 TO TRUE                            DTSCS12
01550         SET LCCM-LINK-SCREEN-88 TO TRUE                           DTSCS12
01551         SET WRK-FATAL-ERROR-YES TO TRUE                           DTSCS12
01552         GO TO P6970-EXIT.                                         DTSCS12
01553                                                                   DTSCS12
01554      MOVE MSKL-REC                   TO MPRF-REC.                 DTSCS12
01555  P6970-EXIT.                                                      DTSCS12
01556      EXIT.                                                        DTSCS12
01557                                                                   DTSCS12
01558  P6980-READ-TAD.                                                  DTSCS12
01559      MOVE LOW-VALUES                 TO MTAD-KEY-AREA.            DTSCS12
01560      MOVE WRK-EMP-NO                 TO MTAD-EMP-NO.              DTSCS12
01561      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSCS12
01562      SET MTAD-TAD-88                 TO TRUE.                     DTSCS12
01563      MOVE MTAD-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS12
01564      PERFORM S810-READ               THRU S810-EXIT.              DTSCS12
01565      IF L810-NO-REC-88                                            DTSCS12
01566         MOVE WRK-EMP-NO          TO MSG-EMP-NO-IN-ERR             DTSCS12
01567         MOVE MSG-E123-AREA       TO LCCM-MSG-AREA                 DTSCS12
01568         SET LCCM-REQ-SCR-SF-88 TO TRUE                            DTSCS12
01569         SET LCCM-LINK-SCREEN-88 TO TRUE                           DTSCS12
01570         SET WRK-FATAL-ERROR-YES TO TRUE                           DTSCS12
01571         GO TO P6980-EXIT.                                         DTSCS12
01572                                                                   DTSCS12
01573      MOVE MSKL-REC                   TO MTAD-REC.                 DTSCS12
01574  P6980-EXIT.                                                      DTSCS12
01575      EXIT.                                                        DTSCS12
01576                                                                   DTSCS12
01577 /*****************************************************************DTSCS12
01578 * CHECK DATA IN LCCM-SCR-HOLD-AREA.  THE TABLE CONTAINS AIX KEYS  DTSCS12
01579 * REPRESENTING EACH LINE DISPLAYED.  THIS PARAGRAPH IS CALLED     DTSCS12
01580 * FROM P3000, P4000, P6000.                                       DTSCS12
01581 ******************************************************************DTSCS12
01582  P9000-CHECK-LCCM-SCR-HOLD.                                       DTSCS12
01583      MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA                 DTSCS12
01584      IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME                     DTSCS12
01585         NEXT SENTENCE                                             DTSCS12
01586      ELSE                                                         DTSCS12
01587         GO TO P9000-EXIT.                                         DTSCS12
01588                                                                   DTSCS12
01589      MOVE WRK-SCR-HOLD-KEY (1) TO ISKL-KEY-AREA.                  DTSCS12
01590      IF ISKL-BTB-88                                               DTSCS12
01591      OR ISKL-OPN-88                                               DTSCS12
01592      OR ISKL-OPS-88                                               DTSCS12
01593      OR ISKL-EIN-88                                               DTSCS12
01594      OR ISKL-BTN-88                                               DTSCS12
01595         SET WRK-AIX-TBL-KEY-FND TO TRUE                           DTSCS12
01596         MOVE ISKL-KEY-AREA TO WRK-STARTING-SEARCH-KEY             DTSCS12
01597      ELSE                                                         DTSCS12
01598         GO TO P9000-EXIT.                                         DTSCS12
01599                                                                   DTSCS12
01600      MOVE WRK-SCR-HOLD-KEY (WRK-SCR-HOLD-KEY-CTR)                 DTSCS12
01601                                TO ISKL-KEY-AREA.                  DTSCS12
01602      IF ISKL-BTB-88                                               DTSCS12
01603      OR ISKL-OPN-88                                               DTSCS12
01604      OR ISKL-OPS-88                                               DTSCS12
01605      OR ISKL-EIN-88                                               DTSCS12
01606      OR ISKL-BTN-88                                               DTSCS12
01607         MOVE ISKL-KEY-AREA TO WRK-ENDING-SEARCH-KEY               DTSCS12
01608      ELSE                                                         DTSCS12
01609         MOVE WRK-STARTING-SEARCH-KEY                              DTSCS12
01610                            TO WRK-ENDING-SEARCH-KEY.              DTSCS12
01611  P9000-EXIT.                                                      DTSCS12
01612      EXIT.                                                        DTSCS12
01613                                                                   DTSCS12
01614 /*****************************************************************DTSCS12
01615 * LINKS TO UTILITY MODULES                                        DTSCS12
01616 ******************************************************************DTSCS12
01617                                                                   DTSCS12
01618  S001-FROM-FED-8.                                                 DTSCS12
01619      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS12
01620      GO TO S001-DATE.                                             DTSCS12
01621                                                                   DTSCS12
01622  S001-FROM-ABS-DATE.                                              DTSCS12
01623      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS12
01624      GO TO S001-DATE.                                             DTSCS12
01625                                                                   DTSCS12
01626  S001-DATE.                                                       DTSCS12
01627      EXEC CICS LINK                                               DTSCS12
01628          PROGRAM('DTSCU001')                                      DTSCS12
01629          COMMAREA(L001-COMM-AREA)                                 DTSCS12
01630      END-EXEC.                                                    DTSCS12
01631  S001-EXIT.                                                       DTSCS12
01632      EXIT.                                                        DTSCS12
01633                                                                   DTSCS12
01634  S013-COUNT-FROM-SCREEN.                                          DTSCS12
01635      EXEC CICS LINK                                               DTSCS12
01636          PROGRAM('DTSCU013')                                      DTSCS12
01637          COMMAREA(L013-COMM-AREA)                                 DTSCS12
01638      END-EXEC.                                                    DTSCS12
01639  S013-EXIT.                                                       DTSCS12
01640      EXIT.                                                        DTSCS12
01641                                                                   DTSCS12
01642  S017-FEIN-FROM-SCREEN.                                           DTSCS12
01643      EXEC CICS LINK                                               DTSCS12
01644          PROGRAM('DTSCU017')                                      DTSCS12
01645          COMMAREA(L017-COMM-AREA)                                 DTSCS12
01646      END-EXEC.                                                    DTSCS12
01647  S017-EXIT.                                                       DTSCS12
01648      EXIT.                                                        DTSCS12
01649                                                                   DTSCS12
01650  S020-SSN-FROM-SCREEN.                                            DTSCS12
01651      EXEC CICS LINK                                               DTSCS12
01652          PROGRAM('DTSCU020')                                      DTSCS12
01653          COMMAREA(L020-COMM-AREA)                                 DTSCS12
01654      END-EXEC.                                                    DTSCS12
01655  S020-EXIT.                                                       DTSCS12
01656      EXIT.                                                        DTSCS12
01657                                                                   DTSCS12
01658  S027-BTN-FROM-SCREEN.                                            DTSCS12
01659      EXEC CICS LINK                                               DTSCS12
01660          PROGRAM('DTSCU027')                                      DTSCS12
01661          COMMAREA(L027-COMM-AREA)                                 DTSCS12
01662      END-EXEC.                                                    DTSCS12
01663  S027-EXIT.                                                       DTSCS12
01664      EXIT.                                                        DTSCS12
01665                                                                   DTSCS12
01666  S803-REQ-SCR-ID-EDIT.                                            DTSCS12
01667      EXEC CICS LINK                                               DTSCS12
01668          PROGRAM ('DTSCU803')                                     DTSCS12
01669          COMMAREA (DFHCOMMAREA)                                   DTSCS12
01670      END-EXEC.                                                    DTSCS12
01671  S803-EXIT.                                                       DTSCS12
01672      EXIT.                                                        DTSCS12
01673                                                                   DTSCS12
01674  S804-INVALID-KEY.                                                DTSCS12
01675      EXEC CICS LINK                                               DTSCS12
01676          PROGRAM ('DTSCU804')                                     DTSCS12
01677          COMMAREA (DFHCOMMAREA)                                   DTSCS12
01678      END-EXEC.                                                    DTSCS12
01679  S804-EXIT.                                                       DTSCS12
01680      EXIT.                                                        DTSCS12
01681                                                                   DTSCS12
01682  S805-MSG-AREA.                                                   DTSCS12
01683      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS12
01684                                                                   DTSCS12
01685      EXEC CICS LINK                                               DTSCS12
01686          PROGRAM ('DTSCU805')                                     DTSCS12
01687          COMMAREA (L805-COMM-AREA)                                DTSCS12
01688      END-EXEC.                                                    DTSCS12
01689                                                                   DTSCS12
01690      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS12
01691  S805-EXIT.                                                       DTSCS12
01692      EXIT.                                                        DTSCS12
01693      EJECT                                                        DTSCS12
01694  S810-READ.                                                       DTSCS12
01695      SET L810-READ-88 TO TRUE.                                    DTSCS12
01696      GO TO S810-IO.                                               DTSCS12
01697                                                                   DTSCS12
01698  S810-START-BROWSE.                                               DTSCS12
01699      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS12
01700      GO TO S810-IO.                                               DTSCS12
01701                                                                   DTSCS12
01702  S810-READ-NEXT.                                                  DTSCS12
01703      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS12
01704      GO TO S810-IO.                                               DTSCS12
01705                                                                   DTSCS12
01706  S810-READ-PREV.                                                  DTSCS12
01707      SET L810-READ-PREV-88 TO TRUE.                               DTSCS12
01708      GO TO S810-IO.                                               DTSCS12
01709                                                                   DTSCS12
01710  S810-END-BROWSE.                                                 DTSCS12
01711      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS12
01712      GO TO S810-IO.                                               DTSCS12
01713                                                                   DTSCS12
01714  S810-COUNT.                                                      DTSCS12
01715      SET L810-COUNT-88 TO TRUE.                                   DTSCS12
01716      GO TO S810-IO.                                               DTSCS12
01717                                                                   DTSCS12
01718  S810-REWRITE.                                                    DTSCS12
01719      SET L810-REWRITE-88 TO TRUE.                                 DTSCS12
01720      GO TO S810-IO.                                               DTSCS12
01721                                                                   DTSCS12
01722  S810-WRITE.                                                      DTSCS12
01723      SET L810-WRITE-88 TO TRUE.                                   DTSCS12
01724      GO TO S810-IO.                                               DTSCS12
01725                                                                   DTSCS12
01726  S810-DELETE.                                                     DTSCS12
01727      SET L810-DELETE-88 TO TRUE.                                  DTSCS12
01728      GO TO S810-IO.                                               DTSCS12
01729                                                                   DTSCS12
01730  S810-IO.                                                         DTSCS12
01731                                                                   DTSCS12
01732      EXEC CICS LINK                                               DTSCS12
01733          PROGRAM ('DTSCU810')                                     DTSCS12
01734          COMMAREA (L810-COMM-AREA)                                DTSCS12
01735      END-EXEC.                                                    DTSCS12
01736                                                                   DTSCS12
01737      IF L810-FILE-CLOSED-88                                       DTSCS12
01738          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS12
01739          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS12
01740          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS12
01741          GO TO MAINLINE-EXIT.                                     DTSCS12
01742  S810-EXIT.                                                       DTSCS12
01743      EXIT.                                                        DTSCS12
01744      EJECT                                                        DTSCS12
01745  S821-START-BROWSE.                                               DTSCS12
01746      SET L821-START-BROWSE-88 TO TRUE.                            DTSCS12
01747      GO TO S821-MASTER-IO.                                        DTSCS12
01748                                                                   DTSCS12
01749  S821-END-BROWSE.                                                 DTSCS12
01750      SET L821-END-BROWSE-88 TO TRUE.                              DTSCS12
01751      GO TO S821-MASTER-IO.                                        DTSCS12
01752                                                                   DTSCS12
01753  S821-READ-PREV.                                                  DTSCS12
01754      SET L821-READ-PREV-88 TO TRUE.                               DTSCS12
01755      GO TO S821-MASTER-IO.                                        DTSCS12
01756                                                                   DTSCS12
01757  S821-READ-NEXT.                                                  DTSCS12
01758      SET L821-READ-NEXT-88 TO TRUE.                               DTSCS12
01759      GO TO S821-MASTER-IO.                                        DTSCS12
01760                                                                   DTSCS12
01761  S821-MASTER-IO.                                                  DTSCS12
01762      MOVE ISKL-KEY-AREA TO HOLD-ISKL-KEY-AREA.                    DTSCS12
01763                                                                   DTSCS12
01764      EXEC CICS LINK                                               DTSCS12
01765          PROGRAM ('DTSCU821')                                     DTSCS12
01766          COMMAREA (L821-COMM-AREA)                                DTSCS12
01767      END-EXEC.                                                    DTSCS12
01768                                                                   DTSCS12
01769      IF L821-FILE-CLOSED-88                                       DTSCS12
01770          MOVE L821-MSG-AREA TO LCCM-MSG-AREA                      DTSCS12
01771          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS12
01772          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS12
01773          GO TO MAINLINE-EXIT                                      DTSCS12
01774      ELSE                                                         DTSCS12
01775      IF L821-OK-88                                                DTSCS12
01776         PERFORM S821A-SIMULATE-NO-REC THRU S821A-EXIT.            DTSCS12
01777  S821-EXIT. EXIT.                                                 DTSCS12
01778                                                                   DTSCS12
01779  S821A-SIMULATE-NO-REC.                                           DTSCS12
01780      IF L821-END-BROWSE-88                                        DTSCS12
01781          GO TO S821A-EXIT.                                        DTSCS12
01782                                                                   DTSCS12
01783      IF (ISKL-EIN-88)                                             DTSCS12
01784         AND IEIN-FEIN NOT = WRK-FEIN                              DTSCS12
01785         SET L821-END-BROWSE-88 TO TRUE                            DTSCS12
01786         EXEC CICS LINK                                            DTSCS12
01787             PROGRAM ('DTSCU821')                                  DTSCS12
01788             COMMAREA (L821-COMM-AREA)                             DTSCS12
01789         END-EXEC                                                  DTSCS12
01790         MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA                  DTSCS12
01791         SET L821-NO-REC-88 TO TRUE                                DTSCS12
01792      ELSE                                                         DTSCS12
01793      IF (ISKL-OPS-88)                                             DTSCS12
01794         AND IOPS-SSN  NOT = WRK-SSN                               DTSCS12
01795         SET L821-END-BROWSE-88 TO TRUE                            DTSCS12
01796         EXEC CICS LINK                                            DTSCS12
01797             PROGRAM ('DTSCU821')                                  DTSCS12
01798             COMMAREA (L821-COMM-AREA)                             DTSCS12
01799         END-EXEC                                                  DTSCS12
01800         MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA                  DTSCS12
01801         SET L821-NO-REC-88 TO TRUE                                DTSCS12
01802      ELSE                                                         DTSCS12
01803      IF (ISKL-BTN-88)                                             DTSCS12
01804         AND IBTN-DC-BUSINESS-TAX-ACCT-NO NOT = WRK-BTN            DTSCS12
01805         SET L821-END-BROWSE-88 TO TRUE                            DTSCS12
01806         EXEC CICS LINK                                            DTSCS12
01807             PROGRAM ('DTSCU821')                                  DTSCS12
01808             COMMAREA (L821-COMM-AREA)                             DTSCS12
01809         END-EXEC                                                  DTSCS12
01810         MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA                  DTSCS12
01811         SET L821-NO-REC-88 TO TRUE.                               DTSCS12
01812  S821A-EXIT. EXIT.                                                DTSCS12
01813                                                                   DTSCS12
01814  S851-SCREEN-PROCESSING.                                          DTSCS12
01815      EXEC CICS LINK                                               DTSCS12
01816          PROGRAM ('DTSCU851')                                     DTSCS12
01817          COMMAREA (L851-COMM-AREA)                                DTSCS12
01818      END-EXEC.                                                    DTSCS12
01819  S851-EXIT.                                                       DTSCS12
01820      EXIT.                                                        DTSCS12
01821                                                                   DTSCS12
01822  S899-ABEND.                                                      DTSCS12
01823      EXEC CICS ABEND                                              DTSCS12
01824          ABCODE(WRK-ABEND-CD)                                     DTSCS12
01825      END-EXEC.                                                    DTSCS12
01826  S899-EXIT.                                                       DTSCS12
01827      EXIT.                                                        DTSCS12
01828 /*****************************************************************DTSCS12
01829 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS12
01830 ******************************************************************DTSCS12
01831                                                                   DTSCS12
01832  S1000-SCREEN-EDITS.                                              DTSCS12
01833      MOVE +0  TO WRK-NUM-SRCH-FLDS-ENTERED.                       DTSCS12
01834      PERFORM S1100-EDIT-NAME          THRU S1100-EXIT.            DTSCS12
01835      PERFORM S1200-EDIT-OPO           THRU S1200-EXIT.            DTSCS12
01836      PERFORM S1300-EDIT-SSN           THRU S1300-EXIT.            DTSCS12
01837      PERFORM S1400-EDIT-FEIN          THRU S1400-EXIT.            DTSCS12
01838      PERFORM S1500-EDIT-BTN           THRU S1500-EXIT.            DTSCS12
01839      IF WRK-NUM-SRCH-FLDS-ENTERED = 0                             DTSCS12
01840        MOVE MSG-E121-AREA TO WRK-MSG-AREA                         DTSCS12
01841        PERFORM S1001-ERROR THRU S1001-EXIT                        DTSCS12
01842      ELSE                                                         DTSCS12
01843      IF WRK-NUM-SRCH-FLDS-ENTERED > 1                             DTSCS12
01844        MOVE MSG-E122-AREA TO WRK-MSG-AREA                         DTSCS12
01845        PERFORM S1001-ERROR THRU S1001-EXIT.                       DTSCS12
01846                                                                   DTSCS12
01847  S1000-EXIT. EXIT.                                                DTSCS12
01848      EJECT                                                        DTSCS12
01849 /**************************************************************** DTSCS12
01850 *  ERROR IN SELECTION CRITERIA                                    DTSCS12
01851 ***************************************************************** DTSCS12
01852  S1001-ERROR.                                                     DTSCS12
01853      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-NAME-A             DTSCS12
01854                                        MAP-OPO-NAME-A.            DTSCS12
01855      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A               DTSCS12
01856                                         MAP-SSN-2-A               DTSCS12
01857                                         MAP-SSN-3-A               DTSCS12
01858                                         MAP-FEIN-1-A              DTSCS12
01859                                         MAP-FEIN-2-A              DTSCS12
01860                                         MAP-BTN-A.                DTSCS12
01861      SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01862      IF LCCM-NO-MSG                                               DTSCS12
01863         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS12
01864         MOVE CATB-CURSOR              TO MAP-EMP-NAME-L.          DTSCS12
01865  S1001-EXIT. EXIT.                                                DTSCS12
01866 /**************************************************************** DTSCS12
01867 *  EDIT EMPLOYER NAME FOR ENTRY                                   DTSCS12
01868 ***************************************************************** DTSCS12
01869  S1100-EDIT-NAME.                                                 DTSCS12
01870      IF MAP-EMP-NAME = LOW-VALUES OR SPACES                       DTSCS12
01871         NEXT SENTENCE                                             DTSCS12
01872      ELSE                                                         DTSCS12
01873         ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED                        DTSCS12
01874         MOVE LOW-VALUES TO IBTB-KEY-AREA                          DTSCS12
01875         SET IBTB-BTB-88 TO TRUE                                   DTSCS12
01876         MOVE MAP-EMP-NAME TO IBTB-NAME                            DTSCS12
01877         MOVE ZEROS TO IBTB-EMP-NO                                 DTSCS12
01878                       IBTB-ID-NO                                  DTSCS12
01879         MOVE IBTB-KEY-AREA TO WRK-STARTING-SEARCH-KEY.            DTSCS12
01880  S1100-EXIT. EXIT.                                                DTSCS12
01881                                                                   DTSCS12
01882 /**************************************************************** DTSCS12
01883 *  EDIT OPO NAME FOR ENTRY                                        DTSCS12
01884 ***************************************************************** DTSCS12
01885  S1200-EDIT-OPO.                                                  DTSCS12
01886      IF MAP-OPO-NAME = LOW-VALUES OR SPACES                       DTSCS12
01887         NEXT SENTENCE                                             DTSCS12
01888      ELSE                                                         DTSCS12
01889         ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED                        DTSCS12
01890         MOVE LOW-VALUES TO IOPN-KEY-AREA                          DTSCS12
01891         SET IOPN-OPN-88 TO TRUE                                   DTSCS12
01892         MOVE MAP-OPO-NAME TO IOPN-NAME                            DTSCS12
01893         MOVE ZEROS TO IOPN-EMP-NO                                 DTSCS12
01894                       IOPN-ID-NO                                  DTSCS12
01895         MOVE IOPN-KEY-AREA TO WRK-STARTING-SEARCH-KEY.            DTSCS12
01896  S1200-EXIT. EXIT.                                                DTSCS12
01897                                                                   DTSCS12
01898 /**************************************************************** DTSCS12
01899 *  EDIT SSN FOR ENTRY                                             DTSCS12
01900 ***************************************************************** DTSCS12
01901  S1300-EDIT-SSN.                                                  DTSCS12
01902      MOVE MAP-SSN-AREA  TO L020-S-SSN-AREA                        DTSCS12
01903      PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT                  DTSCS12
01904      IF L020-NO-ENTRY                                             DTSCS12
01905         NEXT SENTENCE                                             DTSCS12
01906      ELSE                                                         DTSCS12
01907         ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED                        DTSCS12
01908         IF L020-NOT-VALID                                         DTSCS12
01909            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS12
01910            PERFORM S1301-ERROR THRU S1301-EXIT                    DTSCS12
01911         ELSE                                                      DTSCS12
01912            MOVE LOW-VALUES TO IOPS-KEY-AREA                       DTSCS12
01913            SET IOPS-OPS-88 TO TRUE                                DTSCS12
01914            MOVE L020-SSN  TO IOPS-SSN                             DTSCS12
01915            MOVE ZEROS TO IOPS-EMP-NO                              DTSCS12
01916                          IOPS-ID-NO                               DTSCS12
01917            MOVE IOPS-KEY-AREA TO WRK-STARTING-SEARCH-KEY.         DTSCS12
01918  S1300-EXIT. EXIT.                                                DTSCS12
01919                                                                   DTSCS12
01920  S1301-ERROR.                                                     DTSCS12
01921      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A               DTSCS12
01922                                         MAP-SSN-2-A               DTSCS12
01923                                         MAP-SSN-3-A.              DTSCS12
01924      SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01925      IF LCCM-NO-MSG                                               DTSCS12
01926         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS12
01927         MOVE CATB-CURSOR              TO MAP-SSN-1-L.             DTSCS12
01928  S1301-EXIT. EXIT.                                                DTSCS12
01929                                                                   DTSCS12
01930 /**************************************************************** DTSCS12
01931 *  EDIT FEIN FOR ENTRY                                            DTSCS12
01932 ***************************************************************** DTSCS12
01933  S1400-EDIT-FEIN.                                                 DTSCS12
01934      MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA                       DTSCS12
01935      PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT                 DTSCS12
01936      IF L017-NO-ENTRY                                             DTSCS12
01937         NEXT SENTENCE                                             DTSCS12
01938      ELSE                                                         DTSCS12
01939         ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED                        DTSCS12
01940         IF L017-NOT-VALID                                         DTSCS12
01941            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS12
01942            PERFORM S1401-ERROR THRU S1401-EXIT                    DTSCS12
01943         ELSE                                                      DTSCS12
01944            MOVE LOW-VALUES TO IEIN-KEY-AREA                       DTSCS12
01945            SET IEIN-EIN-88 TO TRUE                                DTSCS12
01946            MOVE L017-FEIN TO IEIN-FEIN                            DTSCS12
01947            MOVE ZEROS TO IEIN-EMP-NO                              DTSCS12
01948            MOVE IEIN-KEY-AREA TO WRK-STARTING-SEARCH-KEY.         DTSCS12
01949  S1400-EXIT. EXIT.                                                DTSCS12
01950                                                                   DTSCS12
01951  S1401-ERROR.                                                     DTSCS12
01952      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FEIN-1-A              DTSCS12
01953                                         MAP-FEIN-2-A              DTSCS12
01954      SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01955      IF LCCM-NO-MSG                                               DTSCS12
01956         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS12
01957         MOVE CATB-CURSOR              TO MAP-FEIN-1-L.            DTSCS12
01958  S1401-EXIT. EXIT.                                                DTSCS12
01959                                                                   DTSCS12
01960 /**************************************************************** DTSCS12
01961 *  EDIT BUSINESS TAX NUMBER                                       DTSCS12
01962 ***************************************************************** DTSCS12
01963  S1500-EDIT-BTN.                                                  DTSCS12
01964      MOVE MAP-BTN-AREA TO L027-S-BTN-AREA                         DTSCS12
01965      PERFORM S027-BTN-FROM-SCREEN THRU S027-EXIT                  DTSCS12
01966      IF L027-NO-ENTRY                                             DTSCS12
01967         NEXT SENTENCE                                             DTSCS12
01968      ELSE                                                         DTSCS12
01969         ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED                        DTSCS12
01970         IF L027-NOT-VALID                                         DTSCS12
01971            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS12
01972            PERFORM S1501-ERROR THRU S1501-EXIT                    DTSCS12
01973         ELSE                                                      DTSCS12
01974            MOVE LOW-VALUES TO IBTN-KEY-AREA                       DTSCS12
01975            SET IBTN-BTN-88 TO TRUE                                DTSCS12
01976            MOVE L027-BTN  TO IBTN-DC-BUSINESS-TAX-ACCT-NO         DTSCS12
01977            MOVE ZEROS TO IBTN-EMP-NO                              DTSCS12
01978            MOVE IBTN-KEY-AREA TO WRK-STARTING-SEARCH-KEY.         DTSCS12
01979  S1500-EXIT. EXIT.                                                DTSCS12
01980                                                                   DTSCS12
01981  S1501-ERROR.                                                     DTSCS12
01982      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BTN-A.                DTSCS12
01983      SET CURSOR-SET-YES TO TRUE.                                  DTSCS12
01984      IF LCCM-NO-MSG                                               DTSCS12
01985         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS12
01986         MOVE CATB-CURSOR              TO MAP-BTN-L.               DTSCS12
01987  S1501-EXIT. EXIT.                                                DTSCS12
01988                                                                   DTSCS12
01989 ******************************************************************DTSCS12
01990 * SET ATTIBUTE BYTES FOR SCREEN CLEAR REQUEST.  THIS UNLOCKS THE *DTSCS12
01991 * SEARCH CRITERIA FIELDS WHICH ARE PROTECTED WHEN REQ-INQUIRE     DTSCS12
01992 * IS TRUE.                                                        DTSCS12
01993 ******************************************************************DTSCS12
01994  S5200-SET-CLEAR-ATTRB.                                           DTSCS12
01995      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-EMP-NAME-A            DTSCS12
01996                                         MAP-OPO-NAME-A.           DTSCS12
01997      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A               DTSCS12
01998                                         MAP-SSN-2-A               DTSCS12
01999                                         MAP-SSN-3-A               DTSCS12
02000                                         MAP-FEIN-1-A              DTSCS12
02001                                         MAP-FEIN-2-A              DTSCS12
02002                                         MAP-BTN-A.                DTSCS12
02003                                                                   DTSCS12
02004      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS12
02005                                                                   DTSCS12
02006  S5200-EXIT.                                                      DTSCS12
02007      EXIT.                                                        DTSCS12
02008                                                                   DTSCS12
02009 ******************************************************************DTSCS12
02010 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS12
02011 *  WHILE AN INQUIRY IS IN PROGRESS, THE SEARCH CRITERIA FIELDS    DTSCS12
02012 *  ARE PROTECTED.  THE USER MUST CLEAR THE SCREEN TO CHANGE THE   DTSCS12
02013 *  SEARCH CRITERIA.                                               DTSCS12
02014 ******************************************************************DTSCS12
02015  S5300-SET-INQ-ATTRB.                                             DTSCS12
02016                                                                   DTSCS12
02017      MOVE CATB-ASKIP-NORM-MDTON TO      MAP-EMP-NAME-A            DTSCS12
02018                                         MAP-OPO-NAME-A            DTSCS12
02019                                         MAP-SSN-1-A               DTSCS12
02020                                         MAP-SSN-2-A               DTSCS12
02021                                         MAP-SSN-3-A               DTSCS12
02022                                         MAP-FEIN-1-A              DTSCS12
02023                                         MAP-FEIN-2-A              DTSCS12
02024                                         MAP-BTN-A.                DTSCS12
02025                                                                   DTSCS12
02026      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS12
02027  S5300-EXIT.                                                      DTSCS12
02028      EXIT.                                                        DTSCS12
02029                                                                   DTSCS12
02030  S5900-SET-ATTRB.                                                 DTSCS12
02031      PERFORM S5910-TABLE THRU S5910-EXIT                          DTSCS12
02032          VARYING WRK-CTR FROM 1 BY 1                              DTSCS12
02033          UNTIL WRK-CTR > MAX-LINES.                               DTSCS12
02034      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS12
02035  S5900-EXIT. EXIT.                                                DTSCS12
02036                                                                   DTSCS12
02037  S5910-TABLE.                                                     DTSCS12
02038      MOVE CATB-ASKIP-BRT-MDTON TO MAP-LINE-A(WRK-CTR).            DTSCS12
02039  S5910-EXIT. EXIT.                                                DTSCS12
02040 /***************************************************************  DTSCS12
02041 * THESE ATTRIBUTES ARE BUILT PRIOR TO THE SEND BASED ON THE       DTSCS12
02042 * SEARCH RESULTS AND SCREEN STATUS                                DTSCS12
02043 ****************************************************************  DTSCS12
02044 *S5920-ATTRIBUTES.                                                DTSCS12
02045 *    IF WRK-TS-FOUND-YES                                          DTSCS12
02046 *****AND MAP-SCREEN-ID-A = LOW-VALUES                             DTSCS12
02047 *        MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A         DTSCS12
02048 *    ELSE                                                         DTSCS12
02049 *    IF WRK-TS-FOUND-NO                                           DTSCS12
02050 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-SCREEN-ID-A.            DTSCS12
02051 *                                                                 DTSCS12
02052 *    IF WRK-TS-FOUND-YES                                          DTSCS12
02053 *****AND MAP-LINE-NUMBER-A = LOW-VALUES                           DTSCS12
02054 *        MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A      DTSCS12
02055 *    ELSE                                                         DTSCS12
02056 *    IF WRK-TS-FOUND-NO                                           DTSCS12
02057 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-LINE-NUMBER-A.          DTSCS12
02058 *                                                                 DTSCS12
02059 *    IF WRK-TS-FOUND-NO AND MAP-LEGAL-NAME-A = LOW-VALUES         DTSCS12
02060 *        MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-LEGAL-NAME-A        DTSCS12
02061 *    ELSE                                                         DTSCS12
02062 *    IF WRK-TS-FOUND-YES                                          DTSCS12
02063 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-LEGAL-NAME-A.           DTSCS12
02064 *                                                                 DTSCS12
02065 *    IF WRK-TS-FOUND-NO AND MAP-OPO-NAME-A = LOW-VALUES           DTSCS12
02066 *        MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-OPO-NAME-A          DTSCS12
02067 *    ELSE                                                         DTSCS12
02068 *    IF WRK-TS-FOUND-YES                                          DTSCS12
02069 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-OPO-NAME-A.             DTSCS12
02070 *                                                                 DTSCS12
02071 *    IF WRK-TS-FOUND-NO AND MAP-SSN-1-A = LOW-VALUES              DTSCS12
02072 *        MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SSN-1-A            DTSCS12
02073 *        MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SSN-2-A            DTSCS12
02074 *        MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SSN-3-A            DTSCS12
02075 *    ELSE                                                         DTSCS12
02076 *    IF WRK-TS-FOUND-YES                                          DTSCS12
02077 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-SSN-1-A                 DTSCS12
02078 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-SSN-2-A                 DTSCS12
02079 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-SSN-3-A.                DTSCS12
02080 *                                                                 DTSCS12
02081 *    IF WRK-TS-FOUND-NO AND MAP-FEIN-1-A = LOW-VALUES             DTSCS12
02082 *        MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-FEIN-1-A           DTSCS12
02083 *        MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-FEIN-2-A           DTSCS12
02084 *    ELSE                                                         DTSCS12
02085 *    IF WRK-TS-FOUND-YES                                          DTSCS12
02086 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-FEIN-1-A                DTSCS12
02087 *       MOVE CATB-ASKIP-NORM-MDTON TO MAP-FEIN-2-A.               DTSCS12
02088 *                                                                 DTSCS12
02089 *S5920-EXIT. EXIT.                                                DTSCS12
02090 *    EJECT                                                        DTSCS12
02091 /*****************************************************************DTSCS12
02092 * MAP ROUTINES                                                   *DTSCS12
02093 ******************************************************************DTSCS12
02094  S9100-RECEIVE.                                                   DTSCS12
02095      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS12
02096                                                                   DTSCS12
02097      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS12
02098                                                                   DTSCS12
02099      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS12
02100                                                                   DTSCS12
02101      MOVE L851-AID TO LCCM-AID.                                   DTSCS12
02102      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS12
02103  S9100-EXIT.                                                      DTSCS12
02104      EXIT.                                                        DTSCS12
02105                                                                   DTSCS12
02106  S9200-SEND-DATAONLY.                                             DTSCS12
02107      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS12
02108                                                                   DTSCS12
02109      IF LCCM-NO-MSG                                               DTSCS12
02110          NEXT SENTENCE                                            DTSCS12
02111      ELSE                                                         DTSCS12
02112          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS12
02113                                                                   DTSCS12
02114      IF CURSOR-SET-GOTO                                           DTSCS12
02115          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS12
02116      ELSE                                                         DTSCS12
02117      IF CURSOR-SET-NO                                             DTSCS12
02118          MOVE CATB-CURSOR TO MAP-EMP-NAME-L.                      DTSCS12
02119                                                                   DTSCS12
02120      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS12
02121                                                                   DTSCS12
02122      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS12
02123                                                                   DTSCS12
02124      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS12
02125  S9200-EXIT.                                                      DTSCS12
02126      EXIT.                                                        DTSCS12
02127                                                                   DTSCS12
02128  S9300-SEND-MAP.                                                  DTSCS12
02129 *    PERFORM S5920-ATTRIBUTES THRU S5920-EXIT.                    DTSCS12
02130      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS12
02131      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS12
02132      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS12
02133      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS12
02134                                                                   DTSCS12
02135      IF SCR-ACCESS-UPDATE                                         DTSCS12
02136          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS12
02137      ELSE                                                         DTSCS12
02138          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS12
02139                                                                   DTSCS12
02140      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS12
02141                                                                   DTSCS12
02142      IF CURSOR-SET-NO                                             DTSCS12
02143          MOVE CATB-CURSOR TO MAP-EMP-NAME-L.                      DTSCS12
02144                                                                   DTSCS12
02145      SET L851-SEND-88 TO TRUE.                                    DTSCS12
02146                                                                   DTSCS12
02147      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS12
02148                                                                   DTSCS12
02149      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS12
02150  S9300-EXIT.                                                      DTSCS12
02151      EXIT.                                                        DTSCS12
02152                                                                   DTSCS12
02153  S9310-UPDATE-FKEYS.                                              DTSCS12
02154      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS12
02155                                                                   DTSCS12
02156  S9310-EXIT.                                                      DTSCS12
02157      EXIT.                                                        DTSCS12
02158                                                                   DTSCS12
02159  S9320-INQUIRY-FKEYS.                                             DTSCS12
02160      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS12
02161      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS12
02162      MOVE CFKD-NEW-SEARCH TO MAP-KEY-NEW-SEARCH.                  DTSCS12
02163  S9320-EXIT.                                                      DTSCS12
02164      EXIT.                                                        DTSCS12
02165                                                                   DTSCS12
02166  S9900-PREPARE-SEND.                                              DTSCS12
02167      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS12
02168                         LCCM-SCR-ID.                              DTSCS12
02169      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS12
02170      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS12
02171  S9900-EXIT.                                                      DTSCS12
02172      EXIT.                                                        DTSCS12
