00001  IDENTIFICATION DIVISION.                                         01/28/05
00002  PROGRAM-ID.             DTSCS85.                                 DTSCS85
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV020
00004  DATE-WRITTEN.           SEPTEMBER 1998.                          DTSCS85
00005  DATE-COMPILED.                                                   DTSCS85
00006      SKIP3                                                        DTSCS85
00007 *****                                                             DTSCS85
00008 *    FUNCTION:  FIELD REPRESENTATIVE TERRITORY INQUIRY/UPDATE     DTSCS85
00009 *               SCREEN PROCESSOR.                                 DTSCS85
00010 *                                                                 DTSCS85
00011 *                                                                 DTSCS85
00012 *   ****** NOTE ******* NOTE ******* NOTE ******* NOTE ******     DTSCS85
00013 *                                                                 DTSCS85
00014 *   09/1998: ALL REFERENCES TO FINALIST COMMENTED OUT UNTIL       DTSCS85
00015 *            FINALIST BECOMES AVAILABLE -- GD                     DTSCS85
00016 *                                                                 DTSCS85
00017 *   THIS COMPILE NEEDS                                            DTSCS85
00018 *                                                                 DTSCS85
00019 *     //LINK.SYSLIB DD                                            DTSCS85
00020 *     //            DD                                            DTSCS85
00021 *     //            DD                                            DTSCS85
00022 *     //            DD                                            DTSCS85
00023 *     //            DD                                            DTSCS85
00024 *     //            DD                                            DTSCS85
00025 *     //            DD DSN=CICS.FIN720.LOADLIB.ONLINE,DISP=SHR    DTSCS85
00026 *                                                                 DTSCS85
00027 *     AND                                                         DTSCS85
00028 *                                                                 DTSCS85
00029 *     //        PARM.LINK='LIST,XREF,LET,AMODE(31),RMODE(ANY)',   DTSCS85
00030 *                                                                 DTSCS85
00031 *                                                                 DTSCS85
00032 *                                                                 DTSCS85
00033 *    VERIFY THAT .V720. IS THE CURRENT FINALIST LIBRARY           DTSCS85
00034 *                                                                 DTSCS85
00035 *   ****** NOTE ******* NOTE ******* NOTE ******* NOTE ******     DTSCS85
00036 *                                                                 DTSCS85
00037 *                                                                 DTSCS85
00038 *    MODIFICATION LOG:                                            DTSCS85
00039 *                                                                 DTSCS85
00040 *    09/25/1998  INITIAL DEVELOPMENT. MODIFIED FROM MACCS85.      DTSCS85
00041 *                WORK ORDER:                      PROGRAMMER: GD  DTSCS85
00042 *                                                                 DTSCS85
00043 *    09/22/2000  RECOMPILED FOR NEW VERSION(R720) OF FINALIST.    DTSCS85
00044 *                WORK ORDER:                      PROGRAMMER: ZL1 DTSCS85
00045 *                                                                 DTSCS85
00046 *    01/27/2005  ADDED CANADA (CD) AS A VALID US TERRITORY        DTSCS85
00047 *                WORK ORDER: DC MAINT             PROGRAMMER: ZL1 DTSCS85
00048 *                                                                 DTSCS85
00049 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85
00050 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85
00051 *                WORK ORDER:                      PROGRAMMER: XXX DTSCS85
00052 *                                                                 DTSCS85
00053 *                                                                 DTSCS85
00054 *  DESCRIPTION:                                                   DTSCS85
00055 *                                                                 DTSCS85
00056 *    CLEAR:                                                       DTSCS85
00057 *                                                                 DTSCS85
00058 *      DATA FIELDS DISPLAYED: NONE.                               DTSCS85
00059 *      MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL").            DTSCS85
00060 *      MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA.                      DTSCS85
00061 *                                                                 DTSCS85
00062 *                                                                 DTSCS85
00063 *    INQUIRY:                                                     DTSCS85
00064 *                                                                 DTSCS85
00065 *      CONTROL FIELD(S): FLD-TERRITORY                            DTSCS85
00066 *                                                                 DTSCS85
00067 *      JUMP IN: USE CLEAR LOGIC.                                  DTSCS85
00068 *                                                                 DTSCS85
00069 *      ENTER: DISPLAY FFAZ RECORD ASSOCIATED WITH THE CONTROL     DTSCS85
00070 *             FIELDS.                                             DTSCS85
00071 *                                                                 DTSCS85
00072 *      PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER         DTSCS85
00073 *             MODIFICATION TO CONTROL FIELDS (RATHER THAN         DTSCS85
00074 *             EMP-NO).                                            DTSCS85
00075 *                                                                 DTSCS85
00076 *      NEXT:  STANDARD PAGING LOGIC, EXCEPT BASED ON USER         DTSCS85
00077 *             MODIFICATION TO CONTROL FIELDS (RATHER THAN         DTSCS85
00078 *             EMP-NO).                                            DTSCS85
00079 *                                                                 DTSCS85
00080 *      WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS85
00081 *      DO NOT "WRAP" PAGING.                                      DTSCS85
00082 *                                                                 DTSCS85
00083 *      A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE             DTSCS85
00084 *      FFAZ-KEY-AREA OF THE DISPLAYED FFAZ RECORD IN              DTSCS85
00085 *      LCCM-SCR-KEY-AREA.                                         DTSCS85
00086 *                                                                 DTSCS85
00087 *                                                                 DTSCS85
00088 *    UPDATE:                                                      DTSCS85
00089 *                                                                 DTSCS85
00090 *      ADD                                                        DTSCS85
00091 *      MOD                                                        DTSCS85
00092 *      DEL                                                        DTSCS85
00093 *                                                                 DTSCS85
00094 *                                                                 DTSCS85
00095 *    RECORDS READ:                                                DTSCS85
00096 *                                                                 DTSCS85
00097 *      MASTER:                                                    DTSCS85
00098 *                                                                 DTSCS85
00099 *        NONE.                                                    DTSCS85
00100 *                                                                 DTSCS85
00101 *                                                                 DTSCS85
00102 *      ALTERNATE INDEX:                                           DTSCS85
00103 *                                                                 DTSCS85
00104 *        NONE.                                                    DTSCS85
00105 *                                                                 DTSCS85
00106 *                                                                 DTSCS85
00107 *      REFERENCE:                                                 DTSCS85
00108 *                                                                 DTSCS85
00109 *        FFAZ.                                                    DTSCS85
00110 *                                                                 DTSCS85
00111 *                                                                 DTSCS85
00112 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS85
00113 *                                                                 DTSCS85
00114 *        NONE.                                                    DTSCS85
00115 *                                                                 DTSCS85
00116 *                                                                 DTSCS85
00117 *    RECORDS UPDATED:                                             DTSCS85
00118 *                                                                 DTSCS85
00119 *      MASTER:                                                    DTSCS85
00120 *                                                                 DTSCS85
00121 *        NONE.                                                    DTSCS85
00122 *                                                                 DTSCS85
00123 *                                                                 DTSCS85
00124 *      REFERENCE:                                                 DTSCS85
00125 *                                                                 DTSCS85
00126 *        FFAZ (ADD, MOD, DEL).                                    DTSCS85
00127 *                                                                 DTSCS85
00128 *                                                                 DTSCS85
00129 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS85
00130 *                                                                 DTSCS85
00131 *        NONE.                                                    DTSCS85
00132 *                                                                 DTSCS85
00133 *                                                                 DTSCS85
00134 *    ON-LINE EVENT FILE RECORDS WRITTEN:                          DTSCS85
00135 *                                                                 DTSCS85
00136 *      NONE.                                                      DTSCS85
00137 *                                                                 DTSCS85
00138 *                                                                 DTSCS85
00139 *    MODULES (OTHER THAN STANDARD SCREEN PROCESSING               DTSCS85
00140 *    UTILITY MODULES) LINKED TO:                                  DTSCS85
00141 *                                                                 DTSCS85
00142 *      DTSCU001 DATE EDIT/CONVERSION.                             DTSCS85
00143 *      DTSCU062 FIELD REP ID EDIT/DESCRIPTION.                    DTSCS85
00144 *      DTSCU831 REFERENCE FILE I/O.                               DTSCS85
00145 *                                                                 DTSCS85
00146 *                                                                 DTSCS85
00147 *    MAINTENANCE NOTES:                                           DTSCS85
00148 *                                                                 DTSCS85
00149 *      A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN        DTSCS85
00150 *      REQUIRES ATTENTION IN THE FOLLOWING AREAS:                 DTSCS85
00151 *        ALTER PARAGRAPHS P6900, P8900, S5900,                    DTSCS85
00152 *        ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002,         DTSCS85
00153 *        ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS85),        DTSCS85
00154 *        ALTER THE MAP (DTSM85) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS85
00155 *                                                                 DTSCS85
00156 *****                                                             DTSCS85
00157      SKIP3                                                        DTSCS85
00158  ENVIRONMENT DIVISION.                                            DTSCS85
00159      SKIP3                                                        DTSCS85
00160  DATA DIVISION.                                                   DTSCS85
00161      SKIP3                                                        DTSCS85
00162  WORKING-STORAGE SECTION.                                         DTSCS85
001625 77  PAN-VALET PICTURE X(24) VALUE '020DTSCS85   01/28/05'.       DTSCS85
00163      SKIP3                                                        DTSCS85
00164  01  WRK-AREA.                                                    DTSCS85
00165      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S85 '.    DTSCS85
00166      SKIP1                                                        DTSCS85
00167      05  WRK-SCR-ID.                                              DTSCS85
00168          10  WRK-SCR-ID-9            PIC  9(02)  VALUE  85.       DTSCS85
00169      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '80'.      DTSCS85
00170      SKIP1                                                        DTSCS85
00171      05  WRK-KEY-AREA.                                            DTSCS85
00172          10  WRK-REC-TYPE            PIC S9(04)  COMP.            DTSCS85
00173          10  WRK-FLD-TERRITORY       PIC  X(05).                  DTSCS85
00174          10  FILLER                  PIC  X(09).                  DTSCS85
00175      SKIP1                                                        DTSCS85
00176      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS85
00177      SKIP1                                                        DTSCS85
00178      05  WRK-HOLD-TERRITORY          PIC  X(05).                  DTSCS85
00179      SKIP1                                                        DTSCS85
00180      SKIP1                                                        DTSCS85
00181  01  MSG-LITERALS.                                                DTSCS85
00182      05  MSG-E851-AREA.                                           DTSCS85
00183          10  FILLER     PIC  X(04)  VALUE 'E851'.                 DTSCS85
00184          10  FILLER     PIC  X(60)                                DTSCS85
00185       VALUE 'EITHER ONE OR TEN ENTRIES REQUIRED'.                 DTSCS85
00186      EJECT                                                        DTSCS85
00187  01  SCREEN-CONTROL.                                              DTSCS85
00188      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS85
00189          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS85
00190          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS85
00191      SKIP1                                                        DTSCS85
00192      05  CURSOR-SET-IND              PIC X(01).                   DTSCS85
00193          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS85
00194          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS85
00195          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS85
00196      SKIP1                                                        DTSCS85
00197      05  REQ-IND                     PIC X(01).                   DTSCS85
00198          88  REQ-ERROR                       VALUE 'O'.           DTSCS85
00199          88  REQ-JUMP                        VALUE 'J'.           DTSCS85
00200          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS85
00201          88  REQ-CLEAR                       VALUE 'C'.           DTSCS85
00202          88  REQ-EDIT                        VALUE 'E'.           DTSCS85
00203          88  REQ-UPDATE                      VALUE 'U'.           DTSCS85
00204          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS85
00205      SKIP1                                                        DTSCS85
00206      05  RESP-IND                    PIC X(01).                   DTSCS85
00207          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS85
00208          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS85
00209          88  RESP-JUMP                       VALUE 'J'.           DTSCS85
00210          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS85
00211      SKIP1                                                        DTSCS85
00212      05  SCR-NEW-KEY-IND             PIC  X(01).                  DTSCS85
00213      SKIP1                                                        DTSCS85
00214      05  SCR-ATB-AN               PIC  X(01).                     DTSCS85
00215      05  SCR-ATB-NUM                 PIC  X(01).                  DTSCS85
00216      EJECT                                                        DTSCS85
00217  01  LPAM-DUMMY-COMMAREA           PIC X(01).                     DTSCS85
00218                                                                   DTSCS85
00219  01  LPAM-FUNCTIONS.                                              DTSCS85
00220      05  LPAM-INIT-FUNCTION        PIC X(08)  VALUE 'INIT    '.   DTSCS85
00221      05  LPAM-OPEN-FUNCTION        PIC X(08)  VALUE 'OPEN    '.   DTSCS85
00222      05  LPAM-GETZIP-FUNCTION      PIC X(08)  VALUE 'GETZIP  '.   DTSCS85
00223      05  LPAM-CLOSE-FUNCTION       PIC X(08)  VALUE 'CLOSE   '.   DTSCS85
00224      05  LPAM-TERM-FUNCTION        PIC X(08)  VALUE 'TERM    '.   DTSCS85
00225                                                                   DTSCS85
00226  01  LPAM-ANCHOR-AREA              PIC X(04).                     DTSCS85
00227                                                                   DTSCS85
00228  01  LPAM-RETURN-CODE              PIC X(02).                     DTSCS85
00229                                                                   DTSCS85
00230  01  LPAM-ERROR-AREA.                                             DTSCS85
00231      05  LPAM-ERROR-MODULE         PIC X(08).                     DTSCS85
00232      05  FILLER                    PIC X(01).                     DTSCS85
00233      05  LPAM-ERROR-FUNCTION       PIC X(08).                     DTSCS85
00234      05  FILLER                    PIC X(01).                     DTSCS85
00235      05  ERROR-RETURN-CODES.                                      DTSCS85
00236          10  ERROR-RETURN-CODE OCCURS 17 TIMES                    DTSCS85
00237                                INDEXED BY ERROR-RETURN-IDX        DTSCS85
00238                                    PIC X(01).                     DTSCS85
00239      05  FILLER                    PIC X(01).                     DTSCS85
00240      05  ERROR-MESSAGE             PIC X(44).                     DTSCS85
00241                                                                   DTSCS85
00242  01  LPAM-STREET-FILE-RCB          PIC X(08).                     DTSCS85
00243                                                                   DTSCS85
00244  01  LPAM-NAMES.                                                  DTSCS85
00245      05  LPAM-MODULE-NAME          PIC X(08)  VALUE 'LPAMC   '.   DTSCS85
00246      05  LPAM-PROFILE-NAME         PIC X(08)  VALUE '        '.   DTSCS85
00247      05  LPAM-PRODUCT-NAME         PIC X(08)  VALUE 'BACCMETH'.   DTSCS85
00248      05  LPAM-STREET-FILE-NAME     PIC X(08)  VALUE 'CBDATA  '.   DTSCS85
00249      05  LPAM-CITY-FILE-NAME       PIC X(08)  VALUE 'CBCTYST '.   DTSCS85
00250                                                                   DTSCS85
00251  ++INCLUDE LPAM007C                                               DTSCS85
00252      SKIP3                                                        DTSCS85
00253  ++INCLUDE LPAM008C                                               DTSCS85
00254      EJECT                                                        DTSCS85
00255  01  L001-COMM-AREA.                                              DTSCS85
00256  ++INCLUDE DTSIL001                                               DTSCS85
00257      EJECT                                                        DTSCS85
00258  01  L062-COMM-AREA.                                              DTSCS85
00259  ++INCLUDE DTSIL062                                               DTSCS85
00260      EJECT                                                        DTSCS85
00261 * ERROR MSG MODULE                                                DTSCS85
00262  01  L805-COMM-AREA.                                              DTSCS85
00263  ++INCLUDE DTSIL805                                               DTSCS85
00264      EJECT                                                        DTSCS85
00265 * STATE POSTAL CODES                                              DTSCS85
00266  01  STATE-POSTAL-CODES.                                          DTSCS85
00267  ++INCLUDE DTSIC072                                               DTSCS85
00268      EJECT                                                        DTSCS85
00269 * REFERENCE FILE I-O LINKAGE                                      DTSCS85
00270  01  L831-COMM-AREA.                                              DTSCS85
00271      05  L831-CONTROL-BLOCK.                                      DTSCS85
00272  ++INCLUDE DTSIL831                                               DTSCS85
00273      EJECT                                                        DTSCS85
00274 * COMMON SKELETAL RECORD                                          DTSCS85
00275      05  FCOMM-REC.                                               DTSCS85
00276  ++INCLUDE DTSIFSKL                                               DTSCS85
00277      SKIP3                                                        DTSCS85
00278 * FIELD REP TERRITORY RECORD LAYOUT                               DTSCS85
00279      05  FFAZ-REC REDEFINES FCOMM-REC.                            DTSCS85
00280  ++INCLUDE DTSIFFAZ                                               DTSCS85
00281      EJECT                                                        DTSCS85
00282 * MAP DEFINITION                                                  DTSCS85
00283  01  L851-COMM-AREA.                                              DTSCS85
00284  ++INCLUDE DTSIL851                                               DTSCS85
00285      SKIP3                                                        DTSCS85
00286      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS85
00287  ++INCLUDE DTSIS85                                                DTSCS85
00288      EJECT                                                        DTSCS85
00289 * ATTRIBUTE LITERALS                                              DTSCS85
00290  01  CATB-LITERALS.                                               DTSCS85
00291  ++INCLUDE DTSICATB                                               DTSCS85
00292      SKIP3                                                        DTSCS85
00293 * FUNCTION KEY DESCRIPTION LITERALS                               DTSCS85
00294  01  CFKD-LITERALS.                                               DTSCS85
00295  ++INCLUDE DTSICFKD                                               DTSCS85
00296      EJECT                                                        DTSCS85
00297 * ERROR CODE MESSAGE LITERALS                                     DTSCS85
00298  01  CECD-LITERALS.                                               DTSCS85
00299  ++INCLUDE DTSICECD                                               DTSCS85
00300      SKIP3                                                        DTSCS85
00301 * PROMPT CODE MESSAGE LITERALS                                    DTSCS85
00302  01  CPCD-LITERALS.                                               DTSCS85
00303  ++INCLUDE DTSICPCD                                               DTSCS85
00304      EJECT                                                        DTSCS85
00305  LINKAGE SECTION.                                                 DTSCS85
00306      SKIP3                                                        DTSCS85
00307  01  DFHCOMMAREA.                                                 DTSCS85
00308  ++INCLUDE DTSILCCM                                               DTSCS85
00309      SKIP3                                                        DTSCS85
00310              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS85
00311                  20  LCCM-SCR-KEY-AREA   PIC  X(16).              DTSCS85
00312      EJECT                                                        DTSCS85
00313 ******************************************************************DTSCS85
00314 *                                                                *DTSCS85
00315 ******************************************************************DTSCS85
00316      SKIP1                                                        DTSCS85
00317  PROCEDURE DIVISION.                                              DTSCS85
00318      SKIP2                                                        DTSCS85
00319      SET CURSOR-SET-NO TO TRUE.                                   DTSCS85
00320      SKIP1                                                        DTSCS85
00321      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS85
00322      SKIP1                                                        DTSCS85
00323      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9)                  DTSCS85
00324        TO SCR-ACCESS-IND.                                         DTSCS85
00325      SKIP3                                                        DTSCS85
00326      MOVE SPACE TO REQ-IND.                                       DTSCS85
00327      SKIP1                                                        DTSCS85
00328      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS85
00329      SKIP1                                                        DTSCS85
00330 *-----------------------------------------------------            DTSCS85
00331 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS85
00332 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS85
00333 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS85
00334 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS85
00335 *                                                                 DTSCS85
00336 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS85
00337 *    PROCESSED.                                                   DTSCS85
00338 *                                                                 DTSCS85
00339 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS85
00340 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS85
00341 *    WORK STATION OPERATOR.                                       DTSCS85
00342 *-----------------------------------------------------            DTSCS85
00343      SKIP1                                                        DTSCS85
00344      MOVE SPACE TO RESP-IND.                                      DTSCS85
00345      SKIP1                                                        DTSCS85
00346      IF REQ-ERROR                                                 DTSCS85
00347         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS85
00348      ELSE                                                         DTSCS85
00349      IF REQ-JUMP                                                  DTSCS85
00350         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS85
00351      ELSE                                                         DTSCS85
00352      IF REQ-CLEAR                                                 DTSCS85
00353         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS85
00354      ELSE                                                         DTSCS85
00355      IF REQ-CURSOR-TO-GOTO                                        DTSCS85
00356         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS85
00357      ELSE                                                         DTSCS85
00358      IF REQ-INQUIRE                                               DTSCS85
00359         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS85
00360      ELSE                                                         DTSCS85
00361      IF REQ-EDIT                                                  DTSCS85
00362         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS85
00363      ELSE                                                         DTSCS85
00364      IF REQ-UPDATE                                                DTSCS85
00365         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS85
00366      ELSE                                                         DTSCS85
00367         GO TO S899-ABEND.                                         DTSCS85
00368      SKIP3                                                        DTSCS85
00369 *-----------------------------------------------------            DTSCS85
00370 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS85
00371 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS85
00372 *-----------------------------------------------------            DTSCS85
00373      SKIP1                                                        DTSCS85
00374      IF RESP-SEND-MAP                                             DTSCS85
00375          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS85
00376          SET LCCM-END-TASK-88 TO TRUE                             DTSCS85
00377      ELSE                                                         DTSCS85
00378      IF RESP-SEND-MSGONLY                                         DTSCS85
00379      OR RESP-CURSOR-TO-GOTO                                       DTSCS85
00380          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS85
00381          SET LCCM-END-TASK-88 TO TRUE                             DTSCS85
00382      ELSE                                                         DTSCS85
00383      IF RESP-JUMP                                                 DTSCS85
00384          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS85
00385      ELSE                                                         DTSCS85
00386          GO TO S899-ABEND.                                        DTSCS85
00387      SKIP3                                                        DTSCS85
00388  MAINLINE-EXIT.                                                   DTSCS85
00389      SKIP1                                                        DTSCS85
00390      EXEC CICS                                                    DTSCS85
00391          RETURN                                                   DTSCS85
00392      END-EXEC.                                                    DTSCS85
00393      SKIP2                                                        DTSCS85
00394 *    GOBACK.                                                      DTSCS85
00395 /*****************************************************************DTSCS85
00396 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS85
00397 ******************************************************************DTSCS85
00398  P1000-ANALYZE-REQUEST.                                           DTSCS85
00399      SKIP1                                                        DTSCS85
00400 *-----------------------------------------------------            DTSCS85
00401 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS85
00402 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS85
00403 *     REPLACED WITH ENTER)                                        DTSCS85
00404 *-----------------------------------------------------            DTSCS85
00405      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS85
00406         SET LCCM-ENTER-88 TO TRUE                                 DTSCS85
00407         SET REQ-CLEAR TO TRUE                                     DTSCS85
00408         GO TO P1000-EXIT.                                         DTSCS85
00409      SKIP3                                                        DTSCS85
00410 *-----------------------------------------------------            DTSCS85
00411 *      MAP IS RECEIVED                                            DTSCS85
00412 *-----------------------------------------------------            DTSCS85
00413      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS85
00414      SKIP3                                                        DTSCS85
00415 *-----------------------------------------------------            DTSCS85
00416 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS85
00417 *    WORK STATION                                                 DTSCS85
00418 *-----------------------------------------------------            DTSCS85
00419      IF LCCM-CLEAR-88                                             DTSCS85
00420         SET REQ-CLEAR TO TRUE                                     DTSCS85
00421         GO TO P1000-EXIT.                                         DTSCS85
00422      SKIP3                                                        DTSCS85
00423 *-----------------------------------------------------            DTSCS85
00424 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS85
00425 *-----------------------------------------------------            DTSCS85
00426      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS85
00427         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS85
00428         GO TO P1000-EXIT.                                         DTSCS85
00429      SKIP3                                                        DTSCS85
00430 *-----------------------------------------------------            DTSCS85
00431 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS85
00432 *-----------------------------------------------------            DTSCS85
00433      IF LCCM-PA2-88                                               DTSCS85
00434          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS85
00435          GO TO P1000-EXIT.                                        DTSCS85
00436      SKIP3                                                        DTSCS85
00437 *-----------------------------------------------------            DTSCS85
00438 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS85
00439 *-----------------------------------------------------            DTSCS85
00440      IF LCCM-PA-88                                                DTSCS85
00441        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS85
00442        SET REQ-ERROR TO TRUE                                      DTSCS85
00443        GO TO P1000-EXIT.                                          DTSCS85
00444      SKIP3                                                        DTSCS85
00445 *-----------------------------------------------------            DTSCS85
00446 *    F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A                 DTSCS85
00447 *    REQUEST TO CLEAR THE SCREEN.                                 DTSCS85
00448 *-----------------------------------------------------            DTSCS85
00449      IF LCCM-F12-88                                               DTSCS85
00450         MOVE LOW-VALUES TO MAP-AREA                               DTSCS85
00451         SET REQ-CLEAR TO TRUE                                     DTSCS85
00452         GO TO P1000-EXIT.                                         DTSCS85
00453      SKIP3                                                        DTSCS85
00454 *-----------------------------------------------------            DTSCS85
00455 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS85
00456 *-----------------------------------------------------            DTSCS85
00457      IF LCCM-F03-88                                               DTSCS85
00458         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS85
00459         SET REQ-JUMP TO TRUE                                      DTSCS85
00460         GO TO P1000-EXIT.                                         DTSCS85
00461      SKIP3                                                        DTSCS85
00462 *-----------------------------------------------------            DTSCS85
00463 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS85
00464 *-----------------------------------------------------            DTSCS85
00465      IF LCCM-F04-88                                               DTSCS85
00466         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS85
00467         SET REQ-JUMP TO TRUE                                      DTSCS85
00468         GO TO P1000-EXIT.                                         DTSCS85
00469      SKIP3                                                        DTSCS85
00470 *-----------------------------------------------------            DTSCS85
00471 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS85
00472 *    CORRESPONDENCE SCREEN                                        DTSCS85
00473 *-----------------------------------------------------            DTSCS85
00474      IF LCCM-F14-88                                               DTSCS85
00475         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS85
00476         SET REQ-JUMP TO TRUE                                      DTSCS85
00477         GO TO P1000-EXIT.                                         DTSCS85
00478      SKIP3                                                        DTSCS85
00479 *-----------------------------------------------------            DTSCS85
00480 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS85
00481 *    REQUESTED SCREEN TYPE                                        DTSCS85
00482 *-----------------------------------------------------            DTSCS85
00483      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS85
00484         NEXT SENTENCE                                             DTSCS85
00485      ELSE                                                         DTSCS85
00486        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS85
00487        SET REQ-JUMP TO TRUE                                       DTSCS85
00488        GO TO P1000-EXIT.                                          DTSCS85
00489      SKIP3                                                        DTSCS85
00490 *-----------------------------------------------------            DTSCS85
00491 *    IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL)                DTSCS85
00492 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS85
00493 *-----------------------------------------------------            DTSCS85
00494      IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88                 DTSCS85
00495         IF SCR-ACCESS-UPDATE                                      DTSCS85
00496            SET REQ-EDIT TO TRUE                                   DTSCS85
00497            GO TO P1000-EXIT                                       DTSCS85
00498         ELSE                                                      DTSCS85
00499            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS85
00500            SET REQ-ERROR TO TRUE                                  DTSCS85
00501            GO TO P1000-EXIT.                                      DTSCS85
00502      SKIP3                                                        DTSCS85
00503 *-----------------------------------------------------            DTSCS85
00504 *    IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN,               DTSCS85
00505 *          PAGE UP), INDICATE INQUIRY REQUEST                     DTSCS85
00506 *-----------------------------------------------------            DTSCS85
00507      IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88               DTSCS85
00508          SET REQ-INQUIRE TO TRUE                                  DTSCS85
00509          GO TO P1000-EXIT.                                        DTSCS85
00510      SKIP3                                                        DTSCS85
00511 *-----------------------------------------------------            DTSCS85
00512 *     ANY OTHER KEY IS INVALID                                    DTSCS85
00513 *-----------------------------------------------------            DTSCS85
00514      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS85
00515      SET REQ-ERROR TO TRUE.                                       DTSCS85
00516  P1000-EXIT.                                                      DTSCS85
00517      EXIT.                                                        DTSCS85
00518      SKIP3                                                        DTSCS85
00519 ******************************************************************DTSCS85
00520 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS85
00521 ******************************************************************DTSCS85
00522      SKIP1                                                        DTSCS85
00523  P1100-UPDATE-LOCKED.                                             DTSCS85
00524 *-----------------------------------------------------            DTSCS85
00525 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS85
00526 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS85
00527 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS85
00528 *-----------------------------------------------------            DTSCS85
00529      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS85
00530         SET REQ-UPDATE TO TRUE                                    DTSCS85
00531      ELSE                                                         DTSCS85
00532         SET REQ-ERROR TO TRUE                                     DTSCS85
00533         IF LCCM-SCR-ADD-LOCKED                                    DTSCS85
00534            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS85
00535         ELSE                                                      DTSCS85
00536         IF LCCM-SCR-MOD-LOCKED                                    DTSCS85
00537            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS85
00538         ELSE                                                      DTSCS85
00539         IF LCCM-SCR-DEL-LOCKED                                    DTSCS85
00540            MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID                   DTSCS85
00541         ELSE                                                      DTSCS85
00542            GO TO S899-ABEND.                                      DTSCS85
00543  P1100-EXIT.                                                      DTSCS85
00544      EXIT.                                                        DTSCS85
00545 /*****************************************************************DTSCS85
00546 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS85
00547 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS85
00548 ******************************************************************DTSCS85
00549      SKIP1                                                        DTSCS85
00550  P2000-REQUEST-ERROR.                                             DTSCS85
00551      IF LCCM-MSG                                                  DTSCS85
00552         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS85
00553      ELSE                                                         DTSCS85
00554         GO TO S899-ABEND.                                         DTSCS85
00555  P2000-EXIT.                                                      DTSCS85
00556      EXIT.                                                        DTSCS85
00557 /*****************************************************************DTSCS85
00558 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS85
00559 ******************************************************************DTSCS85
00560      SKIP1                                                        DTSCS85
00561  P3000-REQUEST-JUMP.                                              DTSCS85
00562 *-----------------------------------------------------            DTSCS85
00563 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS85
00564 *    BY USER                                                      DTSCS85
00565 *-----------------------------------------------------            DTSCS85
00566      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS85
00567      SKIP3                                                        DTSCS85
00568 *-----------------------------------------------------            DTSCS85
00569 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS85
00570 *-----------------------------------------------------            DTSCS85
00571      IF LCCM-MSG                                                  DTSCS85
00572         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS85
00573         SET CURSOR-SET-GOTO TO TRUE                               DTSCS85
00574         GO TO P3000-EXIT.                                         DTSCS85
00575      SKIP3                                                        DTSCS85
00576 *-----------------------------------------------------            DTSCS85
00577 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS85
00578 *-----------------------------------------------------            DTSCS85
00579      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS85
00580                         LCCM-SCR-HOLD-AREA.                       DTSCS85
00581      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS85
00582      SET RESP-JUMP TO TRUE.                                       DTSCS85
00583  P3000-EXIT.                                                      DTSCS85
00584      EXIT.                                                        DTSCS85
00585 /*****************************************************************DTSCS85
00586 * CLEAR KEY WAS PRESSED                                          *DTSCS85
00587 ******************************************************************DTSCS85
00588      SKIP1                                                        DTSCS85
00589  P4000-REQUEST-CLEAR.                                             DTSCS85
00590      IF SCR-ACCESS-UPDATE                                         DTSCS85
00591         PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT            DTSCS85
00592      ELSE                                                         DTSCS85
00593         PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.              DTSCS85
00594      SKIP3                                                        DTSCS85
00595 *-----------------------------------------------------            DTSCS85
00596 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS85
00597 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS85
00598 *-----------------------------------------------------            DTSCS85
00599      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS85
00600      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS85
00601      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS85
00602      SET RESP-SEND-MAP TO TRUE.                                   DTSCS85
00603  P4000-EXIT.                                                      DTSCS85
00604      EXIT.                                                        DTSCS85
00605 /*****************************************************************DTSCS85
00606 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS85
00607 ******************************************************************DTSCS85
00608      SKIP1                                                        DTSCS85
00609  P5000-CURSOR-TO-GOTO.                                            DTSCS85
00610      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS85
00611      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS85
00612  P5000-EXIT.                                                      DTSCS85
00613      EXIT.                                                        DTSCS85
00614 /*****************************************************************DTSCS85
00615 * INQUIRY WAS REQUESTED                                          *DTSCS85
00616 ******************************************************************DTSCS85
00617      SKIP1                                                        DTSCS85
00618  P6000-REQUEST-INQUIRE.                                           DTSCS85
00619      MOVE LOW-VALUES TO FFAZ-KEY-AREA.                            DTSCS85
00620      SET FFAZ-FAZ-88 TO TRUE.                                     DTSCS85
00621      SKIP1                                                        DTSCS85
00622      MOVE MAP-TERRITORY TO WRK-HOLD-TERRITORY.                    DTSCS85
00623      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS85
00624      MOVE WRK-HOLD-TERRITORY TO MAP-TERRITORY.                    DTSCS85
00625      SKIP1                                                        DTSCS85
00626      INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE.         DTSCS85
00627      MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY.                    DTSCS85
00628      SKIP1                                                        DTSCS85
00629      IF  LCCM-SCR-INQUIRE                                         DTSCS85
00630      AND FFAZ-KEY-AREA = LCCM-SCR-KEY-AREA                        DTSCS85
00631          MOVE 'N' TO SCR-NEW-KEY-IND                              DTSCS85
00632      ELSE                                                         DTSCS85
00633          MOVE 'Y' TO SCR-NEW-KEY-IND.                             DTSCS85
00634      SKIP1                                                        DTSCS85
00635      IF SCR-ACCESS-UPDATE                                         DTSCS85
00636          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS85
00637      ELSE                                                         DTSCS85
00638          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS85
00639      SKIP1                                                        DTSCS85
00640      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS85
00641      MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA.                        DTSCS85
00642      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS85
00643      SKIP1                                                        DTSCS85
00644      IF LCCM-MSG                                                  DTSCS85
00645          NEXT SENTENCE                                            DTSCS85
00646      ELSE                                                         DTSCS85
00647      IF LCCM-ENTER-88                                             DTSCS85
00648          PERFORM P6100-NO-PAGE THRU P6100-EXIT                    DTSCS85
00649      ELSE                                                         DTSCS85
00650      IF LCCM-F07-88                                               DTSCS85
00651          PERFORM P6200-PAGE-BACK THRU P6200-EXIT                  DTSCS85
00652      ELSE                                                         DTSCS85
00653      IF LCCM-F08-88                                               DTSCS85
00654          PERFORM P6300-PAGE-NEXT THRU P6300-EXIT                  DTSCS85
00655      ELSE                                                         DTSCS85
00656          GO TO S899-ABEND.                                        DTSCS85
00657      SKIP1                                                        DTSCS85
00658      SET RESP-SEND-MAP TO TRUE.                                   DTSCS85
00659  P6000-EXIT.                                                      DTSCS85
00660      EXIT.                                                        DTSCS85
00661      EJECT                                                        DTSCS85
00662  P6100-NO-PAGE.                                                   DTSCS85
00663      IF MAP-TERRITORY = SPACE                                     DTSCS85
00664          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS85
00665          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS85
00666          GO TO P6100-EXIT.                                        DTSCS85
00667      SKIP1                                                        DTSCS85
00668      PERFORM S831-READ THRU S831-EXIT.                            DTSCS85
00669      IF L831-NO-REC-88                                            DTSCS85
00670          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS85
00671          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS85
00672          GO TO P6100-EXIT.                                        DTSCS85
00673      SKIP1                                                        DTSCS85
00674      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS85
00675  P6100-EXIT.                                                      DTSCS85
00676      EXIT.                                                        DTSCS85
00677      EJECT                                                        DTSCS85
00678  P6200-PAGE-BACK.                                                 DTSCS85
00679      MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA.                          DTSCS85
00680      PERFORM S831-START-BROWSE THRU S831-EXIT.                    DTSCS85
00681      IF L831-NO-REC-88                                            DTSCS85
00682          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS85
00683          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS85
00684          GO TO P6200-EXIT.                                        DTSCS85
00685      SKIP1                                                        DTSCS85
00686      IF (SCR-NEW-KEY-IND = 'Y')                                   DTSCS85
00687           AND                                                     DTSCS85
00688         (WRK-KEY-AREA = FFAZ-KEY-AREA)                            DTSCS85
00689          PERFORM S831-END-BROWSE THRU S831-EXIT                   DTSCS85
00690          PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT           DTSCS85
00691          GO TO P6200-EXIT.                                        DTSCS85
00692      SKIP1                                                        DTSCS85
00693      PERFORM S831-READ-PREV THRU S831-EXIT.                       DTSCS85
00694      IF L831-NO-REC-88                                            DTSCS85
00695          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS85
00696          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS85
00697          GO TO P6200-EXIT.                                        DTSCS85
00698      SKIP1                                                        DTSCS85
00699      PERFORM S831-READ-PREV THRU S831-EXIT.                       DTSCS85
00700      IF L831-NO-REC-88                                            DTSCS85
00701          PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT           DTSCS85
00702          MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID                      DTSCS85
00703      ELSE                                                         DTSCS85
00704          PERFORM S831-END-BROWSE THRU S831-EXIT                   DTSCS85
00705          PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.          DTSCS85
00706  P6200-EXIT.                                                      DTSCS85
00707      EXIT.                                                        DTSCS85
00708      EJECT                                                        DTSCS85
00709  P6300-PAGE-NEXT.                                                 DTSCS85
00710      MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA.                          DTSCS85
00711      PERFORM S831-START-BROWSE THRU S831-EXIT.                    DTSCS85
00712      IF L831-NO-REC-88                                            DTSCS85
00713          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS85
00714          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS85
00715          GO TO P6300-EXIT.                                        DTSCS85
00716      SKIP1                                                        DTSCS85
00717      IF (SCR-NEW-KEY-IND = 'N')                                   DTSCS85
00718           AND                                                     DTSCS85
00719         (WRK-KEY-AREA = FFAZ-KEY-AREA)                            DTSCS85
00720          NEXT SENTENCE                                            DTSCS85
00721      ELSE                                                         DTSCS85
00722          PERFORM S831-END-BROWSE THRU S831-EXIT                   DTSCS85
00723          PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT           DTSCS85
00724          GO TO P6300-EXIT.                                        DTSCS85
00725      SKIP1                                                        DTSCS85
00726      PERFORM S831-READ-NEXT THRU S831-EXIT.                       DTSCS85
00727      IF L831-NO-REC-88                                            DTSCS85
00728          PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT           DTSCS85
00729          MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID                       DTSCS85
00730      ELSE                                                         DTSCS85
00731          PERFORM S831-END-BROWSE THRU S831-EXIT                   DTSCS85
00732          PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.          DTSCS85
00733  P6300-EXIT.                                                      DTSCS85
00734      EXIT.                                                        DTSCS85
00735 /*****************************************************************DTSCS85
00736 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS85
00737 ******************************************************************DTSCS85
00738      SKIP1                                                        DTSCS85
00739  P6900-CONSTRUCT-SCREEN.                                          DTSCS85
00740      MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY.                    DTSCS85
00741      SKIP1                                                        DTSCS85
00742      IF FFAZ-SINGLE-REP                                           DTSCS85
00743          MOVE FFAZ-FLD-REP-ID (1)  TO MAP-REP-ID (1)              DTSCS85
00744          MOVE LOW-VALUE            TO MAP-REP-ID (2)              DTSCS85
00745                                       MAP-REP-ID (3)              DTSCS85
00746                                       MAP-REP-ID (4)              DTSCS85
00747                                       MAP-REP-ID (5)              DTSCS85
00748                                       MAP-REP-ID (6)              DTSCS85
00749                                       MAP-REP-ID (7)              DTSCS85
00750                                       MAP-REP-ID (8)              DTSCS85
00751                                       MAP-REP-ID (9)              DTSCS85
00752                                       MAP-REP-ID (10)             DTSCS85
00753      ELSE                                                         DTSCS85
00754          MOVE FFAZ-FLD-REP-ID (1)  TO MAP-REP-ID (1)              DTSCS85
00755          MOVE FFAZ-FLD-REP-ID (2)  TO MAP-REP-ID (2)              DTSCS85
00756          MOVE FFAZ-FLD-REP-ID (3)  TO MAP-REP-ID (3)              DTSCS85
00757          MOVE FFAZ-FLD-REP-ID (4)  TO MAP-REP-ID (4)              DTSCS85
00758          MOVE FFAZ-FLD-REP-ID (5)  TO MAP-REP-ID (5)              DTSCS85
00759          MOVE FFAZ-FLD-REP-ID (6)  TO MAP-REP-ID (6)              DTSCS85
00760          MOVE FFAZ-FLD-REP-ID (7)  TO MAP-REP-ID (7)              DTSCS85
00761          MOVE FFAZ-FLD-REP-ID (8)  TO MAP-REP-ID (8)              DTSCS85
00762          MOVE FFAZ-FLD-REP-ID (9)  TO MAP-REP-ID (9)              DTSCS85
00763          MOVE FFAZ-FLD-REP-ID (10) TO MAP-REP-ID (10).            DTSCS85
00764      SKIP1                                                        DTSCS85
00765      IF FFAZ-ESTB-DATE  NOT =  +0                                 DTSCS85
00766          MOVE FFAZ-ESTB-DATE TO L001-FED-8-DATE-9                 DTSCS85
00767          SET L001-FROM-FED-8 TO TRUE                              DTSCS85
00768          PERFORM S001-DATE THRU S001-EXIT                         DTSCS85
00769          MOVE L001-SLASH-DATE TO MAP-ESTB-DATE.                   DTSCS85
00770      SKIP1                                                        DTSCS85
00771      IF FFAZ-CHNG-DATE  NOT =  +0                                 DTSCS85
00772          MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9                 DTSCS85
00773          SET L001-FROM-FED-8 TO TRUE                              DTSCS85
00774          PERFORM S001-DATE THRU S001-EXIT                         DTSCS85
00775          MOVE L001-SLASH-DATE TO MAP-CHNG-DATE.                   DTSCS85
00776      SKIP1                                                        DTSCS85
00777      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS85
00778      MOVE FFAZ-KEY-AREA TO LCCM-SCR-KEY-AREA.                     DTSCS85
00779  P6900-EXIT.                                                      DTSCS85
00780      EXIT.                                                        DTSCS85
00781 /*****************************************************************DTSCS85
00782 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD.        *DTSCS85
00783 ******************************************************************DTSCS85
00784      SKIP1                                                        DTSCS85
00785  P7000-REQUEST-EDIT.                                              DTSCS85
00786      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS85
00787      SKIP1                                                        DTSCS85
00788      IF LCCM-F09-88                                               DTSCS85
00789         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS85
00790      ELSE                                                         DTSCS85
00791      IF LCCM-F10-88                                               DTSCS85
00792         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS85
00793      ELSE                                                         DTSCS85
00794      IF LCCM-F23-88                                               DTSCS85
00795         PERFORM P7300-EDIT-DEL THRU P7300-EXIT                    DTSCS85
00796      ELSE                                                         DTSCS85
00797         GO TO S899-ABEND.                                         DTSCS85
00798      SKIP3                                                        DTSCS85
00799 *------------------------------------------------------           DTSCS85
00800 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS85
00801 *  IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN  DTSCS85
00802 *  IN A 'CLEAR' STATE.  THE SCREEN MUST BE IN 'INQUIRE' STATUS    DTSCS85
00803 *  IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED.                   DTSCS85
00804 *------------------------------------------------------           DTSCS85
00805      SKIP1                                                        DTSCS85
00806      IF LCCM-MSG                                                  DTSCS85
00807         NEXT SENTENCE                                             DTSCS85
00808      ELSE                                                         DTSCS85
00809         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS85
00810         IF LCCM-F09-88                                            DTSCS85
00811            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS85
00812            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS85
00813         ELSE                                                      DTSCS85
00814         IF LCCM-F10-88                                            DTSCS85
00815            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS85
00816            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS85
00817         ELSE                                                      DTSCS85
00818         IF LCCM-F23-88                                            DTSCS85
00819            SET LCCM-SCR-DEL-LOCKED TO TRUE                        DTSCS85
00820            MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID.                  DTSCS85
00821      SKIP1                                                        DTSCS85
00822      SET RESP-SEND-MAP TO TRUE.                                   DTSCS85
00823  P7000-EXIT.                                                      DTSCS85
00824      EXIT.                                                        DTSCS85
00825 /*****************************************************************DTSCS85
00826 * ADD FUNCTION WAS REQUESTED                                     *DTSCS85
00827 ******************************************************************DTSCS85
00828      SKIP1                                                        DTSCS85
00829  P7100-EDIT-ADD.                                                  DTSCS85
00830 *------------------------------------------------------           DTSCS85
00831 *     ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE         DTSCS85
00832 *------------------------------------------------------           DTSCS85
00833      IF NOT LCCM-SCR-CLEAR                                        DTSCS85
00834         MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS85
00835         GO TO P7100-EXIT.                                         DTSCS85
00836      SKIP1                                                        DTSCS85
00837      PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT.              DTSCS85
00838      SKIP1                                                        DTSCS85
00839      IF LCCM-NO-MSG                                               DTSCS85
00840          PERFORM S8010-READ-FFAZ THRU S8010-EXIT                  DTSCS85
00841          IF L831-OK-88                                            DTSCS85
00842             MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA               DTSCS85
00843             PERFORM S1101-ERROR THRU S1101-EXIT                   DTSCS85
00844          ELSE                                                     DTSCS85
00845             PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT.      DTSCS85
00846  P7100-EXIT.                                                      DTSCS85
00847      EXIT.                                                        DTSCS85
00848 /*****************************************************************DTSCS85
00849 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS85
00850 ******************************************************************DTSCS85
00851      SKIP1                                                        DTSCS85
00852  P7200-EDIT-MOD.                                                  DTSCS85
00853 *-----------------------------------------------------            DTSCS85
00854 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS85
00855 *    INQUIRED                                                     DTSCS85
00856 *-----------------------------------------------------            DTSCS85
00857      IF NOT LCCM-SCR-INQUIRE                                      DTSCS85
00858         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS85
00859         GO TO P7200-EXIT.                                         DTSCS85
00860      SKIP3                                                        DTSCS85
00861 *-----------------------------------------------------            DTSCS85
00862 *    CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD           DTSCS85
00863 *-----------------------------------------------------            DTSCS85
00864      MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA.                      DTSCS85
00865      IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY                     DTSCS85
00866         MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA          DTSCS85
00867         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS85
00868         GO TO P7200-EXIT.                                         DTSCS85
00869      SKIP1                                                        DTSCS85
00870      PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT.              DTSCS85
00871      SKIP1                                                        DTSCS85
00872      IF LCCM-NO-MSG                                               DTSCS85
00873          PERFORM S8010-READ-FFAZ THRU S8010-EXIT                  DTSCS85
00874          IF L831-NO-REC-88                                        DTSCS85
00875             MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                   DTSCS85
00876             PERFORM S1101-ERROR THRU S1101-EXIT                   DTSCS85
00877          ELSE                                                     DTSCS85
00878             PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT.      DTSCS85
00879  P7200-EXIT.                                                      DTSCS85
00880      EXIT.                                                        DTSCS85
00881 /*****************************************************************DTSCS85
00882 * DELETE FUNCTION WAS REQUESTED                                  *DTSCS85
00883 ******************************************************************DTSCS85
00884      SKIP1                                                        DTSCS85
00885  P7300-EDIT-DEL.                                                  DTSCS85
00886 *-----------------------------------------------------            DTSCS85
00887 *    DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY               DTSCS85
00888 *    INQUIRED                                                     DTSCS85
00889 *-----------------------------------------------------            DTSCS85
00890      IF NOT LCCM-SCR-INQUIRE                                      DTSCS85
00891         MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID                     DTSCS85
00892         GO TO P7300-EXIT.                                         DTSCS85
00893      SKIP3                                                        DTSCS85
00894 *-----------------------------------------------------            DTSCS85
00895 *    CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE          DTSCS85
00896 *-----------------------------------------------------            DTSCS85
00897      MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA.                      DTSCS85
00898      IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY                     DTSCS85
00899         MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA          DTSCS85
00900         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS85
00901         GO TO P7300-EXIT.                                         DTSCS85
00902      SKIP1                                                        DTSCS85
00903      IF LCCM-NO-MSG                                               DTSCS85
00904          PERFORM S8010-READ-FFAZ THRU S8010-EXIT                  DTSCS85
00905          IF L831-NO-REC-88                                        DTSCS85
00906             MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                   DTSCS85
00907             PERFORM S1101-ERROR THRU S1101-EXIT.                  DTSCS85
00908  P7300-EXIT.                                                      DTSCS85
00909      EXIT.                                                        DTSCS85
00910 /*****************************************************************DTSCS85
00911 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS85
00912 ******************************************************************DTSCS85
00913      SKIP1                                                        DTSCS85
00914  P8000-REQUEST-UPDATE.                                            DTSCS85
00915      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS85
00916      SKIP1                                                        DTSCS85
00917      IF LCCM-SCR-ADD-LOCKED                                       DTSCS85
00918         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS85
00919      ELSE                                                         DTSCS85
00920      IF LCCM-SCR-MOD-LOCKED                                       DTSCS85
00921         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS85
00922      ELSE                                                         DTSCS85
00923      IF LCCM-SCR-DEL-LOCKED                                       DTSCS85
00924         PERFORM P8300-DEL THRU P8300-EXIT                         DTSCS85
00925      ELSE                                                         DTSCS85
00926         GO TO S899-ABEND.                                         DTSCS85
00927      SKIP1                                                        DTSCS85
00928      SET RESP-SEND-MAP TO TRUE.                                   DTSCS85
00929  P8000-EXIT.                                                      DTSCS85
00930      EXIT.                                                        DTSCS85
00931 /*****************************************************************DTSCS85
00932 *                                                                *DTSCS85
00933 ******************************************************************DTSCS85
00934      SKIP1                                                        DTSCS85
00935  P8100-ADD.                                                       DTSCS85
00936      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS85
00937      SKIP1                                                        DTSCS85
00938      IF LCCM-F12-88                                               DTSCS85
00939         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS85
00940         GO TO P8100-EXIT.                                         DTSCS85
00941      SKIP1                                                        DTSCS85
00942      PERFORM S8010-READ-FFAZ THRU S8010-EXIT.                     DTSCS85
00943      IF L831-OK-88                                                DTSCS85
00944         MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA                   DTSCS85
00945         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS85
00946         GO TO P8100-EXIT.                                         DTSCS85
00947      SKIP1                                                        DTSCS85
00948      MOVE LOW-VALUES TO FFAZ-DATA-AREA.                           DTSCS85
00949      SKIP1                                                        DTSCS85
00950      PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT.                DTSCS85
00951      SKIP1                                                        DTSCS85
00952      MOVE LCCM-CURR-RUN-DATE TO FFAZ-ESTB-DATE.                   DTSCS85
00953      MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE.                   DTSCS85
00954      SKIP1                                                        DTSCS85
00955      PERFORM S831-WRITE THRU S831-EXIT.                           DTSCS85
00956      SKIP1                                                        DTSCS85
00957      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS85
00958      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS85
00959      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS85
00960  P8100-EXIT.                                                      DTSCS85
00961      EXIT.                                                        DTSCS85
00962 /*****************************************************************DTSCS85
00963 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS85
00964 ******************************************************************DTSCS85
00965      SKIP1                                                        DTSCS85
00966  P8200-MOD.                                                       DTSCS85
00967      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS85
00968      SKIP1                                                        DTSCS85
00969      IF LCCM-F12-88                                               DTSCS85
00970         MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID                     DTSCS85
00971         GO TO P8200-EXIT.                                         DTSCS85
00972      SKIP1                                                        DTSCS85
00973      PERFORM S8010-READ-FFAZ THRU S8010-EXIT.                     DTSCS85
00974      IF L831-NO-REC-88                                            DTSCS85
00975         MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                       DTSCS85
00976         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS85
00977         GO TO P8200-EXIT.                                         DTSCS85
00978      SKIP1                                                        DTSCS85
00979      PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT.                DTSCS85
00980      SKIP1                                                        DTSCS85
00981      MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE.                   DTSCS85
00982      SKIP1                                                        DTSCS85
00983      PERFORM S831-REWRITE THRU S831-EXIT.                         DTSCS85
00984      SKIP1                                                        DTSCS85
00985      MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9.                    DTSCS85
00986      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS85
00987      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS85
00988      MOVE L001-SLASH-DATE TO MAP-CHNG-DATE.                       DTSCS85
00989      SKIP1                                                        DTSCS85
00990      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS85
00991  P8200-EXIT.                                                      DTSCS85
00992      EXIT.                                                        DTSCS85
00993 /*****************************************************************DTSCS85
00994 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS85
00995 ******************************************************************DTSCS85
00996      SKIP1                                                        DTSCS85
00997  P8300-DEL.                                                       DTSCS85
00998      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS85
00999      SKIP1                                                        DTSCS85
01000      IF LCCM-F12-88                                               DTSCS85
01001         MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID                     DTSCS85
01002         GO TO P8300-EXIT.                                         DTSCS85
01003      SKIP1                                                        DTSCS85
01004      PERFORM S8010-READ-FFAZ THRU S8010-EXIT.                     DTSCS85
01005      IF NOT L831-OK-88                                            DTSCS85
01006         MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                       DTSCS85
01007         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS85
01008         GO TO P8300-EXIT.                                         DTSCS85
01009      SKIP1                                                        DTSCS85
01010      PERFORM S831-DELETE THRU S831-EXIT.                          DTSCS85
01011      SKIP1                                                        DTSCS85
01012      MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA.                        DTSCS85
01013      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS85
01014      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS85
01015      SKIP1                                                        DTSCS85
01016      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS85
01017      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS85
01018      SKIP1                                                        DTSCS85
01019      MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY.                    DTSCS85
01020      SKIP1                                                        DTSCS85
01021      MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS85
01022  P8300-EXIT.                                                      DTSCS85
01023      EXIT.                                                        DTSCS85
01024      EJECT                                                        DTSCS85
01025  P8900-CONSTRUCT-FFAZ.                                            DTSCS85
01026      SKIP1                                                        DTSCS85
01027      MOVE MAP-REP-ID (1) TO FFAZ-FLD-REP-ID (1).                  DTSCS85
01028      SKIP1                                                        DTSCS85
01029      IF MAP-REP-ID (2) = LOW-VALUE                                DTSCS85
01030          SET FFAZ-SINGLE-REP TO TRUE                              DTSCS85
01031          MOVE LOW-VALUE TO FFAZ-FLD-REP-ID (2)                    DTSCS85
01032                            FFAZ-FLD-REP-ID (3)                    DTSCS85
01033                            FFAZ-FLD-REP-ID (4)                    DTSCS85
01034                            FFAZ-FLD-REP-ID (5)                    DTSCS85
01035                            FFAZ-FLD-REP-ID (6)                    DTSCS85
01036                            FFAZ-FLD-REP-ID (7)                    DTSCS85
01037                            FFAZ-FLD-REP-ID (8)                    DTSCS85
01038                            FFAZ-FLD-REP-ID (9)                    DTSCS85
01039                            FFAZ-FLD-REP-ID (10)                   DTSCS85
01040      ELSE                                                         DTSCS85
01041          SET FFAZ-MULTIPLE-REPS TO TRUE                           DTSCS85
01042          MOVE MAP-REP-ID (2)  TO FFAZ-FLD-REP-ID (2)              DTSCS85
01043          MOVE MAP-REP-ID (3)  TO FFAZ-FLD-REP-ID (3)              DTSCS85
01044          MOVE MAP-REP-ID (4)  TO FFAZ-FLD-REP-ID (4)              DTSCS85
01045          MOVE MAP-REP-ID (5)  TO FFAZ-FLD-REP-ID (5)              DTSCS85
01046          MOVE MAP-REP-ID (6)  TO FFAZ-FLD-REP-ID (6)              DTSCS85
01047          MOVE MAP-REP-ID (7)  TO FFAZ-FLD-REP-ID (7)              DTSCS85
01048          MOVE MAP-REP-ID (8)  TO FFAZ-FLD-REP-ID (8)              DTSCS85
01049          MOVE MAP-REP-ID (9)  TO FFAZ-FLD-REP-ID (9)              DTSCS85
01050          MOVE MAP-REP-ID (10) TO FFAZ-FLD-REP-ID (10).            DTSCS85
01051      SKIP1                                                        DTSCS85
01052  P8900-EXIT.                                                      DTSCS85
01053      EXIT.                                                        DTSCS85
01054 /*****************************************************************DTSCS85
01055 * LINKS TO UTILITY MODULES                                        DTSCS85
01056 ******************************************************************DTSCS85
01057      SKIP1                                                        DTSCS85
01058  S001-DATE.                                                       DTSCS85
01059      EXEC CICS LINK                                               DTSCS85
01060          PROGRAM  ('DTSCU001')                                    DTSCS85
01061          COMMAREA (L001-COMM-AREA)                                DTSCS85
01062      END-EXEC.                                                    DTSCS85
01063  S001-EXIT.                                                       DTSCS85
01064      EXIT.                                                        DTSCS85
01065      SKIP3                                                        DTSCS85
01066  S062-READ-REP.                                                   DTSCS85
01067      EXEC CICS LINK                                               DTSCS85
01068          PROGRAM  ('DTSCU062')                                    DTSCS85
01069          COMMAREA (L062-COMM-AREA)                                DTSCS85
01070      END-EXEC.                                                    DTSCS85
01071      SKIP1                                                        DTSCS85
01072      IF L062-FILE-CLOSED                                          DTSCS85
01073          MOVE L062-MSG-AREA TO LCCM-MSG-AREA                      DTSCS85
01074          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS85
01075          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS85
01076          GO TO MAINLINE-EXIT.                                     DTSCS85
01077  S062-EXIT.                                                       DTSCS85
01078      EXIT.                                                        DTSCS85
01079      EJECT                                                        DTSCS85
01080  S803-REQ-SCR-ID-EDIT.                                            DTSCS85
01081      EXEC CICS LINK                                               DTSCS85
01082          PROGRAM  ('DTSCU803')                                    DTSCS85
01083          COMMAREA (DFHCOMMAREA)                                   DTSCS85
01084      END-EXEC.                                                    DTSCS85
01085  S803-EXIT.                                                       DTSCS85
01086      EXIT.                                                        DTSCS85
01087      SKIP3                                                        DTSCS85
01088  S804-INVALID-KEY.                                                DTSCS85
01089      EXEC CICS LINK                                               DTSCS85
01090          PROGRAM  ('DTSCU804')                                    DTSCS85
01091          COMMAREA (DFHCOMMAREA)                                   DTSCS85
01092      END-EXEC.                                                    DTSCS85
01093  S804-EXIT.                                                       DTSCS85
01094      EXIT.                                                        DTSCS85
01095      SKIP3                                                        DTSCS85
01096  S805-MSG-AREA.                                                   DTSCS85
01097      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS85
01098      SKIP1                                                        DTSCS85
01099      EXEC CICS LINK                                               DTSCS85
01100          PROGRAM  ('DTSCU805')                                    DTSCS85
01101          COMMAREA (L805-COMM-AREA)                                DTSCS85
01102      END-EXEC.                                                    DTSCS85
01103      SKIP1                                                        DTSCS85
01104      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS85
01105  S805-EXIT.                                                       DTSCS85
01106      EXIT.                                                        DTSCS85
01107      EJECT                                                        DTSCS85
01108  S831-READ.                                                       DTSCS85
01109      SET L831-READ-88 TO TRUE.                                    DTSCS85
01110      GO TO S831-IO.                                               DTSCS85
01111      SKIP1                                                        DTSCS85
01112  S831-START-BROWSE.                                               DTSCS85
01113      SET L831-START-BROWSE-88 TO TRUE.                            DTSCS85
01114      GO TO S831-IO.                                               DTSCS85
01115      SKIP1                                                        DTSCS85
01116  S831-READ-NEXT.                                                  DTSCS85
01117      SET L831-READ-NEXT-88 TO TRUE.                               DTSCS85
01118      GO TO S831-IO.                                               DTSCS85
01119      SKIP1                                                        DTSCS85
01120  S831-READ-PREV.                                                  DTSCS85
01121      SET L831-READ-PREV-88 TO TRUE.                               DTSCS85
01122      GO TO S831-IO.                                               DTSCS85
01123      SKIP1                                                        DTSCS85
01124  S831-END-BROWSE.                                                 DTSCS85
01125      SET L831-END-BROWSE-88 TO TRUE.                              DTSCS85
01126      GO TO S831-IO.                                               DTSCS85
01127      SKIP1                                                        DTSCS85
01128  S831-REWRITE.                                                    DTSCS85
01129      SET L831-REWRITE-88 TO TRUE.                                 DTSCS85
01130      GO TO S831-IO.                                               DTSCS85
01131      SKIP1                                                        DTSCS85
01132  S831-WRITE.                                                      DTSCS85
01133      SET L831-WRITE-88 TO TRUE.                                   DTSCS85
01134      GO TO S831-IO.                                               DTSCS85
01135      SKIP1                                                        DTSCS85
01136  S831-DELETE.                                                     DTSCS85
01137      SET L831-DELETE-88 TO TRUE.                                  DTSCS85
01138      GO TO S831-IO.                                               DTSCS85
01139      SKIP1                                                        DTSCS85
01140  S831-IO.                                                         DTSCS85
01141      SKIP1                                                        DTSCS85
01142      EXEC CICS LINK                                               DTSCS85
01143          PROGRAM  ('DTSCU831')                                    DTSCS85
01144          COMMAREA (L831-COMM-AREA)                                DTSCS85
01145      END-EXEC.                                                    DTSCS85
01146      SKIP1                                                        DTSCS85
01147      IF L831-FILE-CLOSED-88                                       DTSCS85
01148          MOVE L831-MSG-AREA TO LCCM-MSG-AREA                      DTSCS85
01149          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS85
01150          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS85
01151          GO TO MAINLINE-EXIT.                                     DTSCS85
01152  S831-EXIT.                                                       DTSCS85
01153      EXIT.                                                        DTSCS85
01154      SKIP3                                                        DTSCS85
01155  S851-SCREEN-PROCESSING.                                          DTSCS85
01156      EXEC CICS LINK                                               DTSCS85
01157          PROGRAM  ('DTSCU851')                                    DTSCS85
01158          COMMAREA (L851-COMM-AREA)                                DTSCS85
01159      END-EXEC.                                                    DTSCS85
01160  S851-EXIT.                                                       DTSCS85
01161      EXIT.                                                        DTSCS85
01162      SKIP3                                                        DTSCS85
01163  S899-ABEND.                                                      DTSCS85
01164      EXEC CICS ABEND                                              DTSCS85
01165          ABCODE(WRK-ABEND-CD)                                     DTSCS85
01166      END-EXEC.                                                    DTSCS85
01167 *S899-EXIT.                                                       DTSCS85
01168 *    EXIT.                                                        DTSCS85
01169 /*****************************************************************DTSCS85
01170 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS85
01171 ******************************************************************DTSCS85
01172      SKIP1                                                        DTSCS85
01173  S1001-SCREEN-KEY-EDITS.                                          DTSCS85
01174      SKIP1                                                        DTSCS85
01175      PERFORM S1100-TERRITORY     THRU S1100-EXIT.                 DTSCS85
01176      SKIP1                                                        DTSCS85
01177  S1001-EXIT.                                                      DTSCS85
01178      EXIT.                                                        DTSCS85
01179      SKIP3                                                        DTSCS85
01180  S1002-SCREEN-DATA-EDITS.                                         DTSCS85
01181      SKIP1                                                        DTSCS85
01182      PERFORM S1210-REP-1         THRU S1210-EXIT.                 DTSCS85
01183      PERFORM S1220-REP-2         THRU S1220-EXIT.                 DTSCS85
01184      PERFORM S1230-REP-REST      THRU S1230-EXIT                  DTSCS85
01185              VARYING MAP-IDX FROM 3 BY 1                          DTSCS85
01186              UNTIL   MAP-IDX GREATER THAN 10.                     DTSCS85
01187      SKIP1                                                        DTSCS85
01188  S1002-EXIT.                                                      DTSCS85
01189      EXIT.                                                        DTSCS85
01190      EJECT                                                        DTSCS85
01191  S1100-TERRITORY.                                                 DTSCS85
01192      INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE.         DTSCS85
01193      IF MAP-TERRITORY = SPACE                                     DTSCS85
01194          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS85
01195          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS85
01196      ELSE                                                         DTSCS85
01197          IF MAP-TERRITORY NUMERIC                                 DTSCS85
01198              NEXT SENTENCE                                        DTSCS85
01199          ELSE                                                     DTSCS85
01200              MOVE MAP-TERRITORY TO C072-ST                        DTSCS85
01201              IF C072-US-88 OR C072-CANADA-88                      DTSCS85
01202                  NEXT SENTENCE                                    DTSCS85
01203              ELSE                                                 DTSCS85
01204                  MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA        DTSCS85
01205                  PERFORM S1101-ERROR THRU S1101-EXIT.             DTSCS85
01206  S1100-EXIT.                                                      DTSCS85
01207      EXIT.                                                        DTSCS85
01208      SKIP3                                                        DTSCS85
01209  S1101-ERROR.                                                     DTSCS85
01210      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TERRITORY-A.           DTSCS85
01211      IF LCCM-NO-MSG                                               DTSCS85
01212          MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                      DTSCS85
01213          MOVE CATB-CURSOR   TO MAP-TERRITORY-L                    DTSCS85
01214          SET CURSOR-SET-YES TO TRUE.                              DTSCS85
01215  S1101-EXIT.                                                      DTSCS85
01216      EXIT.                                                        DTSCS85
01217      EJECT                                                        DTSCS85
01218  S1210-REP-1.                                                     DTSCS85
01219      SET MAP-IDX TO +1.                                           DTSCS85
01220      PERFORM S1211-VERIFY THRU S1211-EXIT.                        DTSCS85
01221  S1210-EXIT.                                                      DTSCS85
01222      EXIT.                                                        DTSCS85
01223      SKIP3                                                        DTSCS85
01224  S1211-VERIFY.                                                    DTSCS85
01225      MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID.                DTSCS85
01226      PERFORM S062-READ-REP THRU S062-EXIT.                        DTSCS85
01227      IF L062-NOT-VALID                                            DTSCS85
01228          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS85
01229          PERFORM S1291-ERROR THRU S1291-EXIT                      DTSCS85
01230          GO TO S1211-EXIT.                                        DTSCS85
01231      IF L062-FIELD-DESK-88 OR L062-DEFAULT-FLD-REP-88             DTSCS85
01232          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS85
01233          PERFORM S1291-ERROR THRU S1291-EXIT.                     DTSCS85
01234  S1211-EXIT.                                                      DTSCS85
01235      EXIT.                                                        DTSCS85
01236      SKIP3                                                        DTSCS85
01237  S1220-REP-2.                                                     DTSCS85
01238      INSPECT MAP-REP-ID (2) CONVERTING SPACE TO LOW-VALUE.        DTSCS85
01239      IF MAP-REP-ID (2)  NOT =  LOW-VALUE                          DTSCS85
01240          SET MAP-IDX TO +2                                        DTSCS85
01241          PERFORM S1211-VERIFY THRU S1211-EXIT.                    DTSCS85
01242  S1220-EXIT.                                                      DTSCS85
01243      EXIT.                                                        DTSCS85
01244      SKIP3                                                        DTSCS85
01245  S1230-REP-REST.                                                  DTSCS85
01246      INSPECT MAP-REP-ID (MAP-IDX) CONVERTING SPACE TO LOW-VALUE.  DTSCS85
01247      IF MAP-REP-ID (MAP-IDX)  NOT =  MAP-REP-ID (2)               DTSCS85
01248          IF MAP-REP-ID (MAP-IDX) =  LOW-VALUE                     DTSCS85
01249          OR MAP-REP-ID (2)       =  LOW-VALUE                     DTSCS85
01250              MOVE MSG-E851-AREA TO WRK-MSG-AREA                   DTSCS85
01251              PERFORM S1291-ERROR THRU S1291-EXIT                  DTSCS85
01252          ELSE                                                     DTSCS85
01253              PERFORM S1211-VERIFY THRU S1211-EXIT.                DTSCS85
01254  S1230-EXIT.                                                      DTSCS85
01255      EXIT.                                                        DTSCS85
01256      SKIP3                                                        DTSCS85
01257  S1291-ERROR.                                                     DTSCS85
01258      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-ID-A (MAP-IDX).    DTSCS85
01259      IF LCCM-NO-MSG                                               DTSCS85
01260          MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                      DTSCS85
01261          MOVE CATB-CURSOR   TO MAP-REP-ID-L (MAP-IDX)             DTSCS85
01262          SET CURSOR-SET-YES TO TRUE.                              DTSCS85
01263  S1291-EXIT.                                                      DTSCS85
01264      EXIT.                                                        DTSCS85
01265      EJECT                                                        DTSCS85
01266 /*****************************************************************DTSCS85
01267 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS85
01268 ******************************************************************DTSCS85
01269  S5100-SET-LOCK-ATTRB.                                            DTSCS85
01270      MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN                      DTSCS85
01271                                 SCR-ATB-NUM.                      DTSCS85
01272      SKIP1                                                        DTSCS85
01273      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS85
01274      SKIP1                                                        DTSCS85
01275      MOVE CATB-ASKIP-BRT-MDTON TO MAP-TERRITORY-A                 DTSCS85
01276                                   MAP-GOTO-A.                     DTSCS85
01277  S5100-EXIT.                                                      DTSCS85
01278      EXIT.                                                        DTSCS85
01279      SKIP3                                                        DTSCS85
01280 ******************************************************************DTSCS85
01281 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS85
01282 ******************************************************************DTSCS85
01283  S5200-SET-UPDATE-ATTRB.                                          DTSCS85
01284      MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN.                 DTSCS85
01285      MOVE CATB-UNPROT-BRT-NUM-MDTON   TO SCR-ATB-NUM.             DTSCS85
01286      SKIP1                                                        DTSCS85
01287      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS85
01288  S5200-EXIT.                                                      DTSCS85
01289      EXIT.                                                        DTSCS85
01290      SKIP3                                                        DTSCS85
01291 ******************************************************************DTSCS85
01292 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS85
01293 ******************************************************************DTSCS85
01294  S5300-SET-INQ-ATTRB.                                             DTSCS85
01295      MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN                     DTSCS85
01296                                   SCR-ATB-NUM.                    DTSCS85
01297      SKIP1                                                        DTSCS85
01298      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS85
01299  S5300-EXIT.                                                      DTSCS85
01300      EXIT.                                                        DTSCS85
01301      SKIP3                                                        DTSCS85
01302 ******************************************************************DTSCS85
01303 *  DO IT                                                         *DTSCS85
01304 ******************************************************************DTSCS85
01305  S5900-SET-ATTRB.                                                 DTSCS85
01306      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-TERRITORY-A.            DTSCS85
01307      SKIP1                                                        DTSCS85
01308      MOVE CATB-ASKIP-NORM-MDTON TO MAP-TERRITORY-DESC-A.          DTSCS85
01309      SKIP1                                                        DTSCS85
01310      MOVE SCR-ATB-AN TO MAP-REP-ID-A (1)                          DTSCS85
01311                            MAP-REP-ID-A (2)                       DTSCS85
01312                            MAP-REP-ID-A (3)                       DTSCS85
01313                            MAP-REP-ID-A (4)                       DTSCS85
01314                            MAP-REP-ID-A (5)                       DTSCS85
01315                            MAP-REP-ID-A (6)                       DTSCS85
01316                            MAP-REP-ID-A (7)                       DTSCS85
01317                            MAP-REP-ID-A (8)                       DTSCS85
01318                            MAP-REP-ID-A (9)                       DTSCS85
01319                            MAP-REP-ID-A (10).                     DTSCS85
01320      SKIP1                                                        DTSCS85
01321      MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A                 DTSCS85
01322                                 MAP-CHNG-DATE-A.                  DTSCS85
01323      SKIP1                                                        DTSCS85
01324      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS85
01325  S5900-EXIT.                                                      DTSCS85
01326      EXIT.                                                        DTSCS85
01327 /*****************************************************************DTSCS85
01328 * READ PREPARATION ROUTINES                                      *DTSCS85
01329 ******************************************************************DTSCS85
01330  S8010-READ-FFAZ.                                                 DTSCS85
01331      MOVE LOW-VALUES TO FFAZ-KEY-AREA.                            DTSCS85
01332      SET FFAZ-FAZ-88 TO TRUE.                                     DTSCS85
01333      MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY.                    DTSCS85
01334      PERFORM S831-READ THRU S831-EXIT.                            DTSCS85
01335  S8010-EXIT.                                                      DTSCS85
01336      EXIT.                                                        DTSCS85
01337 /*****************************************************************DTSCS85
01338 * MAP ROUTINES                                                   *DTSCS85
01339 ******************************************************************DTSCS85
01340  S9100-RECEIVE.                                                   DTSCS85
01341      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS85
01342      SKIP1                                                        DTSCS85
01343      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS85
01344      SKIP1                                                        DTSCS85
01345      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS85
01346      SKIP1                                                        DTSCS85
01347      MOVE L851-AID TO LCCM-AID.                                   DTSCS85
01348      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS85
01349  S9100-EXIT.                                                      DTSCS85
01350      EXIT.                                                        DTSCS85
01351      SKIP3                                                        DTSCS85
01352  S9200-SEND-DATAONLY.                                             DTSCS85
01353      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS85
01354      SKIP1                                                        DTSCS85
01355      IF LCCM-NO-MSG                                               DTSCS85
01356          NEXT SENTENCE                                            DTSCS85
01357      ELSE                                                         DTSCS85
01358          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS85
01359      SKIP1                                                        DTSCS85
01360      IF CURSOR-SET-GOTO                                           DTSCS85
01361          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS85
01362      ELSE                                                         DTSCS85
01363          MOVE CATB-CURSOR TO MAP-TERRITORY-L.                     DTSCS85
01364      SKIP1                                                        DTSCS85
01365      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS85
01366      SKIP1                                                        DTSCS85
01367      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS85
01368      SKIP1                                                        DTSCS85
01369      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS85
01370  S9200-EXIT.                                                      DTSCS85
01371      EXIT.                                                        DTSCS85
01372      SKIP3                                                        DTSCS85
01373  S9300-SEND-MAP.                                                  DTSCS85
01374      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS85
01375      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS85
01376      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS85
01377      SKIP1                                                        DTSCS85
01378      IF SCR-ACCESS-UPDATE                                         DTSCS85
01379          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS85
01380      ELSE                                                         DTSCS85
01381          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS85
01382      SKIP1                                                        DTSCS85
01383      PERFORM S9331-DSCR-TERRITORY THRU S9331-EXIT.                DTSCS85
01384      SKIP1                                                        DTSCS85
01385      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS85
01386      SKIP1                                                        DTSCS85
01387      IF CURSOR-SET-NO                                             DTSCS85
01388          MOVE CATB-CURSOR TO MAP-TERRITORY-L.                     DTSCS85
01389      SKIP1                                                        DTSCS85
01390      SET L851-SEND-88 TO TRUE.                                    DTSCS85
01391      SKIP1                                                        DTSCS85
01392      PERFORM S9800-NAME-FILL THRU S9800-EXIT                      DTSCS85
01393              VARYING MAP-IDX FROM 1 BY 1                          DTSCS85
01394              UNTIL MAP-IDX GREATER THAN 10.                       DTSCS85
01395      SKIP1                                                        DTSCS85
01396      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS85
01397      SKIP1                                                        DTSCS85
01398      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS85
01399  S9300-EXIT.                                                      DTSCS85
01400      EXIT.                                                        DTSCS85
01401      SKIP3                                                        DTSCS85
01402  S9310-UPDATE-FKEYS.                                              DTSCS85
01403      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS85
01404      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS85
01405      MOVE CFKD-ADD TO MAP-KEY-ADD.                                DTSCS85
01406      MOVE CFKD-MOD TO MAP-KEY-MOD.                                DTSCS85
01407      MOVE CFKD-DEL TO MAP-KEY-DEL.                                DTSCS85
01408      SKIP1                                                        DTSCS85
01409      IF LCCM-SCR-CLEAR                                            DTSCS85
01410          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS85
01411                             MAP-KEY-DEL                           DTSCS85
01412      ELSE                                                         DTSCS85
01413      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS85
01414          MOVE LOW-VALUES TO MAP-KEY-BACK                          DTSCS85
01415                             MAP-KEY-FWRD                          DTSCS85
01416                             MAP-KEY-ADD                           DTSCS85
01417                             MAP-KEY-MOD                           DTSCS85
01418                             MAP-KEY-DEL                           DTSCS85
01419      ELSE                                                         DTSCS85
01420          MOVE LOW-VALUES TO MAP-KEY-ADD.                          DTSCS85
01421  S9310-EXIT.                                                      DTSCS85
01422      EXIT.                                                        DTSCS85
01423      SKIP3                                                        DTSCS85
01424  S9320-INQUIRY-FKEYS.                                             DTSCS85
01425      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS85
01426      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS85
01427      MOVE LOW-VALUES TO MAP-KEY-ADD                               DTSCS85
01428                         MAP-KEY-MOD                               DTSCS85
01429                         MAP-KEY-DEL.                              DTSCS85
01430  S9320-EXIT.                                                      DTSCS85
01431      EXIT.                                                        DTSCS85
01432      EJECT                                                        DTSCS85
01433  S9331-DSCR-TERRITORY.                                            DTSCS85
01434 *    IF MAP-TERRITORY = SPACE OR LOW-VALUE                        DTSCS85
01435      IF MAP-TERRITORY NOT NUMERIC                                 DTSCS85
01436          MOVE SPACE TO MAP-TERRITORY-DESC                         DTSCS85
01437          GO TO S9331-EXIT.                                        DTSCS85
01438                                                                   DTSCS85
01439      CALL 'LPAMC' USING                                           DTSCS85
01440                  DFHEIBLK                                         DTSCS85
01441                  LPAM-DUMMY-COMMAREA                              DTSCS85
01442          LPAM-OPEN-FUNCTION                                       DTSCS85
01443                  LPAM-ANCHOR-AREA                                 DTSCS85
01444                  LPAM-RETURN-CODE                                 DTSCS85
01445                  LPAM-ERROR-AREA                                  DTSCS85
01446                  LPAM-STREET-FILE-RCB                             DTSCS85
01447                  LPAM-PRODUCT-NAME                                DTSCS85
01448                  LPAM-STREET-FILE-NAME.                           DTSCS85
01449                                                                   DTSCS85
01450      IF LPAM-RETURN-CODE  NOT =  '00'                             DTSCS85
01451 *        MOVE '=NOT AVAILABLE='    TO MAP-CITY                    DTSCS85
01452          MOVE '=NOT AVAILABLE='    TO MAP-TERRITORY-DESC          DTSCS85
01453          GO TO S9331-EXIT.                                        DTSCS85
01454                                                                   DTSCS85
01455      MOVE LOW-VALUES            TO  LPAM-GETZIP-INPUT.            DTSCS85
01456      MOVE MAP-TERRITORY         TO  LPAM-GETZIP-TARGET-ZIP.       DTSCS85
01457      MOVE 'FIRST'               TO  LPAM-GETZIP-TARGET-IND.       DTSCS85
01458      MOVE 1                     TO  LPAM-GETZIP-REPLICATION.      DTSCS85
01459                                                                   DTSCS85
01460      CALL 'LPAMC' USING                                           DTSCS85
01461                  DFHEIBLK                                         DTSCS85
01462                  LPAM-DUMMY-COMMAREA                              DTSCS85
01463          LPAM-GETZIP-FUNCTION                                     DTSCS85
01464                  LPAM-ANCHOR-AREA                                 DTSCS85
01465                  LPAM-RETURN-CODE                                 DTSCS85
01466                  LPAM-ERROR-AREA                                  DTSCS85
01467                  LPAM-STREET-FILE-RCB                             DTSCS85
01468                  LPAM-GETZIP-INPUT                                DTSCS85
01469                  LPAM-GETZIP-OUTPUT.                              DTSCS85
01470                                                                   DTSCS85
01471      IF LPAM-RETURN-CODE  =  '00'                                 DTSCS85
01472          MOVE LPAM-GETZIP-RCITY    TO MAP-TERRITORY-DESC          DTSCS85
01473 *********MOVE LPAM-GETZIP-RSTATE   TO MAP-ST                      DTSCS85
01474      ELSE                                                         DTSCS85
01475          MOVE ALL '?'              TO MAP-TERRITORY-DESC.         DTSCS85
01476                                                                   DTSCS85
01477      CALL 'LPAMC' USING                                           DTSCS85
01478                  DFHEIBLK                                         DTSCS85
01479                  LPAM-DUMMY-COMMAREA                              DTSCS85
01480          LPAM-CLOSE-FUNCTION                                      DTSCS85
01481                  LPAM-ANCHOR-AREA                                 DTSCS85
01482                  LPAM-RETURN-CODE                                 DTSCS85
01483                  LPAM-ERROR-AREA                                  DTSCS85
01484                  LPAM-STREET-FILE-RCB.                            DTSCS85
01485  S9331-EXIT.                                                      DTSCS85
01486      EXIT.                                                        DTSCS85
01487      EJECT                                                        DTSCS85
01488  S9800-NAME-FILL.                                                 DTSCS85
01489      IF MAP-REP-ID (MAP-IDX) = LOW-VALUE                          DTSCS85
01490          MOVE LOW-VALUE TO MAP-REP-NAME (MAP-IDX)                 DTSCS85
01491      ELSE                                                         DTSCS85
01492          MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID             DTSCS85
01493          PERFORM S062-READ-REP THRU S062-EXIT                     DTSCS85
01494          MOVE L062-NAME TO MAP-REP-NAME (MAP-IDX).                DTSCS85
01495  S9800-EXIT.                                                      DTSCS85
01496      EXIT.                                                        DTSCS85
01497      SKIP3                                                        DTSCS85
01498  S9900-PREPARE-SEND.                                              DTSCS85
01499      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS85
01500                         LCCM-SCR-ID.                              DTSCS85
01501      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS85
01502      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS85
01503  S9900-EXIT.                                                      DTSCS85
01504      EXIT.                                                        DTSCS85
