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