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