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