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