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