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