00001  IDENTIFICATION DIVISION.                                         02/07/12
00002  PROGRAM-ID.             DTSCS62.                                 DTSCS62
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV058
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS62
00005  DATE-COMPILED.                                                   DTSCS62
00006      SKIP3                                                        DTSCS62
00007 *****                                                             DTSCS62
00008 *                                                                 DTSCS62
00009 *    FUNCTION:  FIELD ASSIGNMENT INQUIRY/UPDATE                   DTSCS62
00010 *               SCREEN PROCESSOR.                                 DTSCS62
00011 *                                                                 DTSCS62
00012 *                                                                 DTSCS62
00013 *    MODIFICATION LOG:                                            DTSCS62
00014 *                                                                 DTSCS62
00015 *    11/14/1998  INITIAL DEVELOPMENT.   COPIED FROM MACCS62.      DTSCS62
00016 *                WORK ORDER:                      PROGRAMMER: ZL1 DTSCS62
00017 *                                                                 DTSCS62
00018 *    04/20/1999  MODIFED TO ALLOW USERS WITH INQUIRY ACCESS TO    DTSCS62
00019 *                REQUEST TAX OR WAGES EXTRACTS BY USING THE       DTSCS62
00020 *                F5 KEY.                                          DTSCS62
00021 *                                                                 DTSCS62
00022 *    10/16/1999  FIX NUMEROUS BUGS AND LOGICAL INCONSISTENCIES.   DTSCS62
00023 *                REFERENCE: CLEANUP               PROGRAMMER: EHH DTSCS62
00024 *                                                                 DTSCS62
00025 *    02/21/2001  ALLOW USERS WITHOUT FIELD DESK AUTHORITY ACCESS  DTSCS62
00026 *                TO CERTAIN FIELDS.  SEE S1000.                   DTSCS62
00027 *                REFERENCE: REQUEST FROM FRANK    PROGRAMMER: GD  DTSCS62
00028 *                                                                 DTSCS62
00029 *    03/05/2008  MODIFIED P6910 FOR AUTOMATIC AUDIT ASSIGNMENTS.  DTSCS62
00030 *                FOR AUDIT ASSIGNMENTS GENERATED BY THE SYSTEM    DTSCS62
00031 *                THAT ARE IN HELD STATUS, SET THE TAX AND WAGE    DTSCS62
00032 *                DOWNLOAD INDICATORS TO YES.                      DTSCS62
00033 *                REFERENCE:                       PROGRAMMER: GD  DTSCS62
00034 *                                                                 DTSCS62
00035 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS62
00036 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS62
00037 *                REFERENCE:                       PROGRAMMER: XXX DTSCS62
00038 *                                                                 DTSCS62
00039 *                                                                 DTSCS62
00040 *  DESCRIPTION:                                                   DTSCS62
00041 *                                                                 DTSCS62
00042 *                                                                 DTSCS62
00043 *    CLEAR:                                                       DTSCS62
00044 *                                                                 DTSCS62
00045 *      FIELD DISPLAYED: NONE.                                     DTSCS62
00046 *                                                                 DTSCS62
00047 *                                                                 DTSCS62
00048 *    JUMP:                                                        DTSCS62
00049 *                                                                 DTSCS62
00050 *                                                                 DTSCS62
00051 *    INQUIRY:                                                     DTSCS62
00052 *                                                                 DTSCS62
00053 *      CONTROL FIELD: MAP-ASSIGN-NO                               DTSCS62
00054 *                                                                 DTSCS62
00055 *      JUMP IN: DISPLAY THE FIELD ASSIGNMENT ASSOCIATED WITH      DTSCS62
00056 *               LCCM-ASSIGN-NO.                                   DTSCS62
00057 *                                                                 DTSCS62
00058 *      ENTER: DISPLAY THE FIELD ASSIGNMENT ASSOCIATED WITH        DTSCS62
00059 *             MAP-ASSIGN-NO.                                      DTSCS62
00060 *                                                                 DTSCS62
00061 *      JUMP OUT: NO SPECIAL PROCESSING.                           DTSCS62
00062 *                                                                 DTSCS62
00063 *                                                                 DTSCS62
00064 *    LCCM DATA ELEMENT MAINTENANCE.                               DTSCS62
00065 *                                                                 DTSCS62
00066 *      STANDARD LCCM-ASSIGN-NO MAINTENANCE.                       DTSCS62
00067 *                                                                 DTSCS62
00068 *      MAINTAIN LCCM-EMP-NO IN SYNC WITH LCCM-ASSIGN-NO.          DTSCS62
00069 *                                                                 DTSCS62
00070 *      STANDARD LCCM-RESP-OP-ID MAINTENANCE.                      DTSCS62
00071 *                                                                 DTSCS62
00072 *      STANDARD LCCM-OP-PRINTER-ID MAINTENANCE.                   DTSCS62
00073 *                                                                 DTSCS62
00074 *                                                                 DTSCS62
00075 *    UPDATE:                                                      DTSCS62
00076 *                                                                 DTSCS62
00077 *      MOD                                                        DTSCS62
00078 *                                                                 DTSCS62
00079 *        UPDATE THE MFAS RECORD.                                  DTSCS62
00080 *                                                                 DTSCS62
00081 *        IF MAP-COPY-CNT IS GREATER THAN ZERO,                    DTSCS62
00082 *          THEN LINK TO DTSCU351 FOR ON-LINE PRINT OF THE FIELD   DTSCS62
00083 *          ASSIGNMENT MEMORANDUM.                                 DTSCS62
00084 *                                                                 DTSCS62
00085 *                                                                 DTSCS62
00086 *      DEL                                                        DTSCS62
00087 *                                                                 DTSCS62
00088 *        IF MAP-STATUS-CD = 'P', THEN DELETE IS NOT ALLOWED.      DTSCS62
00089 *                                                                 DTSCS62
00090 *        THUS, WE CAN BE ASSURED, THAT IF DELETE IS ALLOWED,      DTSCS62
00091 *        NO MAUR RECORD EXISTS AND NO MAUY RECORDS EXIST.         DTSCS62
00092 *                                                                 DTSCS62
00093 *        DELETE THE MFAS RECORD.                                  DTSCS62
00094 *                                                                 DTSCS62
00095 *        IF A CORRESPONDING MFAR RECORDS EXIST, THEN DELETE       DTSCS62
00096 *          THE MFAR RECORDS.                                      DTSCS62
00097 *                                                                 DTSCS62
00098 *        MAINTIAN MPRF-MFAS-IND.                                  DTSCS62
00099 *                                                                 DTSCS62
00100 *                                                                 DTSCS62
00101 *                                                                 DTSCS62
00102 *    RECORDS READ:                                                DTSCS62
00103 *                                                                 DTSCS62
00104 *      MASTER:                                                    DTSCS62
00105 *                                                                 DTSCS62
00106 *        MPRF                                                     DTSCS62
00107 *        MFAS                                                     DTSCS62
00108 *        MFAR                                                     DTSCS62
00109 *                                                                 DTSCS62
00110 *                                                                 DTSCS62
00111 *      ALTERNATE INDEX:                                           DTSCS62
00112 *                                                                 DTSCS62
00113 *        IFAN                                                     DTSCS62
00114 *                                                                 DTSCS62
00115 *                                                                 DTSCS62
00116 *      REFERENCE:                                                 DTSCS62
00117 *                                                                 DTSCS62
00118 *        NONE.                                                    DTSCS62
00119 *                                                                 DTSCS62
00120 *                                                                 DTSCS62
00121 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS62
00122 *                                                                 DTSCS62
00123 *        NONE.                                                    DTSCS62
00124 *                                                                 DTSCS62
00125 *                                                                 DTSCS62
00126 *    RECORDS UPDATED:                                             DTSCS62
00127 *                                                                 DTSCS62
00128 *      MASTER:                                                    DTSCS62
00129 *                                                                 DTSCS62
00130 *        MPRF (REWRITE)                                           DTSCS62
00131 *        MFAS (REWRITE,DELETE)                                    DTSCS62
00132 *        MFAR (DELETE)                                            DTSCS62
00133 *                                                                 DTSCS62
00134 *                                                                 DTSCS62
00135 *      REFERENCE:                                                 DTSCS62
00136 *                                                                 DTSCS62
00137 *        NONE.                                                    DTSCS62
00138 *                                                                 DTSCS62
00139 *                                                                 DTSCS62
00140 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS62
00141 *                                                                 DTSCS62
00142 *        NONE.                                                    DTSCS62
00143 *                                                                 DTSCS62
00144 *                                                                 DTSCS62
00145 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS62
00146 *                                                                 DTSCS62
00147 *      IF MAP-TAX-EXTRACT = 'Y'                                   DTSCS62
00148 *        WRITE A T021 (TRN-CD = '01') RECORD.                     DTSCS62
00149 *                                                                 DTSCS62
00150 *      IF MAP-WAGE-EXTRACT = 'Y'                                  DTSCS62
00151 *        WRITE A T021 (TRN-CD = '02') RECORD.                     DTSCS62
00152 *                                                                 DTSCS62
00153 *      IF (MFAS-STATUS-CD IS CHANGED TO 'C')                      DTSCS62
00154 *               AND                                               DTSCS62
00155 *         (MFAS-AUDIT-88)                                         DTSCS62
00156 *        WRITE A R608 RECORD.                                     DTSCS62
00157 *                                                                 DTSCS62
00158 *                                                                 DTSCS62
00159 *    TEMPORARY STORAGE USAGE:                                     DTSCS62
00160 *                                                                 DTSCS62
00161 *      NONE.                                                      DTSCS62
00162 *                                                                 DTSCS62
00163 *                                                                 DTSCS62
00164 *    MODULES LINKED TO:                                           DTSCS62
00165 *                                                                 DTSCS62
00166 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS62
00167 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS62
00168 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS62
00169 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS62
00170 *      DTSCU020  SOCIAL SECURITY NUMBER FROM SCREEN FORMAT/EDIT.  DTSCS62
00171 *      DTSCU022  ASSIGNMENT NO FROM SCREEN FORMAT/EDIT.           DTSCS62
00172 *      DTSCU024  YEAR/QUARTER RANGE FROM SCREEN FORMAT/EDIT.      DTSCS62
00173 *      DTSCU038  R&A CODES EDIT/DESCRIPTION.                      DTSCS62
00174 *      DTSCU039  SIC CODE EDIT/DESCRIPTION.                       DTSCS62
00175 *      DTSCU061  FIELD ZIP/FIELD REP ID.                          DTSCS62
00176 *      DTSCU062  FIELD REP ID EDIT/DESCRIPTION.                   DTSCS62
00177 *      DTSCU063  FIELD ASSIGNMENT TYPE EDIT/DESCRIPTION.          DTSCS62
00178 *      DTSCU071  NAME EDIT/CONVERSION.                            DTSCS62
00179 *      DTSCU081  CLAIMANT NAME LOOKUP.                            DTSCS62
00180 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS62
00181 *      DTSCU221  MPRF-UPDATE DATA ELEMENT MAINTENANCE.            DTSCS62
00182 *      DTSCU331  MODIFICATION LOG UPDATE.                         DTSCS62
00183 *      DTSCU351  FIELD ASSIGNMENT MEMORANDUM PRINT.               DTSCS62
00184 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS62
00185 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT.                    DTSCS62
00186 *                                                                 DTSCS62
00187 *                                                                 DTSCS62
00188                                                                   DTSCS62
00189  ENVIRONMENT DIVISION.                                            DTSCS62
00190                                                                   DTSCS62
00191  DATA DIVISION.                                                   DTSCS62
00192                                                                   DTSCS62
00193  WORKING-STORAGE SECTION.                                         DTSCS62
001935 77  PAN-VALET PICTURE X(24) VALUE '058DTSCS62   02/07/12'.       DTSCS62
00194                                                                   DTSCS62
00195  01  WRK-AREA.                                                    DTSCS62
00196      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S62 '.    DTSCS62
00197                                                                   DTSCS62
00198      05  WRK-MODULE-NAME.                                         DTSCS62
00199          10  FILLER                  PIC  X(05)  VALUE 'DTSCS'.   DTSCS62
00200          10  WRK-SCR-ID.                                          DTSCS62
00201              15  WRK-SCR-ID-N        PIC  9(02)  VALUE 62.        DTSCS62
00202                                                                   DTSCS62
00203      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '60'.      DTSCS62
00204                                                                   DTSCS62
00205      05  WS-REC-FOUND-IND            PIC X(01).                   DTSCS62
00206                                                                   DTSCS62
00207      05  WRK-EXTRACT-REQ-IND         PIC X(01).                   DTSCS62
00208          88  WRK-EXTRACT-REQ-YES-88          VALUE 'Y'.           DTSCS62
00209          88  WRK-EXTRACT-REQ-NO-88           VALUE 'N'.           DTSCS62
00210                                                                   DTSCS62
00211      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS62
00212          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS62
00213          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS62
00214                                                                   DTSCS62
00215      05  CURSOR-SET-IND              PIC X(01).                   DTSCS62
00216          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS62
00217          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS62
00218          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS62
00219                                                                   DTSCS62
00220      05  REQ-IND                     PIC X(01).                   DTSCS62
00221          88  REQ-ERROR                       VALUE 'O'.           DTSCS62
00222          88  REQ-JUMP                        VALUE 'J'.           DTSCS62
00223          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS62
00224          88  REQ-CLEAR                       VALUE 'C'.           DTSCS62
00225          88  REQ-EDIT                        VALUE 'E'.           DTSCS62
00226          88  REQ-UPDATE                      VALUE 'U'.           DTSCS62
00227          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS62
00228                                                                   DTSCS62
00229      05  RESP-IND                    PIC X(01).                   DTSCS62
00230          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS62
00231          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS62
00232          88  RESP-JUMP                       VALUE 'J'.           DTSCS62
00233          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS62
00234                                                                   DTSCS62
00235      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS62
00236                                                                   DTSCS62
00237      05  WRK-ATB-AN               PIC  X(01).                     DTSCS62
00238      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS62
00239                                                                   DTSCS62
00240      05  WRK-ASSIGN-NO               PIC S9(09)  COMP-3.          DTSCS62
00241                                                                   DTSCS62
00242      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS62
00243                                                                   DTSCS62
00244      05  WRK-CTR                     PIC S9(04)  COMP.            DTSCS62
00245                                                                   DTSCS62
00246      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS62
00247          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS62
00248          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS62
00249                                                                   DTSCS62
00250      05  WRK-UPDATE-MPRF-IND         PIC  X(01).                  DTSCS62
00251          88  WRK-UPDATE-MPRF                VALUE 'Y'.            DTSCS62
00252          88  WRK-UPDATE-MPRF-NO             VALUE 'N'.            DTSCS62
00253                                                                   DTSCS62
00254      05  WRK-ACCESS-ASSIGN-IND       PIC X(01) VALUE 'Y'.         DTSCS62
00255          88  WRK-ACCESS-ASSIGN-YES           VALUE 'Y'.           DTSCS62
00256          88  WRK-ACCESS-ASSIGN-NO            VALUE 'N'.           DTSCS62
00257                                                                   DTSCS62
00258      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS62
00259                                                                   DTSCS62
00260      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS62
00261          10  FILLER                  PIC X(05).                   DTSCS62
00262          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS62
00263          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS62
00264                                                                   DTSCS62
00265      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS62
00266          10  FILLER                  PIC X(04).                   DTSCS62
00267          10  WRK-DISPLAY-ASSIGN-NO-1 PIC X(02).                   DTSCS62
00268          10  WRK-DISPLAY-ASSIGN-NO-2 PIC X(05).                   DTSCS62
00269                                                                   DTSCS62
00270      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS62
00271          10  FILLER                  PIC X(08).                   DTSCS62
00272          10  WRK-DISPLAY-QTR-YR      PIC X(02).                   DTSCS62
00273          10  WRK-DISPLAY-QTR-Q       PIC X(01).                   DTSCS62
00274                                                                   DTSCS62
00275      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS62
00276          10  FILLER                  PIC 9(05).                   DTSCS62
00277          10  WRK-DISPLAY-YR          PIC 9(02).                   DTSCS62
00278          10  WRK-DISPLAY-MO          PIC 9(02).                   DTSCS62
00279          10  WRK-DISPLAY-DA          PIC 9(02).                   DTSCS62
00280                                                                   DTSCS62
00281      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS62
00282          10  FILLER                      PIC  X(02).              DTSCS62
00283          10  WRK-DISPLAY-SSN-1           PIC  X(03).              DTSCS62
00284          10  WRK-DISPLAY-SSN-2           PIC  X(02).              DTSCS62
00285          10  WRK-DISPLAY-SSN-3           PIC  X(04).              DTSCS62
00286                                                                   DTSCS62
00287      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS62
00288          10  FILLER                      PIC  X(09).              DTSCS62
00289          10  WRK-DISPLAY-A-YR            PIC  X(02).              DTSCS62
00290                                                                   DTSCS62
00291 *    05  WRK-ASSIGN-TYPE-ERROR-IND   PIC  X(01).                  DTSCS62
00292 *        88  WRK-ASSIGN-TYPE-ERROR-YES   VALUE 'Y'.               DTSCS62
00293 *        88  WRK-ASSIGN-TYPE-ERROR-NO    VALUE 'N'.               DTSCS62
00294                                                                   DTSCS62
00295      05  WRK-START-DATE-ERROR-IND    PIC  X(01).                  DTSCS62
00296          88  WRK-START-DATE-ERROR-YES    VALUE 'Y'.               DTSCS62
00297          88  WRK-START-DATE-ERROR-NO     VALUE 'N'.               DTSCS62
00298                                                                   DTSCS62
00299      05  WRK-MFAS-IND                PIC  X(01).                  DTSCS62
00300                                                                   DTSCS62
00301      05  WRK-START-DATE              PIC S9(09) COMP-3.           DTSCS62
00302                                                                   DTSCS62
00303      05  WRK-L331-REC-OCC-ID         PIC X(20).                   DTSCS62
00304      05  FILLER REDEFINES WRK-L331-REC-OCC-ID.                    DTSCS62
00305          10  WRK-L331-ASSIGN-NO      PIC 9(09).                   DTSCS62
00306          10  FILLER                  PIC X(11).                   DTSCS62
00307                                                                   DTSCS62
00308 * SCREEN SPECIFIC ERROR MESSAGES                                  DTSCS62
00309                                                                   DTSCS62
00310  01  MSG-LITERALS.                                                DTSCS62
00311                                                                   DTSCS62
00312      05  MSG-E621-AREA.                                           DTSCS62
00313          10  FILLER                  PIC  X(04)  VALUE 'E621'.    DTSCS62
00314          10  FILLER                  PIC  X(30)                   DTSCS62
00315                VALUE 'CAN NOT CHANGE AN AUDIT TO A N'.            DTSCS62
00316          10  FILLER                  PIC  X(30)                   DTSCS62
00317                VALUE 'ON-AUDIT IF PROCESSED.        '.            DTSCS62
00318                                                                   DTSCS62
00319      05  MSG-E622-AREA.                                           DTSCS62
00320          10  FILLER                  PIC  X(04)  VALUE 'E622'.    DTSCS62
00321          10  FILLER                  PIC  X(30)                   DTSCS62
00322                VALUE 'STATUS MAY NOT BE CHANGED TO/F'.            DTSCS62
00323          10  FILLER                  PIC  X(30)                   DTSCS62
00324                VALUE 'ROM PROCESSED - USE AUDIT RSLT'.            DTSCS62
00325                                                                   DTSCS62
00326      05  MSG-E623-AREA.                                           DTSCS62
00327          10  FILLER                 PIC  X(04)  VALUE 'E623'.     DTSCS62
00328          10  FILLER                 PIC  X(11) VALUE              DTSCS62
00329                       'ASSIGNMENT '.                              DTSCS62
00330          10  FILLER                 PIC  X(10) VALUE ' MODIFIED.'.DTSCS62
00331          10  WRK-PRINTER-MSG        PIC  X(34) VALUE SPACES.      DTSCS62
00332                                                                   DTSCS62
00333      05  MSG-E624-AREA.                                           DTSCS62
00334          10  FILLER                  PIC  X(04)  VALUE 'E624'.    DTSCS62
00335          10  FILLER                  PIC  X(30)                   DTSCS62
00336                VALUE 'ASSIGNMENTS WITH A STATUS OF P'.            DTSCS62
00337          10  FILLER                  PIC  X(30)                   DTSCS62
00338                VALUE 'ROCESSED MAY NOT BE DELETED.  '.            DTSCS62
00339                                                                   DTSCS62
00340      05  MSG-E625-AREA.                                           DTSCS62
00341          10  FILLER                  PIC  X(04)  VALUE 'E625'.    DTSCS62
00342          10  FILLER                  PIC  X(30)                   DTSCS62
00343                VALUE 'RELATED EMPLOYER IS CHARGING O'.            DTSCS62
00344          10  FILLER                  PIC  X(30)                   DTSCS62
00345                VALUE 'NLY  NOT ALLOWED              '.            DTSCS62
00346                                                                   DTSCS62
00347      05  MSG-E626-AREA.                                           DTSCS62
00348          10  FILLER                  PIC  X(04)  VALUE 'E626'.    DTSCS62
00349          10  MSG-EMP-NO-IN-ERR           PIC 999B999.             DTSCS62
00350          10  MSG-E626-MSG                PIC X(50) VALUE          DTSCS62
00351          ' ALTERNATE INDEX FILE ERROR - CONTACT DP'.              DTSCS62
00352                                                                   DTSCS62
00353      05  MSG-E627-AREA.                                           DTSCS62
00354          10  FILLER                  PIC  X(04)  VALUE 'E627'.    DTSCS62
00355          10  FILLER                      PIC X(60) VALUE          DTSCS62
00356            'COMPLETED DATE MUST BE <= CURRENT RUN DATE'.          DTSCS62
00357                                                                   DTSCS62
00358      05  MSG-E628-AREA.                                           DTSCS62
00359          10  FILLER                  PIC  X(04)  VALUE 'E628'.    DTSCS62
00360          10  FILLER                      PIC X(60) VALUE          DTSCS62
00361            'COMPLETED DATE MUST BE <= PROCESSED DATE'.            DTSCS62
00362                                                                   DTSCS62
00363      05  MSG-E629-AREA.                                           DTSCS62
00364          10  FILLER                  PIC  X(04)  VALUE 'E629'.    DTSCS62
00365          10  FILLER                      PIC X(60) VALUE          DTSCS62
00366            'YRQ RANGE REQUIRED FOR EXTRACT'.                      DTSCS62
00367                                                                   DTSCS62
00368      05  MSG-E630-AREA.                                           DTSCS62
00369          10  FILLER                  PIC  X(04)  VALUE 'E630'.    DTSCS62
00370          10  FILLER                      PIC X(60) VALUE          DTSCS62
00371            'COMPLETED DATE CANNOT BE < THAN START DATE     '.     DTSCS62
00372                                                                   DTSCS62
00373      05  MSG-E62A-AREA.                                           DTSCS62
00374          10  FILLER                  PIC  X(04)  VALUE 'E62A'.    DTSCS62
00375          10  FILLER                      PIC X(60) VALUE          DTSCS62
00376            'NOT AN AUDIT ASSIGNMENT  ENTRY NOT ALLOWED'.          DTSCS62
00377                                                                   DTSCS62
00378      05  MSG-E62B-AREA.                                           DTSCS62
00379          10  FILLER                  PIC  X(04)  VALUE 'E62B'.    DTSCS62
00380          10  FILLER                      PIC X(60) VALUE          DTSCS62
00381            'AUDIT ASSIGNMENT  ENTRY IS REQUIRED'.                 DTSCS62
00382                                                                   DTSCS62
00383      05  MSG-E62C-AREA.                                           DTSCS62
00384          10  FILLER                  PIC  X(04)  VALUE 'E62C'.    DTSCS62
00385          10  FILLER                      PIC X(60) VALUE          DTSCS62
00386            'START DATE MUST BE <= ASSIGNMENT DUE DATE'.           DTSCS62
00387                                                                   DTSCS62
00388      05  MSG-E62D-AREA.                                           DTSCS62
00389          10  FILLER                  PIC  X(04)  VALUE 'E62D'.    DTSCS62
00390          10  FILLER                      PIC X(32) VALUE          DTSCS62
00391            'ASSIGNMENT STATUS IS "H" OR "K" '.                    DTSCS62
00392          10  FILLER                      PIC X(28) VALUE          DTSCS62
00393            ' COMPLETED DATE NOT ALLOWED '.                        DTSCS62
00394                                                                   DTSCS62
00395      05  MSG-E62E-AREA.                                           DTSCS62
00396          10  FILLER                  PIC  X(04)  VALUE 'E62E'.    DTSCS62
00397          10  FILLER                      PIC X(30) VALUE          DTSCS62
00398            'EMPLOYER WRITTEN OFF - EXTRACT'.                      DTSCS62
00399          10  FILLER                      PIC X(30) VALUE          DTSCS62
00400            ' NOT ALLOWED                  '.                      DTSCS62
00401                                                                   DTSCS62
00402      05  MSG-E62F-AREA.                                           DTSCS62
00403          10  FILLER                  PIC  X(04)  VALUE 'E62F'.    DTSCS62
00404          10  FILLER                      PIC X(30) VALUE          DTSCS62
00405            'EXTRACT REQUESTED - PLEASE SPE'.                      DTSCS62
00406          10  FILLER                      PIC X(30) VALUE          DTSCS62
00407            'CIFY EXTRACT TYPE(S)          '.                      DTSCS62
00408                                                                   DTSCS62
00409      05  MSG-E62G-AREA.                                           DTSCS62
00410          10  FILLER                  PIC  X(04)  VALUE 'E62G'.    DTSCS62
00411          10  FILLER                      PIC X(30) VALUE          DTSCS62
00412            'AUDIT ASSIGNMENT - YRQ MODIFIC'.                      DTSCS62
00413          10  FILLER                      PIC X(30) VALUE          DTSCS62
00414            'ATION NOT ALLOWED             '.                      DTSCS62
00415      05  MSG-E62H-AREA.                                           DTSCS62
00416          10  FILLER                  PIC  X(04)  VALUE 'E62H'.    DTSCS62
00417          10  FILLER                      PIC X(30) VALUE          DTSCS62
00418            'CANNOT CHANGE STATUS; AUDIT AS'.                      DTSCS62
00419          10  FILLER                      PIC X(30) VALUE          DTSCS62
00420            'SIGNMENT PENDING. PLEASE CLOSE'.                      DTSCS62
00421      EJECT                                                        DTSCS62
00422  01  WRK-R907-MSG-TABLE.                                          DTSCS62
00423      05  WRK-R907-MSG1.                                           DTSCS62
00424          10  WRK-R907-MSG1-ID            PIC X(11)                DTSCS62
00425                          VALUE 'DTSCS62 695'.                     DTSCS62
00426          10  WRK-R907-MSG1-SHORT-TEXT    PIC X(20)                DTSCS62
00427                          VALUE 'NO IN-STATE FLD REP'.             DTSCS62
00428          10  WRK-R907-MSG1-LONG-TEXT.                             DTSCS62
00429              15 FILLER                   PIC  X(30)               DTSCS62
00430                          VALUE 'AUDIT SURVEY CARD NOT PRINTED:'.  DTSCS62
00431              15 FILLER                   PIC  X(30)               DTSCS62
00432                          VALUE 'NO IN-STATE FIELD REP ASSIGNED'.  DTSCS62
00433  01  L001-COMM-AREA.                                              DTSCS62
00434  ++INCLUDE DTSIL001                                               DTSCS62
00435      EJECT                                                        DTSCS62
00436  01  L004-COMM-AREA.                                              DTSCS62
00437  ++INCLUDE DTSIL004                                               DTSCS62
00438      EJECT                                                        DTSCS62
00439  01  L015-COMM-AREA.                                              DTSCS62
00440  ++INCLUDE DTSIL015                                               DTSCS62
00441      EJECT                                                        DTSCS62
00442  01  L018-COMM-AREA.                                              DTSCS62
00443  ++INCLUDE DTSIL018                                               DTSCS62
00444      EJECT                                                        DTSCS62
00445  01  L020-COMM-AREA.                                              DTSCS62
00446  ++INCLUDE DTSIL020                                               DTSCS62
00447      EJECT                                                        DTSCS62
00448  01  L022-COMM-AREA.                                              DTSCS62
00449  ++INCLUDE DTSIL022                                               DTSCS62
00450      EJECT                                                        DTSCS62
00451  01  L024-COMM-AREA.                                              DTSCS62
00452  ++INCLUDE DTSIL024                                               DTSCS62
00453      EJECT                                                        DTSCS62
00454  01  L036-COMM-AREA.                                              DTSCS62
00455  ++INCLUDE DTSIL036                                               DTSCS62
00456      EJECT                                                        DTSCS62
00457  01  L038-COMM-AREA.                                              DTSCS62
00458  ++INCLUDE DTSIL038                                               DTSCS62
00459      EJECT                                                        DTSCS62
00460  01  L039-COMM-AREA.                                              DTSCS62
00461  ++INCLUDE DTSIL039                                               DTSCS62
00462      EJECT                                                        DTSCS62
00463  01  L061-COMM-AREA.                                              DTSCS62
00464  ++INCLUDE DTSIL061                                               DTSCS62
00465      EJECT                                                        DTSCS62
00466  01  L062-COMM-AREA.                                              DTSCS62
00467  ++INCLUDE DTSIL062                                               DTSCS62
00468      EJECT                                                        DTSCS62
00469  01  L063-COMM-AREA.                                              DTSCS62
00470  ++INCLUDE DTSIL063                                               DTSCS62
00471      EJECT                                                        DTSCS62
00472  01  L071-COMM-AREA.                                              DTSCS62
00473  ++INCLUDE DTSIL071                                               DTSCS62
00474      EJECT                                                        DTSCS62
00475  01  L081-COMM-AREA.                                              DTSCS62
00476  ++INCLUDE DTSIL081                                               DTSCS62
00477      EJECT                                                        DTSCS62
00478  01  L082-COMM-AREA.                                              DTSCS62
00479  ++INCLUDE DTSIL082                                               DTSCS62
00480      EJECT                                                        DTSCS62
00481  01  L111-COMM-AREA.                                              DTSCS62
00482  ++INCLUDE DTSIL111                                               DTSCS62
00483      EJECT                                                        DTSCS62
00484  01  L112-COMM-AREA.                                              DTSCS62
00485  ++INCLUDE DTSIL112                                               DTSCS62
00486      EJECT                                                        DTSCS62
00487  01  L221-COMM-AREA.                                              DTSCS62
00488  ++INCLUDE DTSIL221                                               DTSCS62
00489      EJECT                                                        DTSCS62
00490  01  L331-COMM-AREA.                                              DTSCS62
00491  ++INCLUDE DTSIL331                                               DTSCS62
00492      EJECT                                                        DTSCS62
00493 *01  L351-COMM-AREA.                                              DTSCS62
00494 ***INCLUDE DTSIL351                                               DTSCS62
00495      EJECT                                                        DTSCS62
00496  01  L805-COMM-AREA.                                              DTSCS62
00497  ++INCLUDE DTSIL805                                               DTSCS62
00498      EJECT                                                        DTSCS62
00499  01  L810-COMM-AREA.                                              DTSCS62
00500      05  L810-CONTROL-BLOCK.                                      DTSCS62
00501  ++INCLUDE DTSIL810                                               DTSCS62
00502      EJECT                                                        DTSCS62
00503      05  MSKL-REC.                                                DTSCS62
00504  ++INCLUDE DTSIMSKL                                               DTSCS62
00505      EJECT                                                        DTSCS62
00506  01  MPRF-REC.                                                    DTSCS62
00507  ++INCLUDE DTSIMPRF                                               DTSCS62
00508      EJECT                                                        DTSCS62
00509  01  MFAS-REC.                                                    DTSCS62
00510  ++INCLUDE DTSIMFAS                                               DTSCS62
00511      EJECT                                                        DTSCS62
00512  01  MFSL-REC.                                                    DTSCS62
00513  ++INCLUDE DTSIMFSL                                               DTSCS62
00514      EJECT                                                        DTSCS62
00515  01  MFAR-REC.                                                    DTSCS62
00516  ++INCLUDE DTSIMFAR                                               DTSCS62
00517      EJECT                                                        DTSCS62
00518  01  L821-COMM-AREA.                                              DTSCS62
00519      05  L821-CONTROL-BLOCK.                                      DTSCS62
00520  ++INCLUDE DTSIL821                                               DTSCS62
00521                                                                   DTSCS62
00522      05  ISKL-REC.                                                DTSCS62
00523  ++INCLUDE DTSIISKL                                               DTSCS62
00524                                                                   DTSCS62
00525      05  FILLER REDEFINES ISKL-REC.                               DTSCS62
00526  ++INCLUDE DTSIIFAN                                               DTSCS62
00527      EJECT                                                        DTSCS62
00528  01  L825-COMM-AREA.                                              DTSCS62
00529      05  L825-CONTROL-BLOCK.                                      DTSCS62
00530  ++INCLUDE DTSIL825                                               DTSCS62
00531                                                                   DTSCS62
00532      05  RSKL-REC.                                                DTSCS62
00533  ++INCLUDE DTSIRSK1                                               DTSCS62
00534      EJECT                                                        DTSCS62
00535 *****                                                             DTSCS62
00536 * OLE REPORTS WRITTEN                                             DTSCS62
00537 *****                                                             DTSCS62
00538                                                                   DTSCS62
00539  01  T021-REC.                                                    DTSCS62
00540  ++INCLUDE DTSIT021                                               DTSCS62
00541                                                                   DTSCS62
00542                                                                   DTSCS62
00543                                                                   DTSCS62
00544  01  R608-REC.                                                    DTSCS62
00545  ++INCLUDE DTSIR608                                               DTSCS62
00546                                                                   DTSCS62
00547                                                                   DTSCS62
00548                                                                   DTSCS62
00549  01  R907-REC.                                                    DTSCS62
00550  ++INCLUDE DTSIR907                                               DTSCS62
00551      EJECT                                                        DTSCS62
00552  01  L851-COMM-AREA.                                              DTSCS62
00553  ++INCLUDE DTSIL851                                               DTSCS62
00554                                                                   DTSCS62
00555      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS62
00556  ++INCLUDE DTSIS62                                                DTSCS62
00557      EJECT                                                        DTSCS62
00558  01  CATB-LITERALS.                                               DTSCS62
00559  ++INCLUDE DTSICATB                                               DTSCS62
00560                                                                   DTSCS62
00561  01  CFKD-LITERALS.                                               DTSCS62
00562  ++INCLUDE DTSICFKD                                               DTSCS62
00563                                                                   DTSCS62
00564  01  CECD-LITERALS.                                               DTSCS62
00565  ++INCLUDE DTSICECD                                               DTSCS62
00566                                                                   DTSCS62
00567  01  CPCD-LITERALS.                                               DTSCS62
00568  ++INCLUDE DTSICPCD                                               DTSCS62
00569                                                                   DTSCS62
00570  01  MMAX-LITERALS.                                               DTSCS62
00571  ++INCLUDE DTSIMMAX                                               DTSCS62
00572      EJECT                                                        DTSCS62
00573  LINKAGE SECTION.                                                 DTSCS62
00574                                                                   DTSCS62
00575  01  DFHCOMMAREA.                                                 DTSCS62
00576  ++INCLUDE DTSILCCM                                               DTSCS62
00577      EJECT                                                        DTSCS62
00578  PROCEDURE DIVISION.                                              DTSCS62
00579                                                                   DTSCS62
00580      MOVE +0 TO WRK-ASSIGN-NO.                                    DTSCS62
00581      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS62
00582      SET WRK-EXTRACT-REQ-NO-88 TO TRUE.                           DTSCS62
00583                                                                   DTSCS62
00584      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS62
00585                                                                   DTSCS62
00586      SET CURSOR-SET-NO TO TRUE.                                   DTSCS62
00587                                                                   DTSCS62
00588      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS62
00589        TO SCR-ACCESS-IND.                                         DTSCS62
00590                                                                   DTSCS62
00591      MOVE SPACE TO REQ-IND.                                       DTSCS62
00592                                                                   DTSCS62
00593      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS62
00594                                                                   DTSCS62
00595 *-----------------------------------------------------            DTSCS62
00596 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS62
00597 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS62
00598 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS62
00599 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS62
00600 *                                                                 DTSCS62
00601 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS62
00602 *    PROCESSED.                                                   DTSCS62
00603 *                                                                 DTSCS62
00604 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS62
00605 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS62
00606 *    WORK STATION OPERATOR.                                       DTSCS62
00607 *-----------------------------------------------------            DTSCS62
00608                                                                   DTSCS62
00609      MOVE SPACE TO RESP-IND.                                      DTSCS62
00610                                                                   DTSCS62
00611      IF REQ-ERROR                                                 DTSCS62
00612         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS62
00613      ELSE                                                         DTSCS62
00614      IF REQ-JUMP                                                  DTSCS62
00615         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS62
00616      ELSE                                                         DTSCS62
00617      IF REQ-CLEAR                                                 DTSCS62
00618         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS62
00619      ELSE                                                         DTSCS62
00620      IF REQ-CURSOR-TO-GOTO                                        DTSCS62
00621         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS62
00622      ELSE                                                         DTSCS62
00623      IF REQ-INQUIRE                                               DTSCS62
00624         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS62
00625      ELSE                                                         DTSCS62
00626      IF REQ-EDIT                                                  DTSCS62
00627         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS62
00628      ELSE                                                         DTSCS62
00629      IF REQ-UPDATE                                                DTSCS62
00630         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS62
00631      ELSE                                                         DTSCS62
00632         GO TO S899-ABEND.                                         DTSCS62
00633                                                                   DTSCS62
00634 *-----------------------------------------------------            DTSCS62
00635 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS62
00636 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS62
00637 *-----------------------------------------------------            DTSCS62
00638                                                                   DTSCS62
00639      IF RESP-SEND-MAP                                             DTSCS62
00640          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS62
00641          SET LCCM-END-TASK-88 TO TRUE                             DTSCS62
00642      ELSE                                                         DTSCS62
00643      IF RESP-SEND-MSGONLY                                         DTSCS62
00644          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS62
00645          SET LCCM-END-TASK-88 TO TRUE                             DTSCS62
00646      ELSE                                                         DTSCS62
00647      IF RESP-JUMP                                                 DTSCS62
00648          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
00649      ELSE                                                         DTSCS62
00650      IF RESP-CURSOR-TO-GOTO                                       DTSCS62
00651          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS62
00652          SET LCCM-END-TASK-88 TO TRUE                             DTSCS62
00653      ELSE                                                         DTSCS62
00654          GO TO S899-ABEND.                                        DTSCS62
00655                                                                   DTSCS62
00656  MAINLINE-EXIT.                                                   DTSCS62
00657                                                                   DTSCS62
00658      EXEC CICS                                                    DTSCS62
00659          RETURN                                                   DTSCS62
00660      END-EXEC.                                                    DTSCS62
00661                                                                   DTSCS62
00662      GOBACK.                                                      DTSCS62
00663      EJECT                                                        DTSCS62
00664 /*****************************************************************DTSCS62
00665 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS62
00666 ******************************************************************DTSCS62
00667  P1000-ANALYZE-REQUEST.                                           DTSCS62
00668                                                                   DTSCS62
00669 *-----------------------------------------------------            DTSCS62
00670 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS62
00671 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS62
00672 *     REPLACED WITH ENTER)                                        DTSCS62
00673 *-----------------------------------------------------            DTSCS62
00674      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS62
00675         SET LCCM-ENTER-88 TO TRUE                                 DTSCS62
00676         IF LCCM-ASSIGN-NO > ZERO                                  DTSCS62
00677             SET REQ-INQUIRE TO TRUE                               DTSCS62
00678             MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY                    DTSCS62
00679             MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1       DTSCS62
00680             MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2       DTSCS62
00681         ELSE                                                      DTSCS62
00682             SET REQ-INQUIRE TO TRUE                               DTSCS62
00683         END-IF                                                    DTSCS62
00684         GO TO P1000-EXIT.                                         DTSCS62
00685                                                                   DTSCS62
00686 *-----------------------------------------------------            DTSCS62
00687 *      MAP IS RECEIVED                                            DTSCS62
00688 *-----------------------------------------------------            DTSCS62
00689      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS62
00690                                                                   DTSCS62
00691 *-----------------------------------------------------            DTSCS62
00692 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS62
00693 *    WORK STATION                                                 DTSCS62
00694 *-----------------------------------------------------            DTSCS62
00695      IF LCCM-CLEAR-88                                             DTSCS62
00696         SET REQ-CLEAR TO TRUE                                     DTSCS62
00697         GO TO P1000-EXIT.                                         DTSCS62
00698                                                                   DTSCS62
00699 *-----------------------------------------------------            DTSCS62
00700 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS62
00701 *-----------------------------------------------------            DTSCS62
00702      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS62
00703         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS62
00704         GO TO P1000-EXIT.                                         DTSCS62
00705                                                                   DTSCS62
00706 *-----------------------------------------------------            DTSCS62
00707 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS62
00708 *-----------------------------------------------------            DTSCS62
00709      IF LCCM-PA2-88                                               DTSCS62
00710          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS62
00711          GO TO P1000-EXIT.                                        DTSCS62
00712                                                                   DTSCS62
00713 *-----------------------------------------------------            DTSCS62
00714 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS62
00715 *-----------------------------------------------------            DTSCS62
00716      IF LCCM-PA-88                                                DTSCS62
00717        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS62
00718        SET REQ-ERROR TO TRUE                                      DTSCS62
00719        GO TO P1000-EXIT.                                          DTSCS62
00720                                                                   DTSCS62
00721 *-----------------------------------------------------            DTSCS62
00722 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS             DTSCS62
00723 *    CLEAR SCREEN                                                 DTSCS62
00724 *-----------------------------------------------------            DTSCS62
00725      IF LCCM-F12-88                                               DTSCS62
00726         MOVE LOW-VALUES TO MAP-AREA                               DTSCS62
00727         SET REQ-CLEAR TO TRUE                                     DTSCS62
00728         GO TO P1000-EXIT.                                         DTSCS62
00729                                                                   DTSCS62
00730 *-----------------------------------------------------            DTSCS62
00731 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS62
00732 *-----------------------------------------------------            DTSCS62
00733      IF LCCM-F03-88                                               DTSCS62
00734         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS62
00735         SET REQ-JUMP TO TRUE                                      DTSCS62
00736         GO TO P1000-EXIT.                                         DTSCS62
00737                                                                   DTSCS62
00738 *-----------------------------------------------------            DTSCS62
00739 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS62
00740 *-----------------------------------------------------            DTSCS62
00741      IF LCCM-F04-88                                               DTSCS62
00742         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS62
00743         SET REQ-JUMP TO TRUE                                      DTSCS62
00744         GO TO P1000-EXIT.                                         DTSCS62
00745                                                                   DTSCS62
00746 *---------------------------------------------------------        DTSCS62
00747 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS62
00748 *    CORRESPONDENCE SCREEN.                                       DTSCS62
00749 *---------------------------------------------------------        DTSCS62
00750                                                                   DTSCS62
00751      IF LCCM-F14-88                                               DTSCS62
00752          MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS62
00753          SET REQ-JUMP TO TRUE                                     DTSCS62
00754          GO TO P1000-EXIT.                                        DTSCS62
00755                                                                   DTSCS62
00756 *---------------------------------------------------------        DTSCS62
00757 *    IF REGISTRATION INQUIRY SCREEN KEY PRESSED,                  DTSCS62
00758 *    THEN JUMP TO REGISTRATION INQUIRY SCREEN.                    DTSCS62
00759 *---------------------------------------------------------        DTSCS62
00760 *                                                                 DTSCS62
00761 *    IF LCCM-F17-88                                               DTSCS62
00762 *        MOVE '11' TO LCCM-REQ-SCR-ID                             DTSCS62
00763 *        SET REQ-JUMP TO TRUE                                     DTSCS62
00764 *        GO TO P1000-EXIT.                                        DTSCS62
00765 *                                                                 DTSCS62
00766 *    IF LCCM-F21-88                                               DTSCS62
00767 *        MOVE '63' TO LCCM-REQ-SCR-ID                             DTSCS62
00768 *        SET REQ-JUMP TO TRUE                                     DTSCS62
00769 *        GO TO P1000-EXIT.                                        DTSCS62
00770 *                                                                 DTSCS62
00771 *    IF LCCM-F22-88                                               DTSCS62
00772 *        MOVE '65' TO LCCM-REQ-SCR-ID                             DTSCS62
00773 *        SET REQ-JUMP TO TRUE                                     DTSCS62
00774 *        GO TO P1000-EXIT.                                        DTSCS62
00775 *                                                                 DTSCS62
00776 *-----------------------------------------------------            DTSCS62
00777 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS62
00778 *    REQUESTED SCREEN TYPE                                        DTSCS62
00779 *-----------------------------------------------------            DTSCS62
00780      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS62
00781         NEXT SENTENCE                                             DTSCS62
00782      ELSE                                                         DTSCS62
00783        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS62
00784        SET REQ-JUMP TO TRUE                                       DTSCS62
00785        GO TO P1000-EXIT.                                          DTSCS62
00786                                                                   DTSCS62
00787 *-----------------------------------------------------            DTSCS62
00788 *    IF REQUEST TO UPDATE THE DATA (MOD,DEL)                      DTSCS62
00789 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS62
00790 *    FIELD STAFF HAS UPDATE ACCESS TO THIS SCREEN,                DTSCS62
00791 *    BUT ONLY HAS AUTHORITY TO CHANGE CERTAIN DATA                DTSCS62
00792 *    ELEMENTS.  SEE S1000.  ONLY THE FIELD DESK CAN               DTSCS62
00793 *    DELETE AN ASSIGNMENT.                                        DTSCS62
00794 *-----------------------------------------------------            DTSCS62
00795                                                                   DTSCS62
00796      IF LCCM-F10-88                                               DTSCS62
00797      OR LCCM-F23-88                                               DTSCS62
00798         IF SCR-ACCESS-UPDATE                                      DTSCS62
00799            SET REQ-EDIT TO TRUE                                   DTSCS62
00800            GO TO P1000-EXIT                                       DTSCS62
00801         ELSE                                                      DTSCS62
00802            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS62
00803            SET REQ-ERROR TO TRUE                                  DTSCS62
00804            GO TO P1000-EXIT.                                      DTSCS62
00805                                                                   DTSCS62
00806      IF LCCM-F23-88                                               DTSCS62
00807         IF SCR-ACCESS-UPDATE                                      DTSCS62
00808         AND LCCM-OP-IS-FLD-DESK-88                                DTSCS62
00809            SET REQ-EDIT TO TRUE                                   DTSCS62
00810            GO TO P1000-EXIT                                       DTSCS62
00811         ELSE                                                      DTSCS62
00812            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS62
00813            SET REQ-ERROR TO TRUE                                  DTSCS62
00814            GO TO P1000-EXIT.                                      DTSCS62
00815                                                                   DTSCS62
00816 *-----------------------------------------------------            DTSCS62
00817 *    IF INQUIRY TYPE KEY PRESSED (ENTER)                          DTSCS62
00818 *           INDICATE INQUIRY REQUEST                              DTSCS62
00819 *-----------------------------------------------------            DTSCS62
00820      IF LCCM-ENTER-88                                             DTSCS62
00821          SET REQ-INQUIRE TO TRUE                                  DTSCS62
00822          GO TO P1000-EXIT.                                        DTSCS62
00823                                                                   DTSCS62
00824 *-----------------------------------------------------            DTSCS62
00825 *     ANY OTHER KEY IS INVALID                                    DTSCS62
00826 *-----------------------------------------------------            DTSCS62
00827      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS62
00828      SET REQ-ERROR TO TRUE.                                       DTSCS62
00829  P1000-EXIT.                                                      DTSCS62
00830      EXIT.                                                        DTSCS62
00831                                                                   DTSCS62
00832 ******************************************************************DTSCS62
00833 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS62
00834 ******************************************************************DTSCS62
00835                                                                   DTSCS62
00836  P1100-UPDATE-LOCKED.                                             DTSCS62
00837 *-----------------------------------------------------            DTSCS62
00838 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS62
00839 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS62
00840 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS62
00841 *-----------------------------------------------------            DTSCS62
00842      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS62
00843         SET REQ-UPDATE TO TRUE                                    DTSCS62
00844      ELSE                                                         DTSCS62
00845         SET REQ-ERROR TO TRUE                                     DTSCS62
00846         IF LCCM-SCR-MOD-LOCKED                                    DTSCS62
00847            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS62
00848         ELSE                                                      DTSCS62
00849         IF LCCM-SCR-DEL-LOCKED                                    DTSCS62
00850            MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID                   DTSCS62
00851         ELSE                                                      DTSCS62
00852            GO TO S899-ABEND.                                      DTSCS62
00853  P1100-EXIT.                                                      DTSCS62
00854      EXIT.                                                        DTSCS62
00855 /*****************************************************************DTSCS62
00856 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPOFASD. *DTSCS62
00857 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS62
00858 ******************************************************************DTSCS62
00859                                                                   DTSCS62
00860  P2000-REQUEST-ERROR.                                             DTSCS62
00861      IF LCCM-MSG                                                  DTSCS62
00862         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS62
00863      ELSE                                                         DTSCS62
00864         GO TO S899-ABEND.                                         DTSCS62
00865  P2000-EXIT.                                                      DTSCS62
00866      EXIT.                                                        DTSCS62
00867 /*****************************************************************DTSCS62
00868 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS62
00869 ******************************************************************DTSCS62
00870                                                                   DTSCS62
00871  P3000-REQUEST-JUMP.                                              DTSCS62
00872 *-----------------------------------------------------            DTSCS62
00873 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS62
00874 *    BY USER                                                      DTSCS62
00875 *-----------------------------------------------------            DTSCS62
00876      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS62
00877                                                                   DTSCS62
00878 *-----------------------------------------------------            DTSCS62
00879 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS62
00880 *-----------------------------------------------------            DTSCS62
00881      IF LCCM-MSG                                                  DTSCS62
00882         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS62
00883         SET CURSOR-SET-GOTO TO TRUE                               DTSCS62
00884         GO TO P3000-EXIT.                                         DTSCS62
00885      SKIP3                                                        DTSCS62
00886      MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA.            DTSCS62
00887      PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT.           DTSCS62
00888      IF L022-VALID                                                DTSCS62
00889          MOVE L022-ASSIGN-NO TO LCCM-ASSIGN-NO.                   DTSCS62
00890                                                                   DTSCS62
00891 *-----------------------------------------------------            DTSCS62
00892 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS62
00893 *-----------------------------------------------------            DTSCS62
00894      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS62
00895                         LCCM-SCR-HOLD-AREA.                       DTSCS62
00896      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS62
00897      SET RESP-JUMP TO TRUE.                                       DTSCS62
00898  P3000-EXIT.                                                      DTSCS62
00899      EXIT.                                                        DTSCS62
00900 /*****************************************************************DTSCS62
00901 * CLEAR KEY WAS PRESSED                                          *DTSCS62
00902 ******************************************************************DTSCS62
00903                                                                   DTSCS62
00904  P4000-REQUEST-CLEAR.                                             DTSCS62
00905                                                                   DTSCS62
00906 *-----------------------------------------------------            DTSCS62
00907 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS62
00908 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS62
00909 *-----------------------------------------------------            DTSCS62
00910      IF LCCM-ASSIGN-NO > ZERO                                     DTSCS62
00911         MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY                        DTSCS62
00912         MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1           DTSCS62
00913         MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2           DTSCS62
00914      END-IF.                                                      DTSCS62
00915                                                                   DTSCS62
00916      MOVE ZERO TO LCCM-ASSIGN-NO.                                 DTSCS62
00917                                                                   DTSCS62
00918      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS62
00919                                                                   DTSCS62
00920      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS62
00921                                                                   DTSCS62
00922      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS62
00923                                                                   DTSCS62
00924      SET RESP-SEND-MAP TO TRUE.                                   DTSCS62
00925  P4000-EXIT.                                                      DTSCS62
00926      EXIT.                                                        DTSCS62
00927 /*****************************************************************DTSCS62
00928 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS62
00929 ******************************************************************DTSCS62
00930                                                                   DTSCS62
00931  P5000-CURSOR-TO-GOTO.                                            DTSCS62
00932      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS62
00933      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS62
00934  P5000-EXIT.                                                      DTSCS62
00935      EXIT.                                                        DTSCS62
00936 /*****************************************************************DTSCS62
00937 * INQUIRY WAS REQUESTED                                          *DTSCS62
00938 ******************************************************************DTSCS62
00939                                                                   DTSCS62
00940  P6000-REQUEST-INQUIRE.                                           DTSCS62
00941                                                                   DTSCS62
00942      MOVE MAP-ASSIGN-NO-AREA    TO L022-S-ASSIGN-NO-AREA.         DTSCS62
00943      MOVE LOW-VALUES            TO MAP-AREA.                      DTSCS62
00944      MOVE L022-S-ASSIGN-NO-AREA TO MAP-ASSIGN-NO-AREA.            DTSCS62
00945                                                                   DTSCS62
00946      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS62
00947      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS62
00948                                                                   DTSCS62
00949      SET RESP-SEND-MAP TO TRUE.                                   DTSCS62
00950                                                                   DTSCS62
00951      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS62
00952                                                                   DTSCS62
00953      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS62
00954      IF LCCM-MSG                                                  DTSCS62
00955          GO TO P6000-EXIT.                                        DTSCS62
00956                                                                   DTSCS62
00957      MOVE WRK-ASSIGN-NO      TO LCCM-ASSIGN-NO.                   DTSCS62
00958                                                                   DTSCS62
00959      MOVE WRK-EMP-NO         TO LCCM-EMP-NO.                      DTSCS62
00960                                                                   DTSCS62
00961      PERFORM S1120-READ-MFAS THRU S1120-EXIT.                     DTSCS62
00962                                                                   DTSCS62
00963      IF LCCM-MSG                                                  DTSCS62
00964          GO TO P6000-EXIT.                                        DTSCS62
00965                                                                   DTSCS62
00966      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS62
00967                                                                   DTSCS62
00968      IF LCCM-MSG                                                  DTSCS62
00969          GO TO P6000-EXIT.                                        DTSCS62
00970                                                                   DTSCS62
00971      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS62
00972                                                                   DTSCS62
00973      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS62
00974                                                                   DTSCS62
00975      IF SCR-ACCESS-UPDATE                                         DTSCS62
00976          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS62
00977  P6000-EXIT.                                                      DTSCS62
00978      EXIT.                                                        DTSCS62
00979 /*****************************************************************DTSCS62
00980 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS62
00981 ******************************************************************DTSCS62
00982                                                                   DTSCS62
00983  P6900-CONSTRUCT-SCREEN.                                          DTSCS62
00984      PERFORM P6910-FROM-MFAS THRU P6910-EXIT.                     DTSCS62
00985  P6900-EXIT.                                                      DTSCS62
00986      EXIT.                                                        DTSCS62
00987                                                                   DTSCS62
00988  P6910-FROM-MFAS.                                                 DTSCS62
00989      MOVE WRK-EMP-NO TO WRK-DISPLAY.                              DTSCS62
00990                                                                   DTSCS62
00991      MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1.                   DTSCS62
00992      MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2.                   DTSCS62
00993                                                                   DTSCS62
00994      MOVE MFAS-STATUS-CD       TO MAP-STATUS-CD.                  DTSCS62
00995                                                                   DTSCS62
00996      IF MFAS-FLD-REP-FIELD-DESK-88                                DTSCS62
00997         IF LCCM-OP-IS-FLD-DESK-88                                 DTSCS62
00998            MOVE SPACE TO MAP-FLD-REP-ID                           DTSCS62
00999         ELSE                                                      DTSCS62
01000            MOVE MFAS-FLD-REP-ID TO MAP-FLD-REP-ID                 DTSCS62
01001      ELSE                                                         DTSCS62
01002         MOVE MFAS-FLD-REP-ID TO MAP-FLD-REP-ID                    DTSCS62
01003      END-IF.                                                      DTSCS62
01004                                                                   DTSCS62
01005      MOVE MFAS-ASSIGN-TYPE    TO MAP-ASSIGN-TYPE.                 DTSCS62
01006                                                                   DTSCS62
01007      MOVE MFAS-ATTACHMENTS-IND TO MAP-ATTACHMENTS-IND.            DTSCS62
01008                                                                   DTSCS62
01009      MOVE MFAS-SOURCE-OP-ID   TO MAP-SOURCE-OP-ID.                DTSCS62
01010                                                                   DTSCS62
01011      MOVE MFAS-EMP-SIZE-IND   TO MAP-EMP-SIZE-IND.                DTSCS62
01012                                                                   DTSCS62
01013      MOVE MFAS-START-DATE   TO WRK-DISPLAY.                       DTSCS62
01014      MOVE WRK-DISPLAY-MO    TO MAP-START-DATE-MO.                 DTSCS62
01015      MOVE WRK-DISPLAY-DA    TO MAP-START-DATE-DA.                 DTSCS62
01016      MOVE WRK-DISPLAY-YR    TO MAP-START-DATE-YR.                 DTSCS62
01017                                                                   DTSCS62
01018      IF MFAS-DUE-DATE > 0                                         DTSCS62
01019         MOVE MFAS-DUE-DATE  TO WRK-DISPLAY                        DTSCS62
01020         MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO                    DTSCS62
01021         MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA                    DTSCS62
01022         MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR.                   DTSCS62
01023                                                                   DTSCS62
01024      IF MFAS-COMPLETED-DATE > +0                                  DTSCS62
01025         MOVE MFAS-COMPLETED-DATE TO WRK-DISPLAY                   DTSCS62
01026         MOVE WRK-DISPLAY-MO TO MAP-COMPLETED-DATE-MO              DTSCS62
01027         MOVE WRK-DISPLAY-DA TO MAP-COMPLETED-DATE-DA              DTSCS62
01028         MOVE WRK-DISPLAY-YR TO MAP-COMPLETED-DATE-YR.             DTSCS62
01029                                                                   DTSCS62
01030      IF MFAS-PROCESSED-DATE > +0                                  DTSCS62
01031         MOVE MFAS-PROCESSED-DATE TO L001-FED-8-DATE-9             DTSCS62
01032         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01033         MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE.               DTSCS62
01034                                                                   DTSCS62
01035      IF MFAS-TAX-DOWNLOAD-DATE > +0                               DTSCS62
01036         MOVE MFAS-TAX-DOWNLOAD-DATE TO L001-FED-8-DATE-9          DTSCS62
01037         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01038         MOVE L001-SLASH-DATE TO MAP-TAX-EXTRACT-DATE              DTSCS62
01039      ELSE                                                         DTSCS62
01040         IF MFAS-VERIF-AUDIT-88                                    DTSCS62
01041         AND MFAS-SOURCE-OP-ID = 'SYSTEM'                          DTSCS62
01042         AND MFAS-STATUS-HELD-88                                   DTSCS62
01043            SET MAP-TAX-EXTRACT-YES   TO TRUE                      DTSCS62
01044         END-IF                                                    DTSCS62
01045      END-IF.                                                      DTSCS62
01046                                                                   DTSCS62
01047      IF MFAS-WAGE-DOWNLOAD-DATE > +0                              DTSCS62
01048         MOVE MFAS-WAGE-DOWNLOAD-DATE TO L001-FED-8-DATE-9         DTSCS62
01049         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01050         MOVE L001-SLASH-DATE TO MAP-WAGE-EXTRACT-DATE             DTSCS62
01051      ELSE                                                         DTSCS62
01052         IF MFAS-VERIF-AUDIT-88                                    DTSCS62
01053         AND MFAS-SOURCE-OP-ID = 'SYSTEM'                          DTSCS62
01054         AND MFAS-STATUS-HELD-88                                   DTSCS62
01055            SET MAP-WAGE-EXTRACT-YES   TO TRUE                     DTSCS62
01056         END-IF                                                    DTSCS62
01057      END-IF.                                                      DTSCS62
01058                                                                   DTSCS62
01059      IF MFAS-CLAIMANT-SSN > 0                                     DTSCS62
01060         MOVE MFAS-CLAIMANT-SSN TO WRK-DISPLAY                     DTSCS62
01061         MOVE WRK-DISPLAY-SSN-1 TO MAP-CLAIMANT-SSN-1              DTSCS62
01062         MOVE WRK-DISPLAY-SSN-2 TO MAP-CLAIMANT-SSN-2              DTSCS62
01063         MOVE WRK-DISPLAY-SSN-3 TO MAP-CLAIMANT-SSN-3.             DTSCS62
01064                                                                   DTSCS62
01065      MOVE MFAS-CLAIMANT-NAME TO MAP-CLAIMANT-NAME.                DTSCS62
01066                                                                   DTSCS62
01067      MOVE MFAS-SIC-CD TO MAP-SIC-CD.                              DTSCS62
01068      MOVE MFAS-OWN-CD TO MAP-OWN-CD.                              DTSCS62
01069      MOVE MFAS-NAICS-CD TO MAP-NAICS-CD                           DTSCS62
01070                                                                   DTSCS62
01071      IF MFAS-RELATED-EMP-NO > + 0                                 DTSCS62
01072         MOVE MFAS-RELATED-EMP-NO TO WRK-DISPLAY                   DTSCS62
01073         MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-RELATED-EMP-NO-1         DTSCS62
01074         MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-RELATED-EMP-NO-2.        DTSCS62
01075                                                                   DTSCS62
01076      IF MFAS-START-YRQ > +0                                       DTSCS62
01077         MOVE MFAS-START-YRQ TO WRK-DISPLAY                        DTSCS62
01078         MOVE WRK-DISPLAY-QTR-Q TO MAP-AUDIT-START-Q               DTSCS62
01079         MOVE WRK-DISPLAY-QTR-YR TO MAP-AUDIT-START-YR.            DTSCS62
01080                                                                   DTSCS62
01081      IF MFAS-END-YRQ > +0                                         DTSCS62
01082         MOVE MFAS-END-YRQ TO WRK-DISPLAY                          DTSCS62
01083         MOVE WRK-DISPLAY-QTR-Q TO MAP-AUDIT-END-Q                 DTSCS62
01084         MOVE WRK-DISPLAY-QTR-YR  TO MAP-AUDIT-END-YR.             DTSCS62
01085                                                                   DTSCS62
01086      PERFORM VARYING WRK-CTR FROM 1 BY 1                          DTSCS62
01087      UNTIL WRK-CTR > MFAS-SEL-CNT                                 DTSCS62
01088         MOVE MFAS-AUDIT-SEL-REASON(WRK-CTR)                       DTSCS62
01089           TO MAP-AUDIT-SEL-REASON(WRK-CTR)                        DTSCS62
01090      END-PERFORM.                                                 DTSCS62
01091                                                                   DTSCS62
01092      PERFORM VARYING WRK-CTR FROM 1 BY 1                          DTSCS62
01093      UNTIL WRK-CTR > MFAS-TEXT-CNT                                DTSCS62
01094         MOVE MFAS-TEXT(WRK-CTR)                                   DTSCS62
01095           TO MAP-TEXT(WRK-CTR)                                    DTSCS62
01096      END-PERFORM.                                                 DTSCS62
01097                                                                   DTSCS62
01098  P6910-EXIT.                                                      DTSCS62
01099      EXIT.                                                        DTSCS62
01100 /*****************************************************************DTSCS62
01101 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED.        *DTSCS62
01102 ******************************************************************DTSCS62
01103                                                                   DTSCS62
01104  P7000-REQUEST-EDIT.                                              DTSCS62
01105                                                                   DTSCS62
01106      IF LCCM-F10-88                                               DTSCS62
01107         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS62
01108      ELSE                                                         DTSCS62
01109         IF LCCM-F23-88                                            DTSCS62
01110            PERFORM P7300-EDIT-DEL THRU P7300-EXIT                 DTSCS62
01111         ELSE                                                      DTSCS62
01112            GO TO S899-ABEND.                                      DTSCS62
01113                                                                   DTSCS62
01114 *------------------------------------------------------           DTSCS62
01115 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS62
01116 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS62
01117 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS62
01118 *------------------------------------------------------           DTSCS62
01119                                                                   DTSCS62
01120      IF LCCM-MSG                                                  DTSCS62
01121         NEXT SENTENCE                                             DTSCS62
01122      ELSE                                                         DTSCS62
01123         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS62
01124         IF LCCM-F10-88                                            DTSCS62
01125            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS62
01126            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS62
01127         ELSE                                                      DTSCS62
01128            IF LCCM-F23-88                                         DTSCS62
01129               SET LCCM-SCR-DEL-LOCKED TO TRUE                     DTSCS62
01130               MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID.               DTSCS62
01131                                                                   DTSCS62
01132      SET RESP-SEND-MAP TO TRUE.                                   DTSCS62
01133  P7000-EXIT.                                                      DTSCS62
01134      EXIT.                                                        DTSCS62
01135 /*****************************************************************DTSCS62
01136 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS62
01137 ******************************************************************DTSCS62
01138                                                                   DTSCS62
01139  P7200-EDIT-MOD.                                                  DTSCS62
01140      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS62
01141                                                                   DTSCS62
01142 *-----------------------------------------------------            DTSCS62
01143 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS62
01144 *    INQUIRED                                                     DTSCS62
01145 *-----------------------------------------------------            DTSCS62
01146      IF NOT LCCM-SCR-INQUIRE                                      DTSCS62
01147         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS62
01148         GO TO P7200-EXIT.                                         DTSCS62
01149                                                                   DTSCS62
01150 *-----------------------------------------------------            DTSCS62
01151 *    MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE MOD              DTSCS62
01152 *-----------------------------------------------------            DTSCS62
01153      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS62
01154      IF LCCM-MSG                                                  DTSCS62
01155          GO TO P7200-EXIT.                                        DTSCS62
01156                                                                   DTSCS62
01157      IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO                        DTSCS62
01158          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS62
01159          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS62
01160          GO TO P7200-EXIT.                                        DTSCS62
01161                                                                   DTSCS62
01162      PERFORM S1120-READ-MFAS THRU S1120-EXIT.                     DTSCS62
01163                                                                   DTSCS62
01164      IF LCCM-MSG                                                  DTSCS62
01165          GO TO P7200-EXIT.                                        DTSCS62
01166                                                                   DTSCS62
01167      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS62
01168                                                                   DTSCS62
01169      IF LCCM-MSG                                                  DTSCS62
01170          GO TO P7200-EXIT.                                        DTSCS62
01171                                                                   DTSCS62
01172      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS62
01173                                                                   DTSCS62
01174  P7200-EXIT.                                                      DTSCS62
01175      EXIT.                                                        DTSCS62
01176 /*****************************************************************DTSCS62
01177 * DELETE FUNCTION WAS REQUESTED                                  *DTSCS62
01178 ******************************************************************DTSCS62
01179                                                                   DTSCS62
01180  P7300-EDIT-DEL.                                                  DTSCS62
01181      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS62
01182                                                                   DTSCS62
01183 *-----------------------------------------------------            DTSCS62
01184 *    DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY             DTSCS62
01185 *    INQUIRED                                                     DTSCS62
01186 *-----------------------------------------------------            DTSCS62
01187      IF NOT LCCM-SCR-INQUIRE                                      DTSCS62
01188         MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID                     DTSCS62
01189         GO TO P7300-EXIT.                                         DTSCS62
01190                                                                   DTSCS62
01191 *-----------------------------------------------------            DTSCS62
01192 *    MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE DEL              DTSCS62
01193 *-----------------------------------------------------            DTSCS62
01194      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS62
01195      IF LCCM-MSG                                                  DTSCS62
01196          GO TO P7300-EXIT.                                        DTSCS62
01197                                                                   DTSCS62
01198      PERFORM S1120-READ-MFAS THRU S1120-EXIT.                     DTSCS62
01199                                                                   DTSCS62
01200      IF LCCM-MSG                                                  DTSCS62
01201          GO TO P7300-EXIT.                                        DTSCS62
01202                                                                   DTSCS62
01203      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS62
01204                                                                   DTSCS62
01205      IF LCCM-MSG                                                  DTSCS62
01206          GO TO P7300-EXIT.                                        DTSCS62
01207                                                                   DTSCS62
01208      IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO                        DTSCS62
01209          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS62
01210          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS62
01211          GO TO P7300-EXIT.                                        DTSCS62
01212                                                                   DTSCS62
01213      IF MFAS-STATUS-CD = 'P'                                      DTSCS62
01214         MOVE MSG-E624-AREA TO WRK-MSG-AREA                        DTSCS62
01215         PERFORM S1199-ERROR THRU S1199-EXIT.                      DTSCS62
01216                                                                   DTSCS62
01217  P7300-EXIT.                                                      DTSCS62
01218      EXIT.                                                        DTSCS62
01219                                                                   DTSCS62
01220 /*****************************************************************DTSCS62
01221 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS62
01222 ******************************************************************DTSCS62
01223  P8000-REQUEST-UPDATE.                                            DTSCS62
01224      IF LCCM-SCR-MOD-LOCKED                                       DTSCS62
01225         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS62
01226      ELSE                                                         DTSCS62
01227         IF LCCM-SCR-DEL-LOCKED                                    DTSCS62
01228            PERFORM P8300-DEL THRU P8300-EXIT                      DTSCS62
01229         ELSE                                                      DTSCS62
01230            GO TO S899-ABEND.                                      DTSCS62
01231                                                                   DTSCS62
01232      SET RESP-SEND-MAP TO TRUE.                                   DTSCS62
01233  P8000-EXIT.                                                      DTSCS62
01234      EXIT.                                                        DTSCS62
01235 /*****************************************************************DTSCS62
01236 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS62
01237 ******************************************************************DTSCS62
01238                                                                   DTSCS62
01239  P8200-MOD.                                                       DTSCS62
01240      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS62
01241                                                                   DTSCS62
01242      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS62
01243                                                                   DTSCS62
01244      IF LCCM-F12-88                                               DTSCS62
01245         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS62
01246         GO TO P8200-EXIT.                                         DTSCS62
01247                                                                   DTSCS62
01248      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS62
01249      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS62
01250      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS62
01251      IF LCCM-MSG                                                  DTSCS62
01252          GO TO P8200-EXIT.                                        DTSCS62
01253                                                                   DTSCS62
01254      PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT.               DTSCS62
01255                                                                   DTSCS62
01256      PERFORM S1120-READ-MFAS THRU S1120-EXIT.                     DTSCS62
01257      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS62
01258                                                                   DTSCS62
01259 *-----------------------------------------------------            DTSCS62
01260 *    OPERATORS WITH FIELD DESK AUTHORITY MAY UPDATE ALL           DTSCS62
01261 *    AVAILABLE FIELDS.  OTHER USERS WITH UPDATE ACCESS            DTSCS62
01262 *    TO THIS SCREEN MAY ONLY UPDATE CERTAIN FIELDS.               DTSCS62
01263 *-----------------------------------------------------            DTSCS62
01264      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS62
01265         PERFORM P8210-BUILD-MFAS-FLD-DSK THRU P8210-EXIT          DTSCS62
01266      ELSE                                                         DTSCS62
01267         PERFORM P8220-BUILD-MFAS-PARTIAL THRU P8220-EXIT.         DTSCS62
01268                                                                   DTSCS62
01269      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS62
01270                                                                   DTSCS62
01271 **** IF MAP-COPIES > +0                                           DTSCS62
01272 ****    PERFORM P8250-FIELD-MEMO THRU P8250-EXIT.                 DTSCS62
01273 **** END-IF.                                                      DTSCS62
01274                                                                   DTSCS62
01275 **** MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS62
01276 ***  MOVE MFAS-ASSIGN-NO TO WRK-MSG-ASSIGN-NO.                    DTSCS62
01277      MOVE MSG-E623-AREA  TO LCCM-MSG-AREA.                        DTSCS62
01278                                                                   DTSCS62
01279      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS62
01280  P8200-EXIT.                                                      DTSCS62
01281      EXIT.                                                        DTSCS62
01282      EJECT                                                        DTSCS62
01283  P8210-BUILD-MFAS-FLD-DSK.                                        DTSCS62
01284      MOVE SPACES              TO WRK-L331-REC-OCC-ID.             DTSCS62
01285      MOVE MFAS-ASSIGN-NO      TO WRK-L331-ASSIGN-NO.              DTSCS62
01286      MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID.                 DTSCS62
01287                                                                   DTSCS62
01288      MOVE MAP-COMPLETED-DATE-AREA TO L015-S-DATE-AREA.            DTSCS62
01289      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
01290                                                                   DTSCS62
01291      IF L015-DATE NOT = MFAS-COMPLETED-DATE                       DTSCS62
01292         MOVE 'MFAS-COMPLETED-DATE'  TO L331-FIELD-NAME            DTSCS62
01293         IF MFAS-COMPLETED-DATE = ZERO                             DTSCS62
01294            MOVE SPACES              TO L331-FROM-VALUE            DTSCS62
01295         ELSE                                                      DTSCS62
01296            MOVE MFAS-COMPLETED-DATE TO L001-FED-8-DATE-9          DTSCS62
01297            SET L001-FROM-FED-8      TO TRUE                       DTSCS62
01298            PERFORM S001-DATE        THRU S001-EXIT                DTSCS62
01299            MOVE L001-SLASH-DATE     TO L331-FROM-VALUE            DTSCS62
01300         END-IF                                                    DTSCS62
01301         IF L015-DATE = ZERO                                       DTSCS62
01302            MOVE SPACES              TO L331-TO-VALUE              DTSCS62
01303         ELSE                                                      DTSCS62
01304            MOVE L015-DATE           TO L001-FED-8-DATE-9          DTSCS62
01305            SET L001-FROM-FED-8      TO TRUE                       DTSCS62
01306            PERFORM S001-DATE        THRU S001-EXIT                DTSCS62
01307            MOVE L001-SLASH-DATE     TO L331-TO-VALUE              DTSCS62
01308         END-IF                                                    DTSCS62
01309         PERFORM S331-WRITE-MLOG     THRU S331-EXIT.               DTSCS62
01310                                                                   DTSCS62
01311      MOVE L015-DATE TO MFAS-COMPLETED-DATE                        DTSCS62
01312                                                                   DTSCS62
01313 *  INFORMATION RETURNED FROM L063 WILL BE NEEDED                  DTSCS62
01314      MOVE MAP-ASSIGN-TYPE TO L063-TYPE.                           DTSCS62
01315      PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT.           DTSCS62
01316      MOVE L063-AUDIT-IND TO MFAS-AUDIT-IND.                       DTSCS62
01317      MOVE L063-ACCOUNTING-DESK-IND TO MFAS-ACCOUNTING-DESK-IND.   DTSCS62
01318                                                                   DTSCS62
01319      IF MAP-ASSIGN-TYPE NOT = MFAS-ASSIGN-TYPE                    DTSCS62
01320          MOVE 'MFAS-ASSIGN-TYPE' TO L331-FIELD-NAME               DTSCS62
01321          MOVE MFAS-ASSIGN-TYPE   TO L331-FROM-VALUE               DTSCS62
01322          MOVE MAP-ASSIGN-TYPE    TO L331-TO-VALUE                 DTSCS62
01323          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS62
01324                                                                   DTSCS62
01325      MOVE MAP-ASSIGN-TYPE TO MFAS-ASSIGN-TYPE.                    DTSCS62
01326                                                                   DTSCS62
01327      IF (MFAS-STATUS-CD = 'A' AND MAP-STATUS-CD = 'C')            DTSCS62
01328                AND                                                DTSCS62
01329         (MFAS-AUDIT-88)                                           DTSCS62
01330          MOVE MAP-FLD-REP-ID TO L061-FLD-REP-ID                   DTSCS62
01331          IF L061-FLD-DESK-88                                      DTSCS62
01332              MOVE LENGTH OF R907-REC         TO R907-LENGTH       DTSCS62
01333              MOVE '695'                      TO R907-MSG-ID       DTSCS62
01334              MOVE WRK-EMP-NO                 TO R907-EMP-NO       DTSCS62
01335              MOVE WRK-R907-MSG1-LONG-TEXT    TO R907-MSG-TEXT     DTSCS62
01336              MOVE WRK-MODULE-NAME            TO R907-MODULE-NAME  DTSCS62
01337              MOVE R907-REC TO RSKL-REC                            DTSCS62
01338              PERFORM S825-WRITE THRU S825-EXIT                    DTSCS62
01339          ELSE                                                     DTSCS62
01340              PERFORM P9500-WRITE-R608 THRU P9500-EXIT.            DTSCS62
01341                                                                   DTSCS62
01342      IF MAP-STATUS-CD NOT = MFAS-STATUS-CD                        DTSCS62
01343          MOVE 'MFAS-STATUS-CD'   TO L331-FIELD-NAME               DTSCS62
01344          MOVE MFAS-STATUS-CD     TO L331-FROM-VALUE               DTSCS62
01345          MOVE MAP-STATUS-CD      TO L331-TO-VALUE                 DTSCS62
01346          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS62
01347                                                                   DTSCS62
01348      MOVE MAP-STATUS-CD TO MFAS-STATUS-CD.                        DTSCS62
01349                                                                   DTSCS62
01350      IF MAP-FLD-REP-ID  NOT = MFAS-FLD-REP-ID                     DTSCS62
01351          MOVE 'MFAS-FLD-REP-ID'  TO L331-FIELD-NAME               DTSCS62
01352          MOVE MFAS-FLD-REP-ID    TO L331-FROM-VALUE               DTSCS62
01353          MOVE MAP-FLD-REP-ID     TO L331-TO-VALUE                 DTSCS62
01354          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS62
01355                                                                   DTSCS62
01356      MOVE MAP-FLD-REP-ID TO MFAS-FLD-REP-ID.                      DTSCS62
01357      MOVE MAP-ATTACHMENTS-IND TO MFAS-ATTACHMENTS-IND.            DTSCS62
01358                                                                   DTSCS62
01359      MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA.                DTSCS62
01360      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
01361      MOVE L015-DATE TO MFAS-START-DATE.                           DTSCS62
01362                                                                   DTSCS62
01363      MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA.                  DTSCS62
01364      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
01365                                                                   DTSCS62
01366      IF L015-DATE NOT = MFAS-DUE-DATE                             DTSCS62
01367         MOVE 'MFAS-DUE-DATE'       TO L331-FIELD-NAME             DTSCS62
01368         IF MFAS-DUE-DATE = ZERO                                   DTSCS62
01369             MOVE SPACES TO L331-FROM-VALUE                        DTSCS62
01370         ELSE                                                      DTSCS62
01371             MOVE MFAS-DUE-DATE     TO L001-FED-8-DATE-9           DTSCS62
01372             SET L001-FROM-FED-8    TO TRUE                        DTSCS62
01373             PERFORM S001-DATE      THRU S001-EXIT                 DTSCS62
01374             MOVE L001-SLASH-DATE   TO L331-FROM-VALUE             DTSCS62
01375         END-IF                                                    DTSCS62
01376         IF L015-DATE = ZERO                                       DTSCS62
01377             MOVE SPACES TO L331-TO-VALUE                          DTSCS62
01378         ELSE                                                      DTSCS62
01379             MOVE L015-DATE         TO L001-FED-8-DATE-9           DTSCS62
01380             SET L001-FROM-FED-8    TO TRUE                        DTSCS62
01381             PERFORM S001-DATE      THRU S001-EXIT                 DTSCS62
01382             MOVE L001-SLASH-DATE   TO L331-TO-VALUE               DTSCS62
01383         END-IF                                                    DTSCS62
01384         PERFORM S331-WRITE-MLOG THRU S331-EXIT.                   DTSCS62
01385                                                                   DTSCS62
01386      MOVE L015-DATE TO MFAS-DUE-DATE.                             DTSCS62
01387                                                                   DTSCS62
01388                                                                   DTSCS62
01389      IF MAP-TAX-EXTRACT-YES                                       DTSCS62
01390         MOVE LCCM-CURR-RUN-DATE TO MFAS-TAX-DOWNLOAD-DATE         DTSCS62
01391         MOVE MFAS-TAX-DOWNLOAD-DATE TO L001-FED-8-DATE-9          DTSCS62
01392         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01393         MOVE L001-SLASH-DATE TO MAP-TAX-EXTRACT-DATE              DTSCS62
01394      END-IF.                                                      DTSCS62
01395                                                                   DTSCS62
01396      IF MAP-WAGE-EXTRACT-YES                                      DTSCS62
01397         MOVE LCCM-CURR-RUN-DATE TO MFAS-WAGE-DOWNLOAD-DATE        DTSCS62
01398         MOVE MFAS-WAGE-DOWNLOAD-DATE TO L001-FED-8-DATE-9         DTSCS62
01399         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01400         MOVE L001-SLASH-DATE TO MAP-WAGE-EXTRACT-DATE             DTSCS62
01401      END-IF.                                                      DTSCS62
01402                                                                   DTSCS62
01403      MOVE MAP-SOURCE-OP-ID TO MFAS-SOURCE-OP-ID.                  DTSCS62
01404      MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA.               DTSCS62
01405      PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT.                 DTSCS62
01406      IF L020-NO-ENTRY                                             DTSCS62
01407         MOVE +0 TO MFAS-CLAIMANT-SSN                              DTSCS62
01408         MOVE SPACE TO MFAS-CLAIMANT-NAME                          DTSCS62
01409      ELSE                                                         DTSCS62
01410         MOVE MAP-CLAIMANT-NAME TO MFAS-CLAIMANT-NAME              DTSCS62
01411         MOVE L020-SSN TO MFAS-CLAIMANT-SSN                        DTSCS62
01412      END-IF.                                                      DTSCS62
01413                                                                   DTSCS62
01414      MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.          DTSCS62
01415      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS62
01416      MOVE L018-EMP-NO TO MFAS-RELATED-EMP-NO.                     DTSCS62
01417                                                                   DTSCS62
01418 *    IF MAP-SIC-CD = LOW-VALUES OR SPACES                         DTSCS62
01419 *       MOVE SPACES TO MFAS-SIC-CD                                DTSCS62
01420 *    ELSE                                                         DTSCS62
01421 *       MOVE MAP-SIC-CD TO MFAS-SIC-CD                            DTSCS62
01422 *    END-IF.                                                      DTSCS62
01423 *                                                                 DTSCS62
01424 *    IF MAP-OWN-CD = LOW-VALUES OR SPACES                         DTSCS62
01425 *       MOVE SPACES TO MFAS-OWN-CD                                DTSCS62
01426 *    ELSE                                                         DTSCS62
01427 *       MOVE MAP-OWN-CD TO MFAS-OWN-CD                            DTSCS62
01428 *    END-IF.                                                      DTSCS62
01429 *                                                                 DTSCS62
01430 *    IF MAP-NAICS-CD = LOW-VALUES OR SPACES                       DTSCS62
01431 *       MOVE SPACES TO MFAS-NAICS-CD                              DTSCS62
01432 *    ELSE                                                         DTSCS62
01433 *       MOVE MAP-NAICS-CD TO MFAS-NAICS-CD                        DTSCS62
01434 *    END-IF.                                                      DTSCS62
01435                                                                   DTSCS62
01436      MOVE MAP-EMP-SIZE-IND TO MFAS-EMP-SIZE-IND.                  DTSCS62
01437                                                                   DTSCS62
01438      MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA.      DTSCS62
01439      MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA.          DTSCS62
01440      PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT.                   DTSCS62
01441      IF L024-START-NO-ENTRY                                       DTSCS62
01442         MOVE +0 TO MFAS-START-YRQ                                 DTSCS62
01443      ELSE                                                         DTSCS62
01444         MOVE L024-START-YRQ TO MFAS-START-YRQ                     DTSCS62
01445      END-IF.                                                      DTSCS62
01446                                                                   DTSCS62
01447      IF L024-END-NO-ENTRY                                         DTSCS62
01448         MOVE +0 TO MFAS-END-YRQ                                   DTSCS62
01449      ELSE                                                         DTSCS62
01450         MOVE L024-END-YRQ TO MFAS-END-YRQ                         DTSCS62
01451      END-IF.                                                      DTSCS62
01452                                                                   DTSCS62
01453      PERFORM VARYING WRK-CTR FROM 1 BY 1                          DTSCS62
01454      UNTIL WRK-CTR > MMAX-FAS-SEL-MAX                             DTSCS62
01455         IF MAP-AUDIT-SEL-REASON(WRK-CTR) = LOW-VALUES OR SPACES   DTSCS62
01456            MOVE SPACES TO MFAS-AUDIT-SEL-REASON (WRK-CTR)         DTSCS62
01457         ELSE                                                      DTSCS62
01458            MOVE MAP-AUDIT-SEL-REASON(WRK-CTR)                     DTSCS62
01459              TO MFAS-AUDIT-SEL-REASON(WRK-CTR)                    DTSCS62
01460            MOVE WRK-CTR TO MFAS-SEL-CNT                           DTSCS62
01461         END-IF                                                    DTSCS62
01462      END-PERFORM                                                  DTSCS62
01463                                                                   DTSCS62
01464      MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE                    DTSCS62
01465                                                                   DTSCS62
01466      MOVE +0       TO MFAS-TEXT-CNT.                              DTSCS62
01467                                                                   DTSCS62
01468      PERFORM P8216-TEXT THRU P8216-EXIT                           DTSCS62
01469      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS62
01470       UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX.                          DTSCS62
01471                                                                   DTSCS62
01472                                                                   DTSCS62
01473      MOVE MFAS-REC TO MSKL-REC.                                   DTSCS62
01474      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS62
01475                                                                   DTSCS62
01476      IF MAP-TAX-EXTRACT-YES                                       DTSCS62
01477         SET T021-DOWNLOAD-TAX TO TRUE                             DTSCS62
01478         PERFORM P9100-CREATE-T021 THRU P9100-EXIT.                DTSCS62
01479                                                                   DTSCS62
01480      IF MAP-WAGE-EXTRACT-YES                                      DTSCS62
01481         SET T021-DOWNLOAD-WAGE TO TRUE                            DTSCS62
01482         PERFORM P9100-CREATE-T021 THRU P9100-EXIT.                DTSCS62
01483                                                                   DTSCS62
01484  P8210-EXIT.                                                      DTSCS62
01485      EXIT.                                                        DTSCS62
01486                                                                   DTSCS62
01487  P8216-TEXT.                                                      DTSCS62
01488      IF MAP-TEXT(WRK-CTR) EQUAL LOW-VALUES OR SPACES              DTSCS62
01489         MOVE SPACES TO MFAS-TEXT(WRK-CTR)                         DTSCS62
01490      ELSE                                                         DTSCS62
01491         MOVE MAP-TEXT(WRK-CTR) TO MFAS-TEXT(WRK-CTR)              DTSCS62
01492         MOVE WRK-CTR TO MFAS-TEXT-CNT.                            DTSCS62
01493  P8216-EXIT. EXIT.                                                DTSCS62
01494                                                                   DTSCS62
01495  P8220-BUILD-MFAS-PARTIAL.                                        DTSCS62
01496      MOVE SPACES              TO WRK-L331-REC-OCC-ID.             DTSCS62
01497      MOVE MFAS-ASSIGN-NO      TO WRK-L331-ASSIGN-NO.              DTSCS62
01498      MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID.                 DTSCS62
01499                                                                   DTSCS62
01500      MOVE MAP-COMPLETED-DATE-AREA TO L015-S-DATE-AREA.            DTSCS62
01501      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
01502                                                                   DTSCS62
01503      IF L015-DATE NOT = MFAS-COMPLETED-DATE                       DTSCS62
01504         MOVE 'MFAS-COMPLETED-DATE'  TO L331-FIELD-NAME            DTSCS62
01505         IF MFAS-COMPLETED-DATE = ZERO                             DTSCS62
01506            MOVE SPACES              TO L331-FROM-VALUE            DTSCS62
01507         ELSE                                                      DTSCS62
01508            MOVE MFAS-COMPLETED-DATE TO L001-FED-8-DATE-9          DTSCS62
01509            SET L001-FROM-FED-8      TO TRUE                       DTSCS62
01510            PERFORM S001-DATE        THRU S001-EXIT                DTSCS62
01511            MOVE L001-SLASH-DATE     TO L331-FROM-VALUE            DTSCS62
01512         END-IF                                                    DTSCS62
01513         IF L015-DATE = ZERO                                       DTSCS62
01514            MOVE SPACES              TO L331-TO-VALUE              DTSCS62
01515         ELSE                                                      DTSCS62
01516            MOVE L015-DATE           TO L001-FED-8-DATE-9          DTSCS62
01517            SET L001-FROM-FED-8      TO TRUE                       DTSCS62
01518            PERFORM S001-DATE        THRU S001-EXIT                DTSCS62
01519            MOVE L001-SLASH-DATE     TO L331-TO-VALUE              DTSCS62
01520         END-IF                                                    DTSCS62
01521         PERFORM S331-WRITE-MLOG     THRU S331-EXIT.               DTSCS62
01522                                                                   DTSCS62
01523      MOVE L015-DATE TO MFAS-COMPLETED-DATE                        DTSCS62
01524                                                                   DTSCS62
01525                                                                   DTSCS62
01526      IF (MFAS-STATUS-CD = 'A' AND MAP-STATUS-CD = 'C')            DTSCS62
01527                AND                                                DTSCS62
01528         (MFAS-AUDIT-88)                                           DTSCS62
01529          MOVE MAP-FLD-REP-ID TO L061-FLD-REP-ID                   DTSCS62
01530          IF L061-FLD-DESK-88                                      DTSCS62
01531              MOVE LENGTH OF R907-REC         TO R907-LENGTH       DTSCS62
01532              MOVE '695'                      TO R907-MSG-ID       DTSCS62
01533              MOVE WRK-EMP-NO                 TO R907-EMP-NO       DTSCS62
01534              MOVE WRK-R907-MSG1-LONG-TEXT    TO R907-MSG-TEXT     DTSCS62
01535              MOVE WRK-MODULE-NAME            TO R907-MODULE-NAME  DTSCS62
01536              MOVE R907-REC TO RSKL-REC                            DTSCS62
01537              PERFORM S825-WRITE THRU S825-EXIT                    DTSCS62
01538          ELSE                                                     DTSCS62
01539              PERFORM P9500-WRITE-R608 THRU P9500-EXIT.            DTSCS62
01540                                                                   DTSCS62
01541      IF MAP-STATUS-CD NOT = MFAS-STATUS-CD                        DTSCS62
01542          MOVE 'MFAS-STATUS-CD'   TO L331-FIELD-NAME               DTSCS62
01543          MOVE MFAS-STATUS-CD     TO L331-FROM-VALUE               DTSCS62
01544          MOVE MAP-STATUS-CD      TO L331-TO-VALUE                 DTSCS62
01545          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS62
01546                                                                   DTSCS62
01547      MOVE MAP-STATUS-CD TO MFAS-STATUS-CD.                        DTSCS62
01548                                                                   DTSCS62
01549      IF MAP-TAX-EXTRACT-YES                                       DTSCS62
01550         MOVE LCCM-CURR-RUN-DATE TO MFAS-TAX-DOWNLOAD-DATE         DTSCS62
01551         MOVE MFAS-TAX-DOWNLOAD-DATE TO L001-FED-8-DATE-9          DTSCS62
01552         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01553         MOVE L001-SLASH-DATE TO MAP-TAX-EXTRACT-DATE              DTSCS62
01554      END-IF.                                                      DTSCS62
01555                                                                   DTSCS62
01556      IF MAP-WAGE-EXTRACT-YES                                      DTSCS62
01557         MOVE LCCM-CURR-RUN-DATE TO MFAS-WAGE-DOWNLOAD-DATE        DTSCS62
01558         MOVE MFAS-WAGE-DOWNLOAD-DATE TO L001-FED-8-DATE-9         DTSCS62
01559         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS62
01560         MOVE L001-SLASH-DATE TO MAP-WAGE-EXTRACT-DATE             DTSCS62
01561      END-IF.                                                      DTSCS62
01562                                                                   DTSCS62
01563      IF MFAS-NON-AUDIT-88                                         DTSCS62
01564         PERFORM P8221-YRQ-DATES THRU P8221-EXIT.                  DTSCS62
01565                                                                   DTSCS62
01566      MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE                    DTSCS62
01567                                                                   DTSCS62
01568      MOVE +0       TO MFAS-TEXT-CNT.                              DTSCS62
01569                                                                   DTSCS62
01570      PERFORM P8216-TEXT THRU P8216-EXIT                           DTSCS62
01571      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS62
01572       UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX.                          DTSCS62
01573                                                                   DTSCS62
01574      MOVE MFAS-REC TO MSKL-REC.                                   DTSCS62
01575      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS62
01576                                                                   DTSCS62
01577      IF MAP-TAX-EXTRACT-YES                                       DTSCS62
01578         SET T021-DOWNLOAD-TAX TO TRUE                             DTSCS62
01579         PERFORM P9100-CREATE-T021 THRU P9100-EXIT.                DTSCS62
01580                                                                   DTSCS62
01581      IF MAP-WAGE-EXTRACT-YES                                      DTSCS62
01582         SET T021-DOWNLOAD-WAGE TO TRUE                            DTSCS62
01583         PERFORM P9100-CREATE-T021 THRU P9100-EXIT.                DTSCS62
01584                                                                   DTSCS62
01585      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS62
01586                                                                   DTSCS62
01587  P8220-EXIT.                                                      DTSCS62
01588      EXIT.                                                        DTSCS62
01589                                                                   DTSCS62
01590  P8221-YRQ-DATES.                                                 DTSCS62
01591      MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA.      DTSCS62
01592      MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA.          DTSCS62
01593      PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT.                   DTSCS62
01594      IF L024-START-NO-ENTRY                                       DTSCS62
01595         NEXT SENTENCE                                             DTSCS62
01596      ELSE                                                         DTSCS62
01597         MOVE L024-START-YRQ TO MFAS-START-YRQ                     DTSCS62
01598      END-IF.                                                      DTSCS62
01599                                                                   DTSCS62
01600      IF L024-END-NO-ENTRY                                         DTSCS62
01601         NEXT SENTENCE                                             DTSCS62
01602      ELSE                                                         DTSCS62
01603         MOVE L024-END-YRQ TO MFAS-END-YRQ                         DTSCS62
01604      END-IF.                                                      DTSCS62
01605                                                                   DTSCS62
01606  P8221-EXIT.                                                      DTSCS62
01607      EXIT.                                                        DTSCS62
01608 *P8250-FIELD-MEMO.                                                DTSCS62
01609 *****MOVE MFAS-EMP-NO TO L351-EMP-NO.                             DTSCS62
01610 *****MOVE MFAS-ASSIGN-NO TO L351-ASSIGN-NO.                       DTSCS62
01611 *****MOVE MAP-PRINTER-ID TO L351-PRINTER-ID.                      DTSCS62
01612 *****MOVE MAP-COPIES TO L351-COPY-CNT.                            DTSCS62
01613 *****MOVE LCCM-TASK-START-DISP-DATE TO L351-TASK-START-DISP-DATE. DTSCS62
01614 *****MOVE LCCM-TASK-START-DISP-TIME TO L351-TASK-START-DISP-TIME. DTSCS62
01615 *****MOVE LCCM-TS-NAME-PREFIX       TO L351-TS-NAME-PREFIX.       DTSCS62
01616                                                                   DTSCS62
01617 *****PERFORM S351-PRINT THRU S351-EXIT.                           DTSCS62
01618                                                                   DTSCS62
01619 *****IF L351-PRINT-FAILED                                         DTSCS62
01620 ********MOVE ' (BUT THE PRINT FAILED!)' TO WRK-PRINTER-MSG.       DTSCS62
01621 *P8250-EXIT. EXIT.                                                DTSCS62
01622                                                                   DTSCS62
01623 /*****************************************************************DTSCS62
01624 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS62
01625 ******************************************************************DTSCS62
01626                                                                   DTSCS62
01627  P8300-DEL.                                                       DTSCS62
01628      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS62
01629                                                                   DTSCS62
01630      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS62
01631                                                                   DTSCS62
01632      IF LCCM-F12-88                                               DTSCS62
01633         MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID                     DTSCS62
01634         GO TO P8300-EXIT.                                         DTSCS62
01635                                                                   DTSCS62
01636      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS62
01637                                                                   DTSCS62
01638      MOVE 'D' TO L221-UPDATE-FUNCTION.                            DTSCS62
01639      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS62
01640      IF LCCM-MSG                                                  DTSCS62
01641          GO TO P8300-EXIT.                                        DTSCS62
01642                                                                   DTSCS62
01643      PERFORM S1120-READ-MFAS THRU S1120-EXIT.                     DTSCS62
01644      PERFORM S810-DELETE THRU S810-EXIT.                          DTSCS62
01645                                                                   DTSCS62
01646      PERFORM P8310-DELETE-MFAR THRU P8310-EXIT.                   DTSCS62
01647      PERFORM P8320-CHECK-OTHER THRU P8320-EXIT.                   DTSCS62
01648                                                                   DTSCS62
01649                                                                   DTSCS62
01650      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS62
01651                                                                   DTSCS62
01652      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS62
01653                                                                   DTSCS62
01654      MOVE WRK-ASSIGN-NO TO WRK-DISPLAY.                           DTSCS62
01655      MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1.             DTSCS62
01656      MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2.             DTSCS62
01657                                                                   DTSCS62
01658                                                                   DTSCS62
01659      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS62
01660                                                                   DTSCS62
01661      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS62
01662                                                                   DTSCS62
01663      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS62
01664                                                                   DTSCS62
01665      MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS62
01666  P8300-EXIT.                                                      DTSCS62
01667      EXIT.                                                        DTSCS62
01668      EJECT                                                        DTSCS62
01669                                                                   DTSCS62
01670  P8310-DELETE-MFAR.                                               DTSCS62
01671      MOVE LOW-VALUES TO MFAR-KEY-AREA.                            DTSCS62
01672      MOVE MFAS-EMP-NO TO MFAR-EMP-NO.                             DTSCS62
01673      MOVE MFAS-ASSIGN-NO TO MFAR-ASSIGN-NO.                       DTSCS62
01674      SET MFAR-FAR-88 TO TRUE.                                     DTSCS62
01675      MOVE MFAR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS62
01676      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS62
01677      PERFORM P8311-LOOP THRU P8311-EXIT                           DTSCS62
01678          UNTIL L810-NO-REC-88.                                    DTSCS62
01679  P8310-EXIT.                                                      DTSCS62
01680      EXIT.                                                        DTSCS62
01681      EJECT                                                        DTSCS62
01682                                                                   DTSCS62
01683  P8311-LOOP.                                                      DTSCS62
01684      MOVE MSKL-REC TO MFAR-REC.                                   DTSCS62
01685                                                                   DTSCS62
01686      IF MFAR-ASSIGN-NO = MFAS-ASSIGN-NO                           DTSCS62
01687          NEXT SENTENCE                                            DTSCS62
01688      ELSE                                                         DTSCS62
01689          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS62
01690          SET L810-NO-REC-88 TO TRUE                               DTSCS62
01691          GO TO P8311-EXIT.                                        DTSCS62
01692                                                                   DTSCS62
01693       PERFORM S810-END-BROWSE THRU S810-EXIT.                     DTSCS62
01694       PERFORM S810-DELETE THRU S810-EXIT.                         DTSCS62
01695       PERFORM S810-START-BROWSE THRU S810-EXIT.                   DTSCS62
01696  P8311-EXIT.                                                      DTSCS62
01697      EXIT.                                                        DTSCS62
01698      EJECT                                                        DTSCS62
01699                                                                   DTSCS62
01700  P8320-CHECK-OTHER.                                               DTSCS62
01701      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS62
01702                                                                   DTSCS62
01703      MOVE MPRF-MFAS-IND TO WRK-MFAS-IND.                          DTSCS62
01704                                                                   DTSCS62
01705      MOVE LOW-VALUES TO MFAS-KEY-AREA.                            DTSCS62
01706      MOVE WRK-EMP-NO TO MFAS-EMP-NO.                              DTSCS62
01707      SET MFAS-FAS-88 TO TRUE.                                     DTSCS62
01708      MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS62
01709      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS62
01710      IF L810-OK-88                                                DTSCS62
01711          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS62
01712          SET MPRF-MFAS-EXISTS-88 TO TRUE                          DTSCS62
01713      ELSE                                                         DTSCS62
01714          SET MPRF-NO-MFAS-88 TO TRUE.                             DTSCS62
01715      IF WRK-MFAS-IND = MPRF-MFAS-IND                              DTSCS62
01716          NEXT SENTENCE                                            DTSCS62
01717      ELSE                                                         DTSCS62
01718          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                DTSCS62
01719          MOVE MPRF-REC TO MSKL-REC                                DTSCS62
01720          PERFORM S810-REWRITE THRU S810-EXIT.                     DTSCS62
01721  P8320-EXIT.                                                      DTSCS62
01722      EXIT.                                                        DTSCS62
01723      EJECT                                                        DTSCS62
01724                                                                   DTSCS62
01725  P8810-LOCK-EMPLOYER.                                             DTSCS62
01726      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS62
01727      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS62
01728      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS62
01729      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS62
01730      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS62
01731      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS62
01732      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS62
01733      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS62
01734      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS62
01735                                                                   DTSCS62
01736      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS62
01737  P8810-EXIT.                                                      DTSCS62
01738      EXIT.                                                        DTSCS62
01739      EJECT                                                        DTSCS62
01740                                                                   DTSCS62
01741  P8900-INITIALIZE-L331.                                           DTSCS62
01742      MOVE WRK-EMP-NO TO L331-EMP-NO.                              DTSCS62
01743                                                                   DTSCS62
01744      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.               DTSCS62
01745                                                                   DTSCS62
01746      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.         DTSCS62
01747                                                                   DTSCS62
01748      MOVE LCCM-OP-ID TO L331-OP-ID.                               DTSCS62
01749                                                                   DTSCS62
01750  P8900-EXIT.                                                      DTSCS62
01751      EXIT.                                                        DTSCS62
01752                                                                   DTSCS62
01753 *                                                                 DTSCS62
01754  P9100-CREATE-T021.                                               DTSCS62
01755      MOVE WRK-EMP-NO TO T021-EMP-NO.                              DTSCS62
01756      MOVE LCCM-OP-ID TO T021-OP-ID.                               DTSCS62
01757      MOVE WRK-SCR-ID TO T021-SCR-ID.                              DTSCS62
01758      MOVE LCCM-TASK-START-DATE TO T021-SYS-DATE.                  DTSCS62
01759      MOVE LCCM-TASK-START-TIME TO T021-SYS-TIME.                  DTSCS62
01760      MOVE MFAS-ASSIGN-NO TO T021-ASSIGN-NO.                       DTSCS62
01761      MOVE LENGTH OF T021-REC TO T021-LENGTH.                      DTSCS62
01762      MOVE T021-REC TO RSKL-REC.                                   DTSCS62
01763      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS62
01764  P9100-EXIT.                                                      DTSCS62
01765      EXIT.                                                        DTSCS62
01766                                                                   DTSCS62
01767 /*****************************************************************DTSCS62
01768 * E                                                               DTSCS62
01769 ******************************************************************DTSCS62
01770                                                                   DTSCS62
01771  P9500-WRITE-R608.                                                DTSCS62
01772      MOVE LENGTH OF R608-REC TO R608-LENGTH.                      DTSCS62
01773                                                                   DTSCS62
01774      MOVE LCCM-OP-ID TO R608-OP-ID.                               DTSCS62
01775                                                                   DTSCS62
01776      MOVE WRK-EMP-NO TO R608-EMP-NO.                              DTSCS62
01777                                                                   DTSCS62
01778      MOVE MAP-FLD-REP-ID TO R608-FIELD-REP-ID.                    DTSCS62
01779                                                                   DTSCS62
01780      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS62
01781                                                                   DTSCS62
01782      SET L111-LOOKUP-TAD-88 TO TRUE.                              DTSCS62
01783                                                                   DTSCS62
01784      SET L111-ID-NO-TAD-MAIL-88 TO TRUE.                          DTSCS62
01785                                                                   DTSCS62
01786      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS62
01787                                                                   DTSCS62
01788      IF L111-ADDR-NOT-FOUND-88                                    DTSCS62
01789          MOVE ALL '*' TO L112-MAILING-ADDRESS                     DTSCS62
01790                          L112-ZIP                                 DTSCS62
01791                          L112-ADVANCED-BARCODE                    DTSCS62
01792      ELSE                                                         DTSCS62
01793          SET L112-TAD-ADDR-88 TO TRUE                             DTSCS62
01794          SET L112-ANCHOR-LAST-88 TO TRUE                          DTSCS62
01795          MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME              DTSCS62
01796          MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA          DTSCS62
01797          PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                 DTSCS62
01798                                                                   DTSCS62
01799      MOVE L112-MAILING-ADDRESS TO R608-FMT-ADDR.                  DTSCS62
01800                                                                   DTSCS62
01801      MOVE L112-ZIP TO R608-ZIP.                                   DTSCS62
01802                                                                   DTSCS62
01803      MOVE L112-ADVANCED-BARCODE TO R608-ADVANCED-BARCODE.         DTSCS62
01804                                                                   DTSCS62
01805      MOVE R608-REC TO RSKL-REC.                                   DTSCS62
01806                                                                   DTSCS62
01807      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS62
01808  P9500-EXIT. EXIT.                                                DTSCS62
01809  P9600-BROWSE-MFSL.                                               DTSCS62
01810      MOVE MSKL-REC TO MFSL-REC.                                   DTSCS62
01811                                                                   DTSCS62
01812      IF MFSL-ASSIGN-NO = WRK-ASSIGN-NO                            DTSCS62
01813          NEXT SENTENCE                                            DTSCS62
01814      ELSE                                                         DTSCS62
01815          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS62
01816          SET L810-NO-REC-88 TO TRUE                               DTSCS62
01817          GO TO P9600-EXIT.                                        DTSCS62
01818                                                                   DTSCS62
01819        IF MFSL-STATUS-CD = 'P'                                    DTSCS62
01820          MOVE 'Y' TO WS-REC-FOUND-IND                             DTSCS62
01821      ELSE                                                         DTSCS62
01822          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS62
01823  P9600-EXIT.                                                      DTSCS62
01824      EXIT.                                                        DTSCS62
01825 /*****************************************************************DTSCS62
01826 * LINKS TO UTILITY MODULES                                        DTSCS62
01827 ******************************************************************DTSCS62
01828                                                                   DTSCS62
01829  S001-FROM-FED-8.                                                 DTSCS62
01830      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS62
01831      GO TO S001-DATE.                                             DTSCS62
01832                                                                   DTSCS62
01833  S001-FROM-ABS-DATE.                                              DTSCS62
01834      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS62
01835      GO TO S001-DATE.                                             DTSCS62
01836                                                                   DTSCS62
01837  S001-DATE.                                                       DTSCS62
01838      EXEC CICS LINK                                               DTSCS62
01839          PROGRAM('DTSCU001')                                      DTSCS62
01840          COMMAREA(L001-COMM-AREA)                                 DTSCS62
01841      END-EXEC.                                                    DTSCS62
01842  S001-EXIT.                                                       DTSCS62
01843      EXIT.                                                        DTSCS62
01844                                                                   DTSCS62
01845  S004-FROM-5.                                                     DTSCS62
01846      SET L004-FROM-5 TO TRUE.                                     DTSCS62
01847      GO TO S004-YRQ.                                              DTSCS62
01848                                                                   DTSCS62
01849  S004-FROM-ABS.                                                   DTSCS62
01850      SET L004-FROM-ABS TO TRUE.                                   DTSCS62
01851      GO TO S004-YRQ.                                              DTSCS62
01852                                                                   DTSCS62
01853  S004-FROM-DATE.                                                  DTSCS62
01854      SET L004-FROM-DATE TO TRUE.                                  DTSCS62
01855      GO TO S004-YRQ.                                              DTSCS62
01856                                                                   DTSCS62
01857  S004-YRQ.                                                        DTSCS62
01858      EXEC CICS LINK                                               DTSCS62
01859          PROGRAM('DTSCU004')                                      DTSCS62
01860          COMMAREA(L004-COMM-AREA)                                 DTSCS62
01861      END-EXEC.                                                    DTSCS62
01862  S004-EXIT.                                                       DTSCS62
01863      EXIT.                                                        DTSCS62
01864                                                                   DTSCS62
01865  S015-DATE-FROM-SCREEN.                                           DTSCS62
01866      EXEC CICS LINK                                               DTSCS62
01867          PROGRAM('DTSCU015')                                      DTSCS62
01868          COMMAREA(L015-COMM-AREA)                                 DTSCS62
01869      END-EXEC.                                                    DTSCS62
01870  S015-EXIT.                                                       DTSCS62
01871      EXIT.                                                        DTSCS62
01872                                                                   DTSCS62
01873  S018-EMP-NO-FROM-SCREEN.                                         DTSCS62
01874      EXEC CICS LINK                                               DTSCS62
01875          PROGRAM('DTSCU018')                                      DTSCS62
01876          COMMAREA(L018-COMM-AREA)                                 DTSCS62
01877      END-EXEC.                                                    DTSCS62
01878  S018-EXIT.                                                       DTSCS62
01879      EXIT.                                                        DTSCS62
01880                                                                   DTSCS62
01881  S020-SSN-FROM-SCREEN.                                            DTSCS62
01882      EXEC CICS LINK                                               DTSCS62
01883          PROGRAM('DTSCU020')                                      DTSCS62
01884          COMMAREA(L020-COMM-AREA)                                 DTSCS62
01885      END-EXEC.                                                    DTSCS62
01886  S020-EXIT.                                                       DTSCS62
01887      EXIT.                                                        DTSCS62
01888                                                                   DTSCS62
01889  S022-ASSIGN-NO-FROM-SCREEN.                                      DTSCS62
01890      EXEC CICS LINK                                               DTSCS62
01891          PROGRAM('DTSCU022')                                      DTSCS62
01892          COMMAREA(L022-COMM-AREA)                                 DTSCS62
01893      END-EXEC.                                                    DTSCS62
01894  S022-EXIT.                                                       DTSCS62
01895      EXIT.                                                        DTSCS62
01896                                                                   DTSCS62
01897  S024-EDIT-QTR-SPAN.                                              DTSCS62
01898      SET L024-END-REQUIRED TO TRUE.                               DTSCS62
01899      EXEC CICS LINK                                               DTSCS62
01900          PROGRAM('DTSCU024')                                      DTSCS62
01901          COMMAREA(L024-COMM-AREA)                                 DTSCS62
01902      END-EXEC.                                                    DTSCS62
01903  S024-EXIT.                                                       DTSCS62
01904      EXIT.                                                        DTSCS62
01905                                                                   DTSCS62
01906  S036-EDIT-STATUS-CD.                                             DTSCS62
01907      SET L036-MFAS-STATUS-IND TO TRUE.                            DTSCS62
01908      GO TO S036-FS-EDIT-DSCR.                                     DTSCS62
01909                                                                   DTSCS62
01910  S036-EMP-SIZE.                                                   DTSCS62
01911      SET L036-MFAS-EMP-SIZE-IND TO TRUE.                          DTSCS62
01912      GO TO S036-FS-EDIT-DSCR.                                     DTSCS62
01913                                                                   DTSCS62
01914  S036-AUDIT-SEL-REASON.                                           DTSCS62
01915      SET L036-MFAS-AUDIT-SEL-REASON TO TRUE.                      DTSCS62
01916      GO TO S036-FS-EDIT-DSCR.                                     DTSCS62
01917                                                                   DTSCS62
01918  S036-FS-EDIT-DSCR.                                               DTSCS62
01919      EXEC CICS LINK                                               DTSCS62
01920          PROGRAM('DTSCU036')                                      DTSCS62
01921          COMMAREA(L036-COMM-AREA)                                 DTSCS62
01922      END-EXEC.                                                    DTSCS62
01923  S036-EXIT.                                                       DTSCS62
01924      EXIT.                                                        DTSCS62
01925                                                                   DTSCS62
01926 *S039-SIC-OWN-CODE-EDIT.                                          DTSCS62
01927 *****EXEC CICS LINK                                               DTSCS62
01928 *****    PROGRAM('DTSCU039')                                      DTSCS62
01929 *****    COMMAREA(L039-COMM-AREA)                                 DTSCS62
01930 *****    LENGTH(L039-LENGTH)                                      DTSCS62
01931 *****END-EXEC.                                                    DTSCS62
01932 *****                                                             DTSCS62
01933 *****IF L039-SIC-FILE-CLOSED                                      DTSCS62
01934 *****    MOVE L039-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
01935 *****    SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
01936 *****    SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
01937 *****    GO TO MAINLINE-EXIT.                                     DTSCS62
01938 *****                                                             DTSCS62
01939 *S039-EXIT.                                                       DTSCS62
01940 *****EXIT.                                                        DTSCS62
01941                                                                   DTSCS62
01942  S061-FIELD-ZIP-REP-ID.                                           DTSCS62
01943      EXEC CICS LINK                                               DTSCS62
01944          PROGRAM('DTSCU061')                                      DTSCS62
01945          COMMAREA(L061-COMM-AREA)                                 DTSCS62
01946      END-EXEC.                                                    DTSCS62
01947                                                                   DTSCS62
01948      IF L061-FILE-CLOSED                                          DTSCS62
01949          MOVE L061-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
01950          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
01951          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
01952          GO TO MAINLINE-EXIT.                                     DTSCS62
01953                                                                   DTSCS62
01954  S061-EXIT.                                                       DTSCS62
01955      EXIT.                                                        DTSCS62
01956                                                                   DTSCS62
01957  S062-FLD-REP-ID-DESC.                                            DTSCS62
01958      EXEC CICS LINK                                               DTSCS62
01959          PROGRAM('DTSCU062')                                      DTSCS62
01960          COMMAREA(L062-COMM-AREA)                                 DTSCS62
01961      END-EXEC.                                                    DTSCS62
01962                                                                   DTSCS62
01963      IF L062-FILE-CLOSED                                          DTSCS62
01964          MOVE L062-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
01965          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
01966          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
01967          GO TO MAINLINE-EXIT.                                     DTSCS62
01968                                                                   DTSCS62
01969  S062-EXIT.                                                       DTSCS62
01970      EXIT.                                                        DTSCS62
01971                                                                   DTSCS62
01972  S063-FIELD-ASSIGNMENT-EDIT.                                      DTSCS62
01973      EXEC CICS LINK                                               DTSCS62
01974          PROGRAM('DTSCU063')                                      DTSCS62
01975          COMMAREA(L063-COMM-AREA)                                 DTSCS62
01976      END-EXEC.                                                    DTSCS62
01977                                                                   DTSCS62
01978      IF L063-FILE-CLOSED                                          DTSCS62
01979          MOVE L063-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
01980          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
01981          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
01982          GO TO MAINLINE-EXIT.                                     DTSCS62
01983                                                                   DTSCS62
01984  S063-EXIT.                                                       DTSCS62
01985      EXIT.                                                        DTSCS62
01986                                                                   DTSCS62
01987  S071-FROM-LAST-NAME-FIRST.                                       DTSCS62
01988      SET L071-FROM-LAST-NAME-FIRST TO TRUE.                       DTSCS62
01989      GO TO S071-NAME-EDIT.                                        DTSCS62
01990                                                                   DTSCS62
01991  S071-NAME-EDIT.                                                  DTSCS62
01992      EXEC CICS LINK                                               DTSCS62
01993          PROGRAM('DTSCU071')                                      DTSCS62
01994          COMMAREA(L071-COMM-AREA)                                 DTSCS62
01995      END-EXEC.                                                    DTSCS62
01996  S071-EXIT.                                                       DTSCS62
01997      EXIT.                                                        DTSCS62
01998                                                                   DTSCS62
01999  S081-CLAIMANT-NAME.                                              DTSCS62
02000      EXEC CICS LINK                                               DTSCS62
02001          PROGRAM('DTSCU081')                                      DTSCS62
02002          COMMAREA(L081-COMM-AREA)                                 DTSCS62
02003      END-EXEC.                                                    DTSCS62
02004                                                                   DTSCS62
02005      IF L081-FILE-CLOSED                                          DTSCS62
02006          MOVE L081-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02007          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02008          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02009          GO TO MAINLINE-EXIT.                                     DTSCS62
02010                                                                   DTSCS62
02011  S081-EXIT.                                                       DTSCS62
02012      EXIT.                                                        DTSCS62
02013                                                                   DTSCS62
02014  S082-OP-ID-EDIT.                                                 DTSCS62
02015      EXEC CICS LINK                                               DTSCS62
02016          PROGRAM('DTSCU082')                                      DTSCS62
02017          COMMAREA(L082-COMM-AREA)                                 DTSCS62
02018      END-EXEC.                                                    DTSCS62
02019                                                                   DTSCS62
02020      IF L082-FILE-CLOSED                                          DTSCS62
02021          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02022          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02023          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02024          GO TO MAINLINE-EXIT.                                     DTSCS62
02025                                                                   DTSCS62
02026  S082-EXIT.                                                       DTSCS62
02027      EXIT.                                                        DTSCS62
02028                                                                   DTSCS62
02029  S111-ADDR-LOOKUP.                                                DTSCS62
02030      EXEC CICS LINK                                               DTSCS62
02031          PROGRAM('DTSCU111')                                      DTSCS62
02032          COMMAREA(L111-COMM-AREA)                                 DTSCS62
02033      END-EXEC.                                                    DTSCS62
02034                                                                   DTSCS62
02035      IF L111-FILE-CLOSED-88                                       DTSCS62
02036          MOVE L111-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02037          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02038          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02039          GO TO MAINLINE-EXIT.                                     DTSCS62
02040                                                                   DTSCS62
02041  S111-EXIT.                                                       DTSCS62
02042      EXIT.                                                        DTSCS62
02043                                                                   DTSCS62
02044  S112-ADDR-FORMAT.                                                DTSCS62
02045      EXEC CICS LINK                                               DTSCS62
02046          PROGRAM('DTSCU112')                                      DTSCS62
02047          COMMAREA(L112-COMM-AREA)                                 DTSCS62
02048      END-EXEC.                                                    DTSCS62
02049                                                                   DTSCS62
02050  S112-EXIT.                                                       DTSCS62
02051      EXIT.                                                        DTSCS62
02052                                                                   DTSCS62
02053  S221-EMP-LOCK.                                                   DTSCS62
02054      SET L221-START-UPDATE TO TRUE.                               DTSCS62
02055      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS62
02056                                                                   DTSCS62
02057  S221-EMP-UNLOCK.                                                 DTSCS62
02058      SET L221-END-UPDATE TO TRUE.                                 DTSCS62
02059      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS62
02060                                                                   DTSCS62
02061  S221-EMP-LOCK-UNLOCK.                                            DTSCS62
02062      EXEC CICS LINK                                               DTSCS62
02063          PROGRAM('DTSCU221')                                      DTSCS62
02064          COMMAREA(L221-COMM-AREA)                                 DTSCS62
02065      END-EXEC.                                                    DTSCS62
02066                                                                   DTSCS62
02067      IF L221-FILE-CLOSED                                          DTSCS62
02068          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02069          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02070          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02071          GO TO MAINLINE-EXIT.                                     DTSCS62
02072                                                                   DTSCS62
02073      IF L221-NOT-OK                                               DTSCS62
02074          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS62
02075  S221-EXIT.                                                       DTSCS62
02076      EXIT.                                                        DTSCS62
02077                                                                   DTSCS62
02078                                                                   DTSCS62
02079  S331-WRITE-MLOG.                                                 DTSCS62
02080      EXEC CICS LINK                                               DTSCS62
02081          PROGRAM('DTSCU331')                                      DTSCS62
02082          COMMAREA(L331-COMM-AREA)                                 DTSCS62
02083      END-EXEC.                                                    DTSCS62
02084                                                                   DTSCS62
02085      IF L331-FILE-CLOSED                                          DTSCS62
02086          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02087          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02088          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02089          GO TO MAINLINE-EXIT.                                     DTSCS62
02090                                                                   DTSCS62
02091  S331-EXIT.                                                       DTSCS62
02092      EXIT.                                                        DTSCS62
02093                                                                   DTSCS62
02094 *S351-PRINT.                                                      DTSCS62
02095 *****EXEC CICS LINK                                               DTSCS62
02096 *********PROGRAM('DTSCU351')                                      DTSCS62
02097 *********COMMAREA(L351-COMM-AREA)                                 DTSCS62
02098 *****END-EXEC.                                                    DTSCS62
02099 *S351-EXIT.                                                       DTSCS62
02100 *****EXIT.                                                        DTSCS62
02101                                                                   DTSCS62
02102  S803-REQ-SCR-ID-EDIT.                                            DTSCS62
02103      EXEC CICS LINK                                               DTSCS62
02104          PROGRAM ('DTSCU803')                                     DTSCS62
02105          COMMAREA (DFHCOMMAREA)                                   DTSCS62
02106      END-EXEC.                                                    DTSCS62
02107  S803-EXIT.                                                       DTSCS62
02108      EXIT.                                                        DTSCS62
02109                                                                   DTSCS62
02110  S804-INVALID-KEY.                                                DTSCS62
02111      EXEC CICS LINK                                               DTSCS62
02112          PROGRAM ('DTSCU804')                                     DTSCS62
02113          COMMAREA (DFHCOMMAREA)                                   DTSCS62
02114      END-EXEC.                                                    DTSCS62
02115  S804-EXIT.                                                       DTSCS62
02116      EXIT.                                                        DTSCS62
02117                                                                   DTSCS62
02118  S805-MSG-AREA.                                                   DTSCS62
02119      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS62
02120                                                                   DTSCS62
02121      EXEC CICS LINK                                               DTSCS62
02122          PROGRAM ('DTSCU805')                                     DTSCS62
02123          COMMAREA (L805-COMM-AREA)                                DTSCS62
02124      END-EXEC.                                                    DTSCS62
02125                                                                   DTSCS62
02126      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS62
02127  S805-EXIT.                                                       DTSCS62
02128      EXIT.                                                        DTSCS62
02129      EJECT                                                        DTSCS62
02130  S810-READ.                                                       DTSCS62
02131      SET L810-READ-88 TO TRUE.                                    DTSCS62
02132      GO TO S810-IO.                                               DTSCS62
02133                                                                   DTSCS62
02134  S810-START-BROWSE.                                               DTSCS62
02135      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS62
02136      GO TO S810-IO.                                               DTSCS62
02137                                                                   DTSCS62
02138  S810-READ-NEXT.                                                  DTSCS62
02139      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS62
02140      GO TO S810-IO.                                               DTSCS62
02141                                                                   DTSCS62
02142  S810-READ-PREV.                                                  DTSCS62
02143      SET L810-READ-PREV-88 TO TRUE.                               DTSCS62
02144      GO TO S810-IO.                                               DTSCS62
02145                                                                   DTSCS62
02146  S810-END-BROWSE.                                                 DTSCS62
02147      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS62
02148      GO TO S810-IO.                                               DTSCS62
02149                                                                   DTSCS62
02150  S810-COUNT.                                                      DTSCS62
02151      SET L810-COUNT-88 TO TRUE.                                   DTSCS62
02152      GO TO S810-IO.                                               DTSCS62
02153                                                                   DTSCS62
02154  S810-REWRITE.                                                    DTSCS62
02155      SET L810-REWRITE-88 TO TRUE.                                 DTSCS62
02156      GO TO S810-IO.                                               DTSCS62
02157                                                                   DTSCS62
02158  S810-WRITE.                                                      DTSCS62
02159      SET L810-WRITE-88 TO TRUE.                                   DTSCS62
02160      GO TO S810-IO.                                               DTSCS62
02161                                                                   DTSCS62
02162  S810-DELETE.                                                     DTSCS62
02163      SET L810-DELETE-88 TO TRUE.                                  DTSCS62
02164      GO TO S810-IO.                                               DTSCS62
02165                                                                   DTSCS62
02166  S810-IO.                                                         DTSCS62
02167                                                                   DTSCS62
02168      EXEC CICS LINK                                               DTSCS62
02169          PROGRAM ('DTSCU810')                                     DTSCS62
02170          COMMAREA (L810-COMM-AREA)                                DTSCS62
02171      END-EXEC.                                                    DTSCS62
02172                                                                   DTSCS62
02173      IF L810-FILE-CLOSED-88                                       DTSCS62
02174          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02175          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02176          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02177          GO TO MAINLINE-EXIT.                                     DTSCS62
02178  S810-EXIT.                                                       DTSCS62
02179      EXIT.                                                        DTSCS62
02180      EJECT                                                        DTSCS62
02181  S821-START-BROWSE.                                               DTSCS62
02182      SET L821-START-BROWSE-88 TO TRUE.                            DTSCS62
02183      GO TO S821-ALT-IO.                                           DTSCS62
02184  S821-END-BROWSE.                                                 DTSCS62
02185      SET L821-END-BROWSE-88 TO TRUE.                              DTSCS62
02186      GO TO S821-ALT-IO.                                           DTSCS62
02187  S821-ALT-IO.                                                     DTSCS62
02188      EXEC CICS LINK                                               DTSCS62
02189          PROGRAM ('DTSCU821')                                     DTSCS62
02190          COMMAREA (L821-COMM-AREA)                                DTSCS62
02191      END-EXEC.                                                    DTSCS62
02192      IF L821-FILE-CLOSED-88                                       DTSCS62
02193          MOVE L821-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02194          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02195          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02196          GO TO MAINLINE-EXIT.                                     DTSCS62
02197  S821-EXIT. EXIT.                                                 DTSCS62
02198                                                                   DTSCS62
02199  S825-WRITE.                                                      DTSCS62
02200      SET L825-WRITE-88 TO TRUE.                                   DTSCS62
02201      GO TO S825-O.                                                DTSCS62
02202                                                                   DTSCS62
02203  S825-O.                                                          DTSCS62
02204                                                                   DTSCS62
02205                                                                   DTSCS62
02206      EXEC CICS LINK                                               DTSCS62
02207          PROGRAM ('DTSCU825')                                     DTSCS62
02208          COMMAREA (L825-COMM-AREA)                                DTSCS62
02209      END-EXEC.                                                    DTSCS62
02210                                                                   DTSCS62
02211      IF L825-FILE-CLOSED-88                                       DTSCS62
02212          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS62
02213          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS62
02214          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS62
02215          GO TO MAINLINE-EXIT.                                     DTSCS62
02216  S825-EXIT.                                                       DTSCS62
02217      EXIT.                                                        DTSCS62
02218      EJECT                                                        DTSCS62
02219  S851-SCREEN-PROCESSING.                                          DTSCS62
02220      EXEC CICS LINK                                               DTSCS62
02221          PROGRAM ('DTSCU851')                                     DTSCS62
02222          COMMAREA (L851-COMM-AREA)                                DTSCS62
02223      END-EXEC.                                                    DTSCS62
02224  S851-EXIT.                                                       DTSCS62
02225      EXIT.                                                        DTSCS62
02226                                                                   DTSCS62
02227  S899-ABEND.                                                      DTSCS62
02228      EXEC CICS ABEND                                              DTSCS62
02229          ABCODE(WRK-ABEND-CD)                                     DTSCS62
02230      END-EXEC.                                                    DTSCS62
02231  S899-EXIT.                                                       DTSCS62
02232      EXIT.                                                        DTSCS62
02233 /*****************************************************************DTSCS62
02234 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS62
02235 *    CERTAIN FIELDS ARE OPEN TO FIELD STAFF FOR UPDATE.           DTSCS62
02236 *    S1010 IS EXECUTED IF THE OPERATOR HAS FIELD DESK AUTHORITY   DTSCS62
02237 *    (FOR WHOM ALL FIELDS ARE AVAILABLE).                         DTSCS62
02238 *    S1020 IS EXECUTED IF THE OPERATOR HAS ONLY UPDATE AUTHORTIY. DTSCS62
02239 ******************************************************************DTSCS62
02240  S1000-SCREEN-EDITS.                                              DTSCS62
02241                                                                   DTSCS62
02242      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS62
02243         PERFORM S1010-FIELD-DESK-EDITS  THRU S1010-EXIT           DTSCS62
02244      ELSE                                                         DTSCS62
02245         PERFORM S1020-FIELD-REP-EDITS   THRU S1020-EXIT.          DTSCS62
02246                                                                   DTSCS62
02247  S1000-EXIT.                                                      DTSCS62
02248      EXIT.                                                        DTSCS62
02249                                                                   DTSCS62
02250  S1010-FIELD-DESK-EDITS.                                          DTSCS62
02251      PERFORM S1200-COMPLETED-DATE THRU S1200-EXIT.                DTSCS62
02252      PERFORM S1300-ASSIGN-STATUS  THRU S1300-EXIT.                DTSCS62
02253      PERFORM S1400-ASSIGN-TYPE THRU S1400-EXIT.                   DTSCS62
02254                                                                   DTSCS62
02255      IF LCCM-MSG                                                  DTSCS62
02256         GO TO S1010-EXIT.                                         DTSCS62
02257                                                                   DTSCS62
02258      PERFORM S1500-START-DATE THRU S1500-EXIT.                    DTSCS62
02259      PERFORM S1600-DUE-DATE THRU S1600-EXIT.                      DTSCS62
02260      PERFORM S1700-FLD-REP-ID THRU S1700-EXIT.                    DTSCS62
02261      PERFORM S1800-ATTACHMENTS THRU S1800-EXIT.                   DTSCS62
02262      PERFORM S1900-SOURCE-OP-ID THRU S1900-EXIT.                  DTSCS62
02263      PERFORM S2000-TAX-EXTRACT THRU S2000-EXIT.                   DTSCS62
02264      PERFORM S2100-WAGE-EXTRACT THRU S2100-EXIT.                  DTSCS62
02265      PERFORM S2200-QTR-RANGE THRU S2200-EXIT.                     DTSCS62
02266      PERFORM S2300-EMP-SIZE-IND  THRU S2300-EXIT                  DTSCS62
02267      PERFORM S2400-AUDIT-SEL-REASON  THRU S2400-EXIT              DTSCS62
02268      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS62
02269       UNTIL  WRK-CTR > MMAX-FAS-SEL-MAX.                          DTSCS62
02270      PERFORM S2500-RELATED-EMP-NO THRU S2500-EXIT.                DTSCS62
02271      PERFORM S2600-CLAIMANT-SSN THRU S2600-EXIT.                  DTSCS62
02272      PERFORM S2700-CLAIMANT-NAME THRU S2700-EXIT.                 DTSCS62
02273      SKIP1                                                        DTSCS62
02274      PERFORM S3100-TEXT THRU S3100-EXIT                           DTSCS62
02275      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS62
02276       UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX.                          DTSCS62
02277      SKIP1                                                        DTSCS62
02278      IF LCCM-MSG                                                  DTSCS62
02279         GO TO S1010-EXIT.                                         DTSCS62
02280                                                                   DTSCS62
02281  S1010-EXIT.                                                      DTSCS62
02282      EXIT.                                                        DTSCS62
02283                                                                   DTSCS62
02284  S1020-FIELD-REP-EDITS.                                           DTSCS62
02285      PERFORM S1200-COMPLETED-DATE THRU S1200-EXIT.                DTSCS62
02286      PERFORM S1300-ASSIGN-STATUS  THRU S1300-EXIT.                DTSCS62
02287                                                                   DTSCS62
02288      IF LCCM-MSG                                                  DTSCS62
02289         GO TO S1020-EXIT.                                         DTSCS62
02290                                                                   DTSCS62
02291      PERFORM S2000-TAX-EXTRACT THRU S2000-EXIT.                   DTSCS62
02292      PERFORM S2100-WAGE-EXTRACT THRU S2100-EXIT.                  DTSCS62
02293                                                                   DTSCS62
02294      IF WRK-EXTRACT-REQ-YES-88                                    DTSCS62
02295          PERFORM S2200-QTR-RANGE THRU S2200-EXIT.                 DTSCS62
02296                                                                   DTSCS62
02297      PERFORM S3100-TEXT THRU S3100-EXIT                           DTSCS62
02298      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS62
02299       UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX.                          DTSCS62
02300                                                                   DTSCS62
02301  S1020-EXIT.                                                      DTSCS62
02302      EXIT.                                                        DTSCS62
02303                                                                   DTSCS62
02304  S1100-EDIT-KEY.                                                  DTSCS62
02305      PERFORM S1101-ASSIGN-NO           THRU S1101-EXIT.           DTSCS62
02306  S1100-EXIT. EXIT.                                                DTSCS62
02307 /*****************************************************************DTSCS62
02308 *                                                                 DTSCS62
02309 ******************************************************************DTSCS62
02310  S1101-ASSIGN-NO.                                                 DTSCS62
02311      MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA.            DTSCS62
02312      PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT.           DTSCS62
02313                                                                   DTSCS62
02314      IF L022-NO-ENTRY                                             DTSCS62
02315         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS62
02316         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS62
02317         GO TO S1101-EXIT.                                         DTSCS62
02318                                                                   DTSCS62
02319      IF L022-NOT-VALID                                            DTSCS62
02320         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS62
02321         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS62
02322         GO TO S1101-EXIT.                                         DTSCS62
02323                                                                   DTSCS62
02324      MOVE L022-ASSIGN-NO             TO WRK-ASSIGN-NO             DTSCS62
02325                                                                   DTSCS62
02326      PERFORM S1110-THRU-FAN THRU S1110-EXIT.                      DTSCS62
02327                                                                   DTSCS62
02328  S1101-EXIT. EXIT.                                                DTSCS62
02329                                                                   DTSCS62
02330  S1110-THRU-FAN.                                                  DTSCS62
02331      MOVE LOW-VALUES TO IFAN-KEY-AREA.                            DTSCS62
02332      SET IFAN-FAN-88 TO TRUE.                                     DTSCS62
02333      MOVE L022-ASSIGN-NO TO IFAN-ASSIGN-NO.                       DTSCS62
02334      MOVE ZEROS TO IFAN-EMP-NO.                                   DTSCS62
02335      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS62
02336      IF L821-OK-88                                                DTSCS62
02337         PERFORM S821-END-BROWSE  THRU S821-EXIT                   DTSCS62
02338         IF IFAN-ASSIGN-NO = L022-ASSIGN-NO                        DTSCS62
02339            MOVE IFAN-EMP-NO TO WRK-EMP-NO                         DTSCS62
02340         ELSE                                                      DTSCS62
02341            SET L821-NO-REC-88 TO TRUE                             DTSCS62
02342            MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA                DTSCS62
02343            PERFORM S1199-ERROR          THRU S1199-EXIT           DTSCS62
02344            GO TO S1110-EXIT                                       DTSCS62
02345      ELSE                                                         DTSCS62
02346         MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA                   DTSCS62
02347         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS62
02348         GO TO S1110-EXIT.                                         DTSCS62
02349                                                                   DTSCS62
02350  S1110-EXIT.                                                      DTSCS62
02351      EXIT.                                                        DTSCS62
02352                                                                   DTSCS62
02353  S1120-READ-MFAS.                                                 DTSCS62
02354      MOVE LOW-VALUES TO MFAS-KEY-AREA.                            DTSCS62
02355      SET MFAS-FAS-88 TO TRUE.                                     DTSCS62
02356      MOVE IFAN-EMP-NO TO MFAS-EMP-NO.                             DTSCS62
02357      MOVE IFAN-ASSIGN-NO TO MFAS-ASSIGN-NO.                       DTSCS62
02358      MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS62
02359                                                                   DTSCS62
02360      PERFORM S810-READ THRU S810-EXIT.                            DTSCS62
02361      IF L810-NO-REC-88                                            DTSCS62
02362         MOVE IFAN-EMP-NO TO MSG-EMP-NO-IN-ERR                     DTSCS62
02363         MOVE MSG-E626-AREA TO LCCM-MSG-AREA                       DTSCS62
02364         SET LCCM-REQ-SCR-SF-88 TO TRUE                            DTSCS62
02365         SET LCCM-LINK-SCREEN-88 TO TRUE                           DTSCS62
02366         GO TO MAINLINE-EXIT                                       DTSCS62
02367      ELSE                                                         DTSCS62
02368         MOVE MSKL-REC TO MFAS-REC.                                DTSCS62
02369  S1120-EXIT.                                                      DTSCS62
02370      EXIT.                                                        DTSCS62
02371                                                                   DTSCS62
02372  S1130-READ-MPRF.                                                 DTSCS62
02373      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS62
02374      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS62
02375      SET MPRF-PRF-88 TO TRUE.                                     DTSCS62
02376      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS62
02377      PERFORM S810-READ THRU S810-EXIT.                            DTSCS62
02378      IF L810-NO-REC-88                                            DTSCS62
02379          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS62
02380          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS62
02381      ELSE                                                         DTSCS62
02382          MOVE MSKL-REC TO MPRF-REC                                DTSCS62
02383          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS62
02384  S1130-EXIT.                                                      DTSCS62
02385      EXIT.                                                        DTSCS62
02386                                                                   DTSCS62
02387  S1199-ERROR.                                                     DTSCS62
02388      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-NO-1-A         DTSCS62
02389                                         MAP-ASSIGN-NO-2-A.        DTSCS62
02390      IF LCCM-NO-MSG                                               DTSCS62
02391         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS62
02392         MOVE CATB-CURSOR             TO MAP-ASSIGN-NO-1-L         DTSCS62
02393         SET CURSOR-SET-YES TO TRUE.                               DTSCS62
02394  S1199-EXIT. EXIT.                                                DTSCS62
02395                                                                   DTSCS62
02396 /*****************************************************************DTSCS62
02397 *                                                                *DTSCS62
02398 ******************************************************************DTSCS62
02399  S1200-COMPLETED-DATE.                                            DTSCS62
02400                                                                   DTSCS62
02401      MOVE MAP-COMPLETED-DATE-AREA TO L015-S-DATE-AREA.            DTSCS62
02402      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
02403                                                                   DTSCS62
02404      IF L015-NO-ENTRY                                             DTSCS62
02405         IF MAP-STATUS-CD = 'C' OR 'P'                             DTSCS62
02406            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS62
02407            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS62
02408            GO TO S1200-EXIT                                       DTSCS62
02409         ELSE                                                      DTSCS62
02410            GO TO S1200-EXIT                                       DTSCS62
02411         END-IF.                                                   DTSCS62
02412                                                                   DTSCS62
02413      IF MAP-STATUS-CD = 'A'                                       DTSCS62
02414      AND L015-VALID                                               DTSCS62
02415         MOVE 'C' TO MAP-STATUS-CD                                 DTSCS62
02416      END-IF.                                                      DTSCS62
02417                                                                   DTSCS62
02418      IF MAP-STATUS-CD = 'C'                                       DTSCS62
02419      OR MAP-STATUS-CD = 'P'                                       DTSCS62
02420        IF L015-NOT-VALID                                          DTSCS62
02421           MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA             DTSCS62
02422           PERFORM S1201-ERROR    THRU S1201-EXIT                  DTSCS62
02423        ELSE                                                       DTSCS62
02424           PERFORM S1210-CROSS-EDITS THRU S1210-EXIT               DTSCS62
02425      ELSE                                                         DTSCS62
02426         MOVE MSG-E62D-AREA TO WRK-MSG-AREA                        DTSCS62
02427         PERFORM S1201-ERROR    THRU S1201-EXIT.                   DTSCS62
02428  S1200-EXIT. EXIT.                                                DTSCS62
02429                                                                   DTSCS62
02430  S1201-ERROR.                                                     DTSCS62
02431      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COMPLETED-DATE-MO-A   DTSCS62
02432                              MAP-COMPLETED-DATE-DA-A              DTSCS62
02433                              MAP-COMPLETED-DATE-YR-A.             DTSCS62
02434      IF LCCM-NO-MSG                                               DTSCS62
02435         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02436         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS62
02437         MOVE CATB-CURSOR             TO MAP-COMPLETED-DATE-MO-L.  DTSCS62
02438  S1201-EXIT. EXIT.                                                DTSCS62
02439                                                                   DTSCS62
02440  S1210-CROSS-EDITS.                                               DTSCS62
02441      IF L015-DATE > LCCM-CURR-RUN-DATE                            DTSCS62
02442          MOVE MSG-E627-AREA TO WRK-MSG-AREA                       DTSCS62
02443          PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS62
02444          GO TO S1210-EXIT.                                        DTSCS62
02445                                                                   DTSCS62
02446      IF MFAS-PROCESSED-DATE = +0                                  DTSCS62
02447          NEXT SENTENCE                                            DTSCS62
02448      ELSE                                                         DTSCS62
02449          IF L015-DATE > MFAS-PROCESSED-DATE                       DTSCS62
02450              MOVE MSG-E628-AREA TO WRK-MSG-AREA                   DTSCS62
02451              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS62
02452              GO TO S1210-EXIT.                                    DTSCS62
02453                                                                   DTSCS62
02454          IF L015-DATE < MFAS-START-DATE                           DTSCS62
02455              MOVE MSG-E630-AREA TO WRK-MSG-AREA                   DTSCS62
02456              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS62
02457              GO TO S1210-EXIT.                                    DTSCS62
02458  S1210-EXIT.                                                      DTSCS62
02459      EXIT.                                                        DTSCS62
02460 /*****************************************************************DTSCS62
02461 *                                                                *DTSCS62
02462 ******************************************************************DTSCS62
02463  S1300-ASSIGN-STATUS.                                             DTSCS62
02464                                                                   DTSCS62
02465      MOVE MAP-STATUS-CD  TO L036-CD.                              DTSCS62
02466      PERFORM S036-EDIT-STATUS-CD THRU S036-EXIT.                  DTSCS62
02467      MOVE L036-SHORT-DSCR TO MAP-STATUS-CD-DESC.                  DTSCS62
02468                                                                   DTSCS62
02469      IF L036-NOT-VALID                                            DTSCS62
02470         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS62
02471         PERFORM S1301-ERROR    THRU S1301-EXIT                    DTSCS62
02472         GO TO S1300-EXIT                                          DTSCS62
02473      ELSE                                                         DTSCS62
02474      IF (MFAS-STATUS-PROCESSED-88                                 DTSCS62
02475          AND MAP-STATUS-CD NOT = 'P')                             DTSCS62
02476         MOVE MSG-E622-AREA    TO WRK-MSG-AREA                     DTSCS62
02477         PERFORM S1301-ERROR    THRU S1301-EXIT                    DTSCS62
02478         GO TO S1300-EXIT                                          DTSCS62
02479      ELSE                                                         DTSCS62
02480      IF (NOT MFAS-STATUS-PROCESSED-88                             DTSCS62
02481          AND MAP-STATUS-CD = 'P')                                 DTSCS62
02482         MOVE MSG-E622-AREA    TO WRK-MSG-AREA                     DTSCS62
02483         PERFORM S1301-ERROR    THRU S1301-EXIT                    DTSCS62
02484         GO TO S1300-EXIT                                          DTSCS62
02485      END-IF.                                                      DTSCS62
02486      IF (NOT MFAS-STATUS-HELD-88 AND                              DTSCS62
02487          NOT MFAS-STATUS-KILLED-88                                DTSCS62
02488          AND MAP-STATUS-CD = 'H' OR 'K')                          DTSCS62
02489          PERFORM S1350-CHECK-OPEN-APPN  THRU S1350-EXIT           DTSCS62
02490          IF WS-REC-FOUND-IND = 'Y'                                DTSCS62
02491             MOVE MSG-E62H-AREA    TO WRK-MSG-AREA                 DTSCS62
02492             PERFORM S1301-ERROR    THRU S1301-EXIT.               DTSCS62
02493  S1300-EXIT. EXIT.                                                DTSCS62
02494                                                                   DTSCS62
02495  S1301-ERROR.                                                     DTSCS62
02496      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-CD-A.           DTSCS62
02497      IF LCCM-NO-MSG                                               DTSCS62
02498         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02499         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS62
02500         MOVE CATB-CURSOR             TO MAP-STATUS-CD-L.          DTSCS62
02501  S1301-EXIT. EXIT.                                                DTSCS62
02502                                                                   DTSCS62
02503  S1350-CHECK-OPEN-APPN.                                           DTSCS62
02504                                                                   DTSCS62
02505       MOVE LOW-VALUES TO MFSL-KEY-AREA.                           DTSCS62
02506       MOVE WRK-EMP-NO TO MFSL-EMP-NO.                             DTSCS62
02507       MOVE WRK-ASSIGN-NO TO MFSL-ASSIGN-NO.                       DTSCS62
02508       SET MFSL-FSL-88 TO TRUE.                                    DTSCS62
02509       MOVE MFSL-KEY-AREA TO MSKL-KEY-AREA.                        DTSCS62
02510       PERFORM S810-START-BROWSE THRU S810-EXIT.                   DTSCS62
02511       IF L810-NO-REC-88                                           DTSCS62
02512           GO TO S1350-EXIT.                                       DTSCS62
02513                                                                   DTSCS62
02514       MOVE 'N' TO WS-REC-FOUND-IND.                               DTSCS62
02515       PERFORM P9600-BROWSE-MFSL THRU P9600-EXIT                   DTSCS62
02516           UNTIL (L810-NO-REC-88)                                  DTSCS62
02517                     OR                                            DTSCS62
02518           (WS-REC-FOUND-IND = 'Y').                               DTSCS62
02519                                                                   DTSCS62
02520  S1350-EXIT. EXIT.                                                DTSCS62
02521 /*****************************************************************DTSCS62
02522 *                                                                *DTSCS62
02523 ******************************************************************DTSCS62
02524  S1400-ASSIGN-TYPE.                                               DTSCS62
02525                                                                   DTSCS62
02526      IF MAP-ASSIGN-TYPE EQUAL LOW-VALUES OR SPACES                DTSCS62
02527         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS62
02528         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS62
02529      ELSE                                                         DTSCS62
02530         MOVE MAP-ASSIGN-TYPE TO L063-TYPE                         DTSCS62
02531         PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT         DTSCS62
02532         IF L063-NOT-VALID                                         DTSCS62
02533            MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA            DTSCS62
02534            PERFORM S1401-ERROR   THRU S1401-EXIT                  DTSCS62
02535         ELSE                                                      DTSCS62
02536            PERFORM S1410-CROSS-EDITS THRU S1410-EXIT.             DTSCS62
02537                                                                   DTSCS62
02538  S1400-EXIT. EXIT.                                                DTSCS62
02539                                                                   DTSCS62
02540  S1401-ERROR.                                                     DTSCS62
02541      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-TYPE-A.        DTSCS62
02542      IF LCCM-NO-MSG                                               DTSCS62
02543         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02544         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02545         MOVE CATB-CURSOR              TO MAP-ASSIGN-TYPE-L.       DTSCS62
02546  S1401-EXIT. EXIT.                                                DTSCS62
02547                                                                   DTSCS62
02548  S1410-CROSS-EDITS.                                               DTSCS62
02549      IF NOT L063-AUDIT-88                                         DTSCS62
02550          IF MFAS-STATUS-PROCESSED-88                              DTSCS62
02551              MOVE MSG-E621-AREA TO WRK-MSG-AREA                   DTSCS62
02552              PERFORM S1401-ERROR THRU S1401-EXIT.                 DTSCS62
02553  S1410-EXIT.                                                      DTSCS62
02554      EXIT.                                                        DTSCS62
02555 /*****************************************************************DTSCS62
02556 *                                                                *DTSCS62
02557 ******************************************************************DTSCS62
02558  S1500-START-DATE.                                                DTSCS62
02559      SET WRK-START-DATE-ERROR-NO TO TRUE.                         DTSCS62
02560      MOVE +0 TO WRK-START-DATE.                                   DTSCS62
02561                                                                   DTSCS62
02562      MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA.                DTSCS62
02563      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
02564                                                                   DTSCS62
02565      IF L015-NO-ENTRY                                             DTSCS62
02566         IF L063-VERIF-AUDIT-88                                    DTSCS62
02567            PERFORM S1550-NEXT-QTR THRU S1550-EXIT                 DTSCS62
02568         ELSE                                                      DTSCS62
02569            MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY                 DTSCS62
02570                                       WRK-START-DATE              DTSCS62
02571         END-IF                                                    DTSCS62
02572         MOVE WRK-DISPLAY-MO TO MAP-START-DATE-MO                  DTSCS62
02573         MOVE WRK-DISPLAY-DA TO MAP-START-DATE-DA                  DTSCS62
02574         MOVE WRK-DISPLAY-YR TO MAP-START-DATE-YR                  DTSCS62
02575      ELSE                                                         DTSCS62
02576      IF L015-NOT-VALID                                            DTSCS62
02577         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS62
02578         PERFORM S1501-ERROR    THRU S1501-EXIT                    DTSCS62
02579      ELSE                                                         DTSCS62
02580         MOVE L015-DATE TO WRK-START-DATE.                         DTSCS62
02581  S1500-EXIT. EXIT.                                                DTSCS62
02582                                                                   DTSCS62
02583  S1501-ERROR.                                                     DTSCS62
02584      SET WRK-START-DATE-ERROR-YES TO TRUE.                        DTSCS62
02585      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-START-DATE-MO-A       DTSCS62
02586                              MAP-START-DATE-DA-A                  DTSCS62
02587                              MAP-START-DATE-YR-A.                 DTSCS62
02588      IF LCCM-NO-MSG                                               DTSCS62
02589         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02590         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS62
02591         MOVE CATB-CURSOR             TO MAP-START-DATE-MO-L.      DTSCS62
02592  S1501-EXIT. EXIT.                                                DTSCS62
02593                                                                   DTSCS62
02594  S1550-NEXT-QTR.                                                  DTSCS62
02595      MOVE LCCM-CURR-RUN-DATE TO L004-DATE.                        DTSCS62
02596      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCS62
02597      ADD +1 TO L004-ABS-QTR.                                      DTSCS62
02598      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSCS62
02599      MOVE L004-QTR-START-DATE TO WRK-DISPLAY                      DTSCS62
02600                                  WRK-START-DATE.                  DTSCS62
02601  S1550-EXIT. EXIT.                                                DTSCS62
02602 /*****************************************************************DTSCS62
02603 *                                                                *DTSCS62
02604 ******************************************************************DTSCS62
02605  S1600-DUE-DATE.                                                  DTSCS62
02606      MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA.                  DTSCS62
02607      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
02608                                                                   DTSCS62
02609      IF MAP-STATUS-CD = 'K'                                       DTSCS62
02610          IF L015-NO-ENTRY                                         DTSCS62
02611              GO TO S1600-EXIT                                     DTSCS62
02612          ELSE                                                     DTSCS62
02613              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS62
02614              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS62
02615              GO TO S1600-EXIT.                                    DTSCS62
02616                                                                   DTSCS62
02617      IF L015-NO-ENTRY                                             DTSCS62
02618         IF WRK-START-DATE-ERROR-YES                               DTSCS62
02619            NEXT SENTENCE                                          DTSCS62
02620         ELSE                                                      DTSCS62
02621         IF L063-NO-DEFAULT-DUE-88                                 DTSCS62
02622            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS62
02623            PERFORM S1601-ERROR THRU S1601-EXIT                    DTSCS62
02624         ELSE                                                      DTSCS62
02625         IF L063-DEFAULT-DUE-NXT-Q-END-88                          DTSCS62
02626            MOVE LCCM-CURR-RUN-DATE TO L004-DATE                   DTSCS62
02627            PERFORM S004-FROM-DATE THRU S004-EXIT                  DTSCS62
02628            ADD +1 TO L004-ABS-QTR                                 DTSCS62
02629            PERFORM S004-FROM-ABS THRU S004-EXIT                   DTSCS62
02630            MOVE L004-QTR-END-DATE TO WRK-DISPLAY                  DTSCS62
02631            MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO                 DTSCS62
02632            MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA                 DTSCS62
02633            MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR                 DTSCS62
02634            PERFORM S1610-START-DUE-CROSS-EDIT THRU S1610-EXIT     DTSCS62
02635         ELSE                                                      DTSCS62
02636            MOVE WRK-START-DATE TO L001-FED-8-DATE-9               DTSCS62
02637            PERFORM S001-FROM-FED-8 THRU S001-EXIT                 DTSCS62
02638            ADD L063-DEFAULT-DUE-DAYS TO L001-JUL-ABS-DAY          DTSCS62
02639            PERFORM S001-FROM-ABS-DATE THRU S001-EXIT              DTSCS62
02640            MOVE L001-FED-8-DATE-9 TO WRK-DISPLAY                  DTSCS62
02641            MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO                 DTSCS62
02642            MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA                 DTSCS62
02643            MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR                 DTSCS62
02644            PERFORM S1610-START-DUE-CROSS-EDIT THRU S1610-EXIT     DTSCS62
02645      ELSE                                                         DTSCS62
02646      IF L015-NOT-VALID                                            DTSCS62
02647         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS62
02648         PERFORM S1601-ERROR   THRU S1601-EXIT                     DTSCS62
02649      ELSE                                                         DTSCS62
02650         PERFORM S1610-START-DUE-CROSS-EDIT THRU S1610-EXIT.       DTSCS62
02651  S1600-EXIT. EXIT.                                                DTSCS62
02652                                                                   DTSCS62
02653  S1601-ERROR.                                                     DTSCS62
02654      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DUE-DATE-MO-A         DTSCS62
02655                                         MAP-DUE-DATE-DA-A         DTSCS62
02656                                         MAP-DUE-DATE-YR-A.        DTSCS62
02657      IF LCCM-NO-MSG                                               DTSCS62
02658         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02659         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS62
02660         MOVE CATB-CURSOR             TO MAP-DUE-DATE-MO-L.        DTSCS62
02661  S1601-EXIT. EXIT.                                                DTSCS62
02662                                                                   DTSCS62
02663  S1610-START-DUE-CROSS-EDIT.                                      DTSCS62
02664      IF WRK-START-DATE = +0                                       DTSCS62
02665          GO TO S1610-EXIT.                                        DTSCS62
02666                                                                   DTSCS62
02667      MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA.                  DTSCS62
02668      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS62
02669      IF L015-VALID                                                DTSCS62
02670          NEXT SENTENCE                                            DTSCS62
02671      ELSE                                                         DTSCS62
02672          GO TO S1610-EXIT.                                        DTSCS62
02673                                                                   DTSCS62
02674      IF WRK-START-DATE > L015-DATE                                DTSCS62
02675          MOVE MSG-E62C-AREA TO WRK-MSG-AREA                       DTSCS62
02676          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS62
02677          PERFORM S1601-ERROR THRU S1601-EXIT.                     DTSCS62
02678  S1610-EXIT.                                                      DTSCS62
02679      EXIT.                                                        DTSCS62
02680 /*****************************************************************DTSCS62
02681 *                                                                *DTSCS62
02682 ******************************************************************DTSCS62
02683  S1700-FLD-REP-ID.                                                DTSCS62
02684      IF MAP-FLD-REP-ID EQUAL LOW-VALUES OR SPACES                 DTSCS62
02685         PERFORM S1710-GET-REP THRU S1710-EXIT                     DTSCS62
02686      ELSE                                                         DTSCS62
02687         MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID                    DTSCS62
02688         PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT               DTSCS62
02689         IF L062-NOT-VALID                                         DTSCS62
02690            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS62
02691            PERFORM S1701-ERROR THRU S1701-EXIT                    DTSCS62
02692         ELSE                                                      DTSCS62
02693            NEXT SENTENCE.                                         DTSCS62
02694  S1700-EXIT. EXIT.                                                DTSCS62
02695                                                                   DTSCS62
02696  S1701-ERROR.                                                     DTSCS62
02697      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-FLD-REP-ID-A.        DTSCS62
02698      IF LCCM-NO-MSG                                               DTSCS62
02699         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02700         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02701         MOVE CATB-CURSOR              TO MAP-FLD-REP-ID-L.        DTSCS62
02702  S1701-EXIT. EXIT.                                                DTSCS62
02703                                                                   DTSCS62
02704  S1710-GET-REP.                                                   DTSCS62
02705      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS62
02706          MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP                        DTSCS62
02707          MOVE MPRF-FLD-ST  TO L061-FLD-ST                         DTSCS62
02708          MOVE MPRF-EMP-NO TO L061-EMP-NO                          DTSCS62
02709          PERFORM S061-FIELD-ZIP-REP-ID THRU S061-EXIT             DTSCS62
02710          MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID                   DTSCS62
02711      ELSE                                                         DTSCS62
02712          IF L063-ACCOUNTING-YES-88                                DTSCS62
02713              MOVE 'AD' TO MAP-FLD-REP-ID                          DTSCS62
02714          ELSE                                                     DTSCS62
02715              MOVE 'FD' TO MAP-FLD-REP-ID                          DTSCS62
02716          END-IF                                                   DTSCS62
02717      END-IF.                                                      DTSCS62
02718  S1710-EXIT.                                                      DTSCS62
02719      EXIT.                                                        DTSCS62
02720 /*****************************************************************DTSCS62
02721 *                                                                *DTSCS62
02722 ******************************************************************DTSCS62
02723  S1800-ATTACHMENTS.                                               DTSCS62
02724      IF (MAP-ATTACHMENTS-IND = LOW-VALUES OR SPACES)              DTSCS62
02725            MOVE L063-DEFAULT-ATTACH-IND TO MAP-ATTACHMENTS-IND    DTSCS62
02726      ELSE                                                         DTSCS62
02727      IF MAP-ATTACHMENTS-IND-VALID                                 DTSCS62
02728         NEXT SENTENCE                                             DTSCS62
02729      ELSE                                                         DTSCS62
02730         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS62
02731         PERFORM S1801-ERROR THRU S1801-EXIT.                      DTSCS62
02732  S1800-EXIT. EXIT.                                                DTSCS62
02733                                                                   DTSCS62
02734  S1801-ERROR.                                                     DTSCS62
02735      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTACHMENTS-IND-A.     DTSCS62
02736      IF LCCM-NO-MSG                                               DTSCS62
02737         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02738         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02739         MOVE CATB-CURSOR              TO MAP-ATTACHMENTS-IND-L.   DTSCS62
02740  S1801-EXIT. EXIT.                                                DTSCS62
02741 /*****************************************************************DTSCS62
02742 *                                                                *DTSCS62
02743 ******************************************************************DTSCS62
02744  S1900-SOURCE-OP-ID.                                              DTSCS62
02745      IF MAP-SOURCE-OP-ID EQUAL LOW-VALUES OR SPACES               DTSCS62
02746          MOVE LCCM-RESP-OP-ID TO MAP-SOURCE-OP-ID.                DTSCS62
02747                                                                   DTSCS62
02748      IF MAP-SOURCE-OP-ID = 'SYSTEM'                               DTSCS62
02749         MOVE LCCM-OP-ID             TO MAP-SOURCE-OP-ID           DTSCS62
02750      ELSE                                                         DTSCS62
02751         IF MAP-SOURCE-OP-ID = LCCM-OP-ID                          DTSCS62
02752            NEXT SENTENCE                                          DTSCS62
02753         ELSE                                                      DTSCS62
02754            MOVE MAP-SOURCE-OP-ID      TO L082-OP-ID               DTSCS62
02755            PERFORM S082-OP-ID-EDIT    THRU S082-EXIT              DTSCS62
02756            IF L082-INTERNAL-88                                    DTSCS62
02757             OR L082-NOT-VALID-OP                                  DTSCS62
02758                MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA          DTSCS62
02759                PERFORM S1901-ERROR THRU S1901-EXIT                DTSCS62
02760                GO TO S1900-EXIT                                   DTSCS62
02761            END-IF                                                 DTSCS62
02762         END-IF                                                    DTSCS62
02763      END-IF.                                                      DTSCS62
02764      SKIP3                                                        DTSCS62
02765 *****                                                             DTSCS62
02766 *                                                                 DTSCS62
02767 *    FOLLOWING LINE OF CODE COMMENTED OUT AS INAPPROPRIATE FOR    DTSCS62
02768 *    SCREEN 62.  PER HELENA AND MARY.  01/24/95.                  DTSCS62
02769 *                                                                 DTSCS62
02770 *****                                                             DTSCS62
02771                                                                   DTSCS62
02772 *****MOVE MAP-SOURCE-OP-ID TO LCCM-RESP-OP-ID.                    DTSCS62
02773  S1900-EXIT. EXIT.                                                DTSCS62
02774                                                                   DTSCS62
02775  S1901-ERROR.                                                     DTSCS62
02776      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-SOURCE-OP-ID-A.      DTSCS62
02777      IF LCCM-NO-MSG                                               DTSCS62
02778         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02779         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02780         MOVE CATB-CURSOR              TO MAP-SOURCE-OP-ID-L.      DTSCS62
02781  S1901-EXIT. EXIT.                                                DTSCS62
02782 /*****************************************************************DTSCS62
02783 *                                                                *DTSCS62
02784 ******************************************************************DTSCS62
02785  S2000-TAX-EXTRACT.                                               DTSCS62
02786      IF MAP-TAX-EXTRACT EQUAL LOW-VALUES OR SPACES                DTSCS62
02787         SET MAP-TAX-EXTRACT-NO TO TRUE                            DTSCS62
02788      ELSE                                                         DTSCS62
02789      IF NOT MAP-TAX-EXTRACT-VALID                                 DTSCS62
02790         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS62
02791         PERFORM S2001-ERROR THRU S2001-EXIT                       DTSCS62
02792       ELSE                                                        DTSCS62
02793         IF MAP-TAX-EXTRACT-YES                                    DTSCS62
02794            SET WRK-EXTRACT-REQ-YES-88 TO TRUE.                    DTSCS62
02795                                                                   DTSCS62
02796      IF MAP-TAX-EXTRACT-YES                                       DTSCS62
02797         IF MPRF-NOT-WRITTEN-OFF-88                                DTSCS62
02798            NEXT SENTENCE                                          DTSCS62
02799         ELSE                                                      DTSCS62
02800            MOVE MSG-E62E-AREA TO WRK-MSG-AREA                     DTSCS62
02801            PERFORM S2001-ERROR THRU S2001-EXIT.                   DTSCS62
02802  S2000-EXIT. EXIT.                                                DTSCS62
02803                                                                   DTSCS62
02804  S2001-ERROR.                                                     DTSCS62
02805      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-TAX-EXTRACT-A.       DTSCS62
02806      IF LCCM-NO-MSG                                               DTSCS62
02807         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02808         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02809         MOVE CATB-CURSOR              TO MAP-TAX-EXTRACT-L.       DTSCS62
02810  S2001-EXIT. EXIT.                                                DTSCS62
02811 /*****************************************************************DTSCS62
02812 *                                                                *DTSCS62
02813 ******************************************************************DTSCS62
02814  S2100-WAGE-EXTRACT.                                              DTSCS62
02815      IF MAP-WAGE-EXTRACT EQUAL LOW-VALUES OR SPACES               DTSCS62
02816         SET MAP-WAGE-EXTRACT-NO TO TRUE                           DTSCS62
02817      ELSE                                                         DTSCS62
02818      IF NOT MAP-WAGE-EXTRACT-VALID                                DTSCS62
02819         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS62
02820         PERFORM S2101-ERROR THRU S2101-EXIT                       DTSCS62
02821      ELSE                                                         DTSCS62
02822         IF MAP-WAGE-EXTRACT-YES                                   DTSCS62
02823            SET WRK-EXTRACT-REQ-YES-88 TO TRUE.                    DTSCS62
02824                                                                   DTSCS62
02825      IF MAP-WAGE-EXTRACT-YES                                      DTSCS62
02826         IF MPRF-NOT-WRITTEN-OFF-88                                DTSCS62
02827            NEXT SENTENCE                                          DTSCS62
02828         ELSE                                                      DTSCS62
02829            MOVE MSG-E62E-AREA TO WRK-MSG-AREA                     DTSCS62
02830            PERFORM S2101-ERROR THRU S2101-EXIT.                   DTSCS62
02831  S2100-EXIT. EXIT.                                                DTSCS62
02832                                                                   DTSCS62
02833  S2101-ERROR.                                                     DTSCS62
02834      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-WAGE-EXTRACT-A.      DTSCS62
02835      IF LCCM-NO-MSG                                               DTSCS62
02836         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02837         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02838         MOVE CATB-CURSOR              TO MAP-WAGE-EXTRACT-L.      DTSCS62
02839  S2101-EXIT. EXIT.                                                DTSCS62
02840 /*****************************************************************DTSCS62
02841 *                                                                 DTSCS62
02842 ******************************************************************DTSCS62
02843  S2200-QTR-RANGE.                                                 DTSCS62
02844      MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA.      DTSCS62
02845                                                                   DTSCS62
02846      MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA.          DTSCS62
02847                                                                   DTSCS62
02848      PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT.                   DTSCS62
02849                                                                   DTSCS62
02850                                                                   DTSCS62
02851      IF LCCM-F05-88                                               DTSCS62
02852          PERFORM S2210-EXTRACT-ONLY-EDITS THRU S2210-EXIT         DTSCS62
02853          GO TO S2200-EXIT.                                        DTSCS62
02854                                                                   DTSCS62
02855                                                                   DTSCS62
02856      IF L024-START-NO-ENTRY                                       DTSCS62
02857         IF L063-AUDIT-88                                          DTSCS62
02858            MOVE MSG-E62B-AREA TO WRK-MSG-AREA                     DTSCS62
02859            PERFORM S2201-ERROR THRU S2201-EXIT                    DTSCS62
02860         ELSE                                                      DTSCS62
02861            IF WRK-EXTRACT-REQ-YES-88                              DTSCS62
02862               MOVE MSG-E629-AREA TO WRK-MSG-AREA                  DTSCS62
02863               PERFORM S2201-ERROR THRU S2201-EXIT                 DTSCS62
02864            ELSE                                                   DTSCS62
02865               NEXT SENTENCE                                       DTSCS62
02866      ELSE                                                         DTSCS62
02867      IF L024-START-NOT-VALID                                      DTSCS62
02868          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS62
02869          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS62
02870      ELSE                                                         DTSCS62
02871         IF (L063-NON-AUDIT-88)                                    DTSCS62
02872                AND                                                DTSCS62
02873            (MFAS-NON-AUDIT-88)                                    DTSCS62
02874                AND                                                DTSCS62
02875            (WRK-EXTRACT-REQ-NO-88)                                DTSCS62
02876                AND                                                DTSCS62
02877            (L024-START-YRQ NOT = MFAS-START-YRQ)                  DTSCS62
02878             MOVE MSG-E62A-AREA TO WRK-MSG-AREA                    DTSCS62
02879             PERFORM S2201-ERROR THRU S2201-EXIT.                  DTSCS62
02880                                                                   DTSCS62
02881                                                                   DTSCS62
02882      IF L024-END-NO-ENTRY                                         DTSCS62
02883         IF L063-AUDIT-88                                          DTSCS62
02884            MOVE MSG-E62B-AREA TO WRK-MSG-AREA                     DTSCS62
02885            PERFORM S2203-ERROR THRU S2203-EXIT                    DTSCS62
02886         ELSE                                                      DTSCS62
02887            IF WRK-EXTRACT-REQ-YES-88                              DTSCS62
02888               MOVE MSG-E629-AREA TO WRK-MSG-AREA                  DTSCS62
02889               PERFORM S2203-ERROR THRU S2203-EXIT                 DTSCS62
02890            ELSE                                                   DTSCS62
02891               NEXT SENTENCE                                       DTSCS62
02892      ELSE                                                         DTSCS62
02893         IF L024-END-NOT-VALID OR L024-END-COPIED-FROM-START       DTSCS62
02894            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS62
02895            PERFORM S2203-ERROR THRU S2203-EXIT                    DTSCS62
02896         ELSE                                                      DTSCS62
02897            IF (L063-NON-AUDIT-88)                                 DTSCS62
02898                     AND                                           DTSCS62
02899               (MFAS-NON-AUDIT-88)                                 DTSCS62
02900                     AND                                           DTSCS62
02901               (WRK-EXTRACT-REQ-NO-88)                             DTSCS62
02902                     AND                                           DTSCS62
02903               (L024-END-YRQ NOT = MFAS-END-YRQ)                   DTSCS62
02904               MOVE MSG-E62A-AREA TO WRK-MSG-AREA                  DTSCS62
02905               PERFORM S2203-ERROR THRU S2203-EXIT.                DTSCS62
02906                                                                   DTSCS62
02907                                                                   DTSCS62
02908      IF L024-START-VALID AND L024-END-VALID                       DTSCS62
02909         NEXT SENTENCE                                             DTSCS62
02910      ELSE                                                         DTSCS62
02911         GO TO S2200-EXIT.                                         DTSCS62
02912                                                                   DTSCS62
02913                                                                   DTSCS62
02914      IF L024-SPAN-INVALID                                         DTSCS62
02915      OR L024-END-BEFORE-START                                     DTSCS62
02916      OR L024-QTRS-SPANNED > +12                                   DTSCS62
02917         MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS62
02918         PERFORM S2201-ERROR THRU S2201-EXIT                       DTSCS62
02919         PERFORM S2203-ERROR THRU S2203-EXIT                       DTSCS62
02920      END-IF.                                                      DTSCS62
02921  S2200-EXIT. EXIT.                                                DTSCS62
02922                                                                   DTSCS62
02923  S2201-ERROR.                                                     DTSCS62
02924      MOVE CATB-UNPROT-NORM-NUM-MDTON   TO MAP-AUDIT-START-YR-A    DTSCS62
02925                                           MAP-AUDIT-START-Q-A     DTSCS62
02926      IF LCCM-NO-MSG                                               DTSCS62
02927         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02928         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02929         MOVE CATB-CURSOR              TO MAP-AUDIT-START-YR-L.    DTSCS62
02930  S2201-EXIT. EXIT.                                                DTSCS62
02931                                                                   DTSCS62
02932  S2203-ERROR.                                                     DTSCS62
02933      MOVE CATB-UNPROT-NORM-NUM-MDTON   TO MAP-AUDIT-END-YR-A      DTSCS62
02934                                           MAP-AUDIT-END-Q-A       DTSCS62
02935      IF LCCM-NO-MSG                                               DTSCS62
02936         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
02937         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
02938         MOVE CATB-CURSOR              TO MAP-AUDIT-END-YR-L.      DTSCS62
02939  S2203-EXIT. EXIT.                                                DTSCS62
02940                                                                   DTSCS62
02941                                                                   DTSCS62
02942                                                                   DTSCS62
02943  S2210-EXTRACT-ONLY-EDITS.                                        DTSCS62
02944      IF L024-START-NO-ENTRY                                       DTSCS62
02945          MOVE MSG-E629-AREA TO WRK-MSG-AREA                       DTSCS62
02946          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS62
02947      ELSE                                                         DTSCS62
02948      IF L024-START-NOT-VALID                                      DTSCS62
02949          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS62
02950          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS62
02951      ELSE                                                         DTSCS62
02952          IF MFAS-AUDIT-88                                         DTSCS62
02953              IF L024-START-YRQ = MFAS-START-YRQ                   DTSCS62
02954                  NEXT SENTENCE                                    DTSCS62
02955              ELSE                                                 DTSCS62
02956                  MOVE MSG-E62G-AREA TO WRK-MSG-AREA               DTSCS62
02957                  PERFORM S2201-ERROR THRU S2201-EXIT.             DTSCS62
02958                                                                   DTSCS62
02959                                                                   DTSCS62
02960      IF L024-END-NO-ENTRY                                         DTSCS62
02961          MOVE MSG-E629-AREA TO WRK-MSG-AREA                       DTSCS62
02962          PERFORM S2203-ERROR THRU S2203-EXIT                      DTSCS62
02963      ELSE                                                         DTSCS62
02964      IF L024-END-NOT-VALID OR L024-END-COPIED-FROM-START          DTSCS62
02965          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS62
02966          PERFORM S2203-ERROR THRU S2203-EXIT                      DTSCS62
02967      ELSE                                                         DTSCS62
02968          IF MFAS-AUDIT-88                                         DTSCS62
02969              IF L024-END-YRQ = MFAS-END-YRQ                       DTSCS62
02970                  NEXT SENTENCE                                    DTSCS62
02971              ELSE                                                 DTSCS62
02972                  MOVE MSG-E62G-AREA TO WRK-MSG-AREA               DTSCS62
02973                  PERFORM S2203-ERROR THRU S2203-EXIT.             DTSCS62
02974                                                                   DTSCS62
02975                                                                   DTSCS62
02976      IF L024-START-VALID AND L024-END-VALID                       DTSCS62
02977          NEXT SENTENCE                                            DTSCS62
02978      ELSE                                                         DTSCS62
02979          GO TO S2210-EXIT.                                        DTSCS62
02980                                                                   DTSCS62
02981                                                                   DTSCS62
02982      IF (L024-SPAN-INVALID)                                       DTSCS62
02983             OR                                                    DTSCS62
02984         (L024-END-BEFORE-START)                                   DTSCS62
02985             OR                                                    DTSCS62
02986         (L024-QTRS-SPANNED > +12)                                 DTSCS62
02987          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS62
02988          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS62
02989          PERFORM S2203-ERROR THRU S2203-EXIT.                     DTSCS62
02990  S2210-EXIT.                                                      DTSCS62
02991      EXIT.                                                        DTSCS62
02992 /*****************************************************************DTSCS62
02993 *                                                                 DTSCS62
02994 ******************************************************************DTSCS62
02995  S2300-EMP-SIZE-IND.                                              DTSCS62
02996      IF MAP-EMP-SIZE-IND = LOW-VALUES                             DTSCS62
02997          MOVE SPACES TO MAP-EMP-SIZE-IND.                         DTSCS62
02998      SKIP1                                                        DTSCS62
02999      IF MAP-EMP-SIZE-IND = SPACES                                 DTSCS62
03000         IF L063-NON-AUDIT-88                                      DTSCS62
03001            NEXT SENTENCE                                          DTSCS62
03002         ELSE                                                      DTSCS62
03003            MOVE 'S' TO MAP-EMP-SIZE-IND                           DTSCS62
03004      ELSE                                                         DTSCS62
03005      IF MAP-EMP-SIZE-IND-VALID                                    DTSCS62
03006         IF L063-NON-AUDIT-88                                      DTSCS62
03007            MOVE MSG-E62A-AREA TO WRK-MSG-AREA                     DTSCS62
03008            PERFORM S2301-ERROR THRU S2301-EXIT                    DTSCS62
03009         ELSE                                                      DTSCS62
03010            NEXT SENTENCE                                          DTSCS62
03011      ELSE                                                         DTSCS62
03012         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS62
03013         PERFORM S2301-ERROR THRU S2301-EXIT.                      DTSCS62
03014                                                                   DTSCS62
03015  S2300-EXIT. EXIT.                                                DTSCS62
03016                                                                   DTSCS62
03017  S2301-ERROR.                                                     DTSCS62
03018      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-EMP-SIZE-IND-A.      DTSCS62
03019      IF LCCM-NO-MSG                                               DTSCS62
03020         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03021         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
03022         MOVE CATB-CURSOR              TO MAP-EMP-SIZE-IND-L.      DTSCS62
03023  S2301-EXIT. EXIT.                                                DTSCS62
03024 /*****************************************************************DTSCS62
03025 *                                                                 DTSCS62
03026 ******************************************************************DTSCS62
03027 *S2200-SIC-OWN-CD.                                                DTSCS62
03028 *****IF MAP-SIC-CD = LOW-VALUES                                   DTSCS62
03029 *****    MOVE SPACES TO MAP-SIC-CD.                               DTSCS62
03030 *****                                                             DTSCS62
03031 *****IF MAP-OWN-CD = LOW-VALUES                                   DTSCS62
03032 *****    MOVE SPACES TO MAP-OWN-CD.                               DTSCS62
03033 *****                                                             DTSCS62
03034 *****IF (MAP-SIC-CD = SPACES)                                     DTSCS62
03035 *****       AND                                                   DTSCS62
03036 *****   (MAP-OWN-CD = SPACES)                                     DTSCS62
03037 *****    IF WRK-ASSIGN-TYPE-ERROR-YES                             DTSCS62
03038 *****        GO TO S2200-EXIT                                     DTSCS62
03039 *****    ELSE                                                     DTSCS62
03040 *****        IF L063-AUDIT-88                                     DTSCS62
03041 *****            MOVE MPRF-SIC-CD TO MAP-SIC-CD                   DTSCS62
03042 *****            MOVE MPRF-OWN-CD TO MAP-OWN-CD                   DTSCS62
03043 *****            GO TO S2200-EXIT                                 DTSCS62
03044 *****        ELSE                                                 DTSCS62
03045 *****            GO TO S2200-EXIT.                                DTSCS62
03046 *****                                                             DTSCS62
03047 *****MOVE MAP-SIC-CD TO L039-SIC-CD.                              DTSCS62
03048 *****MOVE MAP-OWN-CD TO L039-OWN-CD.                              DTSCS62
03049 *****                                                             DTSCS62
03050 *****PERFORM S039-SIC-OWN-CODE-EDIT THRU S039-EXIT.               DTSCS62
03051 *****                                                             DTSCS62
03052 *****IF L039-SIC-NOT-VALID                                        DTSCS62
03053 *****    MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS62
03054 *****    PERFORM S2201-ERROR THRU S2201-EXIT.                     DTSCS62
03055 *****                                                             DTSCS62
03056 *****IF L039-OWN-NOT-VALID                                        DTSCS62
03057 *****    MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS62
03058 *****    PERFORM S2202-ERROR THRU S2202-EXIT.                     DTSCS62
03059 *S2200-EXIT. EXIT.                                                DTSCS62
03060                                                                   DTSCS62
03061 *S2201-ERROR.                                                     DTSCS62
03062 *****MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS62
03063 *****  TO MAP-SIC-CD-A.                                           DTSCS62
03064 *****IF LCCM-NO-MSG                                               DTSCS62
03065 *****   SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03066 *****   MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS62
03067 *****   MOVE CATB-CURSOR  TO MAP-SIC-CD-L.                        DTSCS62
03068 *S2201-EXIT. EXIT.                                                DTSCS62
03069                                                                   DTSCS62
03070 *S2202-ERROR.                                                     DTSCS62
03071 *****MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS62
03072 *****  TO MAP-OWN-CD-A.                                           DTSCS62
03073 *****IF LCCM-NO-MSG                                               DTSCS62
03074 *****   SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03075 *****   MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS62
03076 *****   MOVE CATB-CURSOR  TO MAP-OWN-CD-L.                        DTSCS62
03077 *S2202-EXIT. EXIT.                                                DTSCS62
03078 /*****************************************************************DTSCS62
03079 *                                                                 DTSCS62
03080 ******************************************************************DTSCS62
03081  S2400-AUDIT-SEL-REASON.                                          DTSCS62
03082      INSPECT MAP-AUDIT-SEL-REASON (WRK-CTR)                       DTSCS62
03083          CONVERTING LOW-VALUES TO SPACES.                         DTSCS62
03084                                                                   DTSCS62
03085      IF MAP-AUDIT-SEL-REASON (WRK-CTR) = SPACES                   DTSCS62
03086            IF L063-AUDIT-88                                       DTSCS62
03087              AND WRK-CTR = 1                                      DTSCS62
03088               SET MAP-AUDIT-SEL-DEFAULT-88 (WRK-CTR) TO TRUE      DTSCS62
03089               GO TO S2400-EXIT                                    DTSCS62
03090            ELSE                                                   DTSCS62
03091               GO TO S2400-EXIT.                                   DTSCS62
03092                                                                   DTSCS62
03093      IF L063-NON-AUDIT-88                                         DTSCS62
03094         MOVE MSG-E62A-AREA TO WRK-MSG-AREA                        DTSCS62
03095         PERFORM S2401-ERROR THRU S2401-EXIT                       DTSCS62
03096         GO TO S2400-EXIT.                                         DTSCS62
03097                                                                   DTSCS62
03098      MOVE MAP-AUDIT-SEL-REASON (WRK-CTR) TO L036-CD.              DTSCS62
03099      PERFORM S036-AUDIT-SEL-REASON THRU S036-EXIT.                DTSCS62
03100                                                                   DTSCS62
03101      IF L036-NOT-VALID                                            DTSCS62
03102         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS62
03103         PERFORM S2401-ERROR THRU S2401-EXIT.                      DTSCS62
03104  S2400-EXIT. EXIT.                                                DTSCS62
03105                                                                   DTSCS62
03106  S2401-ERROR.                                                     DTSCS62
03107      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS62
03108        TO MAP-AUDIT-SEL-REASON-A (WRK-CTR).                       DTSCS62
03109      IF LCCM-NO-MSG                                               DTSCS62
03110         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03111         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS62
03112         MOVE CATB-CURSOR  TO MAP-AUDIT-SEL-REASON-L(WRK-CTR).     DTSCS62
03113  S2401-EXIT. EXIT.                                                DTSCS62
03114 /*****************************************************************DTSCS62
03115 *                                                                *DTSCS62
03116 ******************************************************************DTSCS62
03117 *S2400-COPIES.                                                    DTSCS62
03118 *****                                                             DTSCS62
03119 *                                                                 DTSCS62
03120 *    LYNNETTE WISHES THAT MAP-COPIES SHOULD ALWAYS DEFAULT TO 0.  DTSCS62
03121 *    HER WISH IS OUR COMMAND.                    05/10/95         DTSCS62
03122 *                                                                 DTSCS62
03123 *****                                                             DTSCS62
03124 *                                                                 DTSCS62
03125 *    IF MAP-COPIES = LOW-VALUE OR SPACE                           DTSCS62
03126 *       IF MAP-STATUS-CD = 'C' OR 'P' OR 'K'                      DTSCS62
03127 *          MOVE '0' TO MAP-COPIES                                 DTSCS62
03128 *       ELSE                                                      DTSCS62
03129 *       IF LCCM-OP-IS-FLD-DESK-88                                 DTSCS62
03130 *          MOVE '0' TO MAP-COPIES                                 DTSCS62
03131 *       ELSE                                                      DTSCS62
03132 *          MOVE '0' TO MAP-COPIES                                 DTSCS62
03133 *********MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA            DTSCS62
03134 *********PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT              DTSCS62
03135 *********MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA       DTSCS62
03136 *********PERFORM S018-EMP-NO-FROM-SCREEN   THRU S018-EXIT         DTSCS62
03137 *********IF L018-NO-ENTRY                                         DTSCS62
03138 *********AND L020-NO-ENTRY                                        DTSCS62
03139 *********    MOVE '0' TO MAP-COPIES                               DTSCS62
03140 *********ELSE                                                     DTSCS62
03141 *********IF L020-NO-ENTRY                                         DTSCS62
03142 *********OR L018-NO-ENTRY                                         DTSCS62
03143 *********    MOVE '0' TO MAP-COPIES                               DTSCS62
03144 *********ELSE                                                     DTSCS62
03145 *********    MOVE '0' TO MAP-COPIES                               DTSCS62
03146 *    ELSE                                                         DTSCS62
03147 *    IF NOT MAP-COPIES-VALID                                      DTSCS62
03148 *       MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS62
03149 *       PERFORM S2401-ERROR   THRU S2401-EXIT.                    DTSCS62
03150 *S2400-EXIT. EXIT.                                                DTSCS62
03151                                                                   DTSCS62
03152 *S2401-ERROR.                                                     DTSCS62
03153 *    MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPIES-A.             DTSCS62
03154 *    IF LCCM-NO-MSG                                               DTSCS62
03155 *       SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03156 *       MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
03157 *       MOVE CATB-CURSOR              TO MAP-COPIES-L.            DTSCS62
03158 *S2401-EXIT. EXIT.                                                DTSCS62
03159 /*****************************************************************DTSCS62
03160 *                                                                *DTSCS62
03161 ******************************************************************DTSCS62
03162 *S2500-PRINTER-ID.                                                DTSCS62
03163 *    IF MAP-PRINTER-ID EQUAL LOW-VALUES OR SPACES                 DTSCS62
03164 *       IF LCCM-NO-PRINTER                                        DTSCS62
03165 *         AND MAP-COPIES NOT = '0'                                DTSCS62
03166 *           MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA              DTSCS62
03167 *           PERFORM S2501-ERROR THRU S2501-EXIT                   DTSCS62
03168 *       ELSE                                                      DTSCS62
03169 *          MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID                 DTSCS62
03170 *    ELSE                                                         DTSCS62
03171 *       MOVE MAP-PRINTER-ID TO LCCM-PRINTER-ID.                   DTSCS62
03172 *S2500-EXIT. EXIT.                                                DTSCS62
03173                                                                   DTSCS62
03174 *S2501-ERROR.                                                     DTSCS62
03175 *    MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-PRINTER-ID-A.        DTSCS62
03176 *    IF LCCM-NO-MSG                                               DTSCS62
03177 *       SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03178 *       MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
03179 *       MOVE CATB-CURSOR              TO MAP-PRINTER-ID-L.        DTSCS62
03180 *S2501-EXIT. EXIT.                                                DTSCS62
03181 /*****************************************************************DTSCS62
03182 *                                                                *DTSCS62
03183 ******************************************************************DTSCS62
03184  S2500-RELATED-EMP-NO.                                            DTSCS62
03185      MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.          DTSCS62
03186      PERFORM S018-EMP-NO-FROM-SCREEN   THRU S018-EXIT.            DTSCS62
03187      IF L018-NO-ENTRY                                             DTSCS62
03188         GO TO S2500-EXIT.                                         DTSCS62
03189                                                                   DTSCS62
03190      IF L018-NOT-VALID                                            DTSCS62
03191      OR L018-EMP-NO = LCCM-EMP-NO                                 DTSCS62
03192         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS62
03193         PERFORM S2501-ERROR   THRU S2501-EXIT                     DTSCS62
03194         GO TO S2500-EXIT.                                         DTSCS62
03195                                                                   DTSCS62
03196      MOVE LOW-VALUES                 TO MPRF-KEY-AREA.            DTSCS62
03197      MOVE L018-EMP-NO                TO MPRF-EMP-NO.              DTSCS62
03198      SET  MPRF-PRF-88                TO TRUE.                     DTSCS62
03199      MOVE MPRF-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS62
03200      PERFORM S810-READ               THRU S810-EXIT.              DTSCS62
03201                                                                   DTSCS62
03202      IF L810-NO-REC-88                                            DTSCS62
03203          IF L018-EMP-NO = MFAS-RELATED-EMP-NO                     DTSCS62
03204              NEXT SENTENCE                                        DTSCS62
03205          ELSE                                                     DTSCS62
03206              MOVE EMSG-NO-RECORD         TO WRK-MSG-AREA          DTSCS62
03207              PERFORM S2501-ERROR         THRU S2501-EXIT          DTSCS62
03208              GO TO S2500-EXIT.                                    DTSCS62
03209                                                                   DTSCS62
03210      MOVE MSKL-REC                   TO MPRF-REC.                 DTSCS62
03211      IF MPRF-CLASS-CHG-ONLY-88                                    DTSCS62
03212         MOVE MSG-E625-AREA TO WRK-MSG-AREA                        DTSCS62
03213         PERFORM S2501-ERROR THRU S2501-EXIT.                      DTSCS62
03214                                                                   DTSCS62
03215 *** NEED TO REREAD THE EMPLOYER FOR LATER                         DTSCS62
03216                                                                   DTSCS62
03217      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS62
03218  S2500-EXIT. EXIT.                                                DTSCS62
03219                                                                   DTSCS62
03220  S2501-ERROR.                                                     DTSCS62
03221      MOVE CATB-UNPROT-NORM-NUM-MDTON  TO MAP-RELATED-EMP-NO-1-A   DTSCS62
03222                                          MAP-RELATED-EMP-NO-2-A.  DTSCS62
03223      IF LCCM-NO-MSG                                               DTSCS62
03224         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03225         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
03226         MOVE CATB-CURSOR              TO MAP-RELATED-EMP-NO-1-L.  DTSCS62
03227  S2501-EXIT. EXIT.                                                DTSCS62
03228 /*****************************************************************DTSCS62
03229 *                                                                *DTSCS62
03230 ******************************************************************DTSCS62
03231  S2600-CLAIMANT-SSN.                                              DTSCS62
03232      MOVE MAP-CLAIMANT-SSN-AREA      TO L020-S-SSN-AREA.          DTSCS62
03233      PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT.                 DTSCS62
03234      IF L020-NO-ENTRY                                             DTSCS62
03235         NEXT SENTENCE                                             DTSCS62
03236      ELSE                                                         DTSCS62
03237      IF L020-NOT-VALID                                            DTSCS62
03238         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS62
03239         PERFORM S2601-ERROR THRU S2601-EXIT.                      DTSCS62
03240                                                                   DTSCS62
03241  S2600-EXIT. EXIT.                                                DTSCS62
03242                                                                   DTSCS62
03243  S2601-ERROR.                                                     DTSCS62
03244      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLAIMANT-SSN-1-A      DTSCS62
03245                              MAP-CLAIMANT-SSN-2-A                 DTSCS62
03246                              MAP-CLAIMANT-SSN-3-A.                DTSCS62
03247      IF LCCM-NO-MSG                                               DTSCS62
03248         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03249         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
03250         MOVE CATB-CURSOR              TO MAP-CLAIMANT-SSN-1-L.    DTSCS62
03251  S2601-EXIT. EXIT.                                                DTSCS62
03252 /*****************************************************************DTSCS62
03253 *                                                                *DTSCS62
03254 ******************************************************************DTSCS62
03255  S2700-CLAIMANT-NAME.                                             DTSCS62
03256      INSPECT MAP-CLAIMANT-NAME                                    DTSCS62
03257          CONVERTING LOW-VALUES TO SPACES.                         DTSCS62
03258                                                                   DTSCS62
03259      IF MAP-CLAIMANT-NAME = SPACES                                DTSCS62
03260         IF L020-NO-ENTRY                                          DTSCS62
03261            GO TO S2700-EXIT.                                      DTSCS62
03262                                                                   DTSCS62
03263      IF L020-NOT-VALID                                            DTSCS62
03264         GO TO S2700-EXIT.                                         DTSCS62
03265                                                                   DTSCS62
03266      IF L020-NO-ENTRY                                             DTSCS62
03267         MOVE EMSG-FIELD-NOT-ALLOWED  TO WRK-MSG-AREA              DTSCS62
03268         PERFORM S2701-ERROR          THRU S2701-EXIT              DTSCS62
03269         GO TO S2700-EXIT.                                         DTSCS62
03270                                                                   DTSCS62
03271      IF MAP-CLAIMANT-NAME = SPACES                                DTSCS62
03272         MOVE L020-SSN TO L081-CLAIMANT-SSN                        DTSCS62
03273         PERFORM S081-CLAIMANT-NAME      THRU S081-EXIT            DTSCS62
03274         IF L081-NAME-FOUND                                        DTSCS62
03275            MOVE L081-CLAIMANT-NAME     TO MAP-CLAIMANT-NAME.      DTSCS62
03276                                                                   DTSCS62
03277      IF MAP-CLAIMANT-NAME = SPACES                                DTSCS62
03278         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS62
03279         PERFORM S2701-ERROR          THRU S2701-EXIT              DTSCS62
03280      ELSE                                                         DTSCS62
03281         MOVE MAP-CLAIMANT-NAME        TO L071-NAM                 DTSCS62
03282         PERFORM S071-FROM-LAST-NAME-FIRST THRU S071-EXIT          DTSCS62
03283         IF L071-NAME-INVALID                                      DTSCS62
03284            MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA           DTSCS62
03285            PERFORM S2701-ERROR          THRU S2701-EXIT.          DTSCS62
03286                                                                   DTSCS62
03287  S2700-EXIT. EXIT.                                                DTSCS62
03288                                                                   DTSCS62
03289  S2701-ERROR.                                                     DTSCS62
03290      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-CLAIMANT-NAME-A.     DTSCS62
03291      IF LCCM-NO-MSG                                               DTSCS62
03292         SET CURSOR-SET-YES           TO TRUE                      DTSCS62
03293         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS62
03294         MOVE CATB-CURSOR              TO MAP-CLAIMANT-NAME-L.     DTSCS62
03295  S2701-EXIT. EXIT.                                                DTSCS62
03296 /*****************************************************************DTSCS62
03297 *                                                                *DTSCS62
03298 ******************************************************************DTSCS62
03299  S3100-TEXT.                                                      DTSCS62
03300      INSPECT MAP-TEXT (WRK-CTR)                                   DTSCS62
03301          CONVERTING LOW-VALUES TO SPACES.                         DTSCS62
03302  S3100-EXIT. EXIT.                                                DTSCS62
03303                                                                   DTSCS62
03304 /*****************************************************************DTSCS62
03305 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS62
03306 ******************************************************************DTSCS62
03307  S5100-SET-LOCK-ATTRB.                                            DTSCS62
03308      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS62
03309                                 WRK-ATB-NUM.                      DTSCS62
03310                                                                   DTSCS62
03311      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS62
03312                                                                   DTSCS62
03313      MOVE CATB-ASKIP-BRT-MDTON TO MAP-ASSIGN-NO-1-A               DTSCS62
03314                                 MAP-ASSIGN-NO-2-A                 DTSCS62
03315                                 MAP-GOTO-A.                       DTSCS62
03316  S5100-EXIT.                                                      DTSCS62
03317      EXIT.                                                        DTSCS62
03318                                                                   DTSCS62
03319 ******************************************************************DTSCS62
03320 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS62
03321 ******************************************************************DTSCS62
03322  S5200-SET-UPDATE-ATTRB.                                          DTSCS62
03323      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS62
03324         PERFORM S5210-FIELD-DESK-UPD  THRU S5210-EXIT             DTSCS62
03325      ELSE                                                         DTSCS62
03326         PERFORM S5220-REGULAR-UPD     THRU S5220-EXIT.            DTSCS62
03327                                                                   DTSCS62
03328  S5200-EXIT.                                                      DTSCS62
03329      EXIT.                                                        DTSCS62
03330                                                                   DTSCS62
03331  S5210-FIELD-DESK-UPD.                                            DTSCS62
03332      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS62
03333      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS62
03334                                                                   DTSCS62
03335      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS62
03336                                                                   DTSCS62
03337  S5210-EXIT.                                                      DTSCS62
03338      EXIT.                                                        DTSCS62
03339                                                                   DTSCS62
03340  S5220-REGULAR-UPD.                                               DTSCS62
03341      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS62
03342                                   WRK-ATB-NUM.                    DTSCS62
03343                                                                   DTSCS62
03344      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS62
03345      MOVE CATB-UNPROT-BRT-NUM-MDTON TO                            DTSCS62
03346          MAP-ASSIGN-NO-1-A                                        DTSCS62
03347          MAP-ASSIGN-NO-2-A                                        DTSCS62
03348          MAP-COMPLETED-DATE-DA-A                                  DTSCS62
03349          MAP-COMPLETED-DATE-MO-A                                  DTSCS62
03350          MAP-COMPLETED-DATE-YR-A                                  DTSCS62
03351          MAP-AUDIT-END-Q-A                                        DTSCS62
03352          MAP-AUDIT-END-YR-A                                       DTSCS62
03353          MAP-AUDIT-START-Q-A                                      DTSCS62
03354          MAP-AUDIT-START-YR-A.                                    DTSCS62
03355                                                                   DTSCS62
03356      MOVE CATB-UNPROT-BRT-AN-MDTON TO                             DTSCS62
03357          MAP-STATUS-CD-A                                          DTSCS62
03358          MAP-TAX-EXTRACT-A                                        DTSCS62
03359          MAP-WAGE-EXTRACT-A.                                      DTSCS62
03360                                                                   DTSCS62
03361                                                                   DTSCS62
03362  S5220-EXIT.                                                      DTSCS62
03363      EXIT.                                                        DTSCS62
03364                                                                   DTSCS62
03365 ******************************************************************DTSCS62
03366 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS62
03367 ******************************************************************DTSCS62
03368  S5300-SET-INQ-ATTRB.                                             DTSCS62
03369      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS62
03370                                   WRK-ATB-NUM.                    DTSCS62
03371                                                                   DTSCS62
03372      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS62
03373                                                                   DTSCS62
03374      MOVE CATB-UNPROT-BRT-NUM-MDTON TO                            DTSCS62
03375          MAP-ASSIGN-NO-1-A                                        DTSCS62
03376          MAP-ASSIGN-NO-2-A.                                       DTSCS62
03377                                                                   DTSCS62
03378  S5300-EXIT.                                                      DTSCS62
03379      EXIT.                                                        DTSCS62
03380                                                                   DTSCS62
03381  S5900-SET-ATTRB.                                                 DTSCS62
03382      MOVE WRK-ATB-AN TO                                           DTSCS62
03383                                                                   DTSCS62
03384          MAP-ASSIGN-TYPE-A                                        DTSCS62
03385          MAP-ATTACHMENTS-IND-A                                    DTSCS62
03386          MAP-EMP-SIZE-IND-A                                       DTSCS62
03387          MAP-FLD-REP-ID-A                                         DTSCS62
03388          MAP-SOURCE-OP-ID-A                                       DTSCS62
03389          MAP-STATUS-CD-A                                          DTSCS62
03390          MAP-TAX-EXTRACT-A                                        DTSCS62
03391          MAP-WAGE-EXTRACT-A                                       DTSCS62
03392          MAP-CLAIMANT-NAME-A                                      DTSCS62
03393          PERFORM VARYING WRK-CTR FROM 1 BY 1                      DTSCS62
03394             UNTIL WRK-CTR > MMAX-FAS-SEL-MAX                      DTSCS62
03395             MOVE WRK-ATB-AN TO                                    DTSCS62
03396              MAP-AUDIT-SEL-REASON-A(WRK-CTR)                      DTSCS62
03397          END-PERFORM                                              DTSCS62
03398          PERFORM VARYING WRK-CTR FROM 1 BY 1                      DTSCS62
03399             UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX                     DTSCS62
03400             MOVE CATB-UNPROT-BRT-AN-MDTON TO                      DTSCS62
03401                  MAP-TEXT-A(WRK-CTR)                              DTSCS62
03402          END-PERFORM                                              DTSCS62
03403      MOVE WRK-ATB-NUM TO                                          DTSCS62
03404          MAP-ASSIGN-NO-1-A                                        DTSCS62
03405          MAP-ASSIGN-NO-2-A                                        DTSCS62
03406          MAP-AUDIT-END-Q-A                                        DTSCS62
03407          MAP-AUDIT-END-YR-A                                       DTSCS62
03408          MAP-AUDIT-START-Q-A                                      DTSCS62
03409          MAP-AUDIT-START-YR-A                                     DTSCS62
03410          MAP-CLAIMANT-SSN-1-A                                     DTSCS62
03411          MAP-CLAIMANT-SSN-2-A                                     DTSCS62
03412          MAP-CLAIMANT-SSN-3-A                                     DTSCS62
03413          MAP-COMPLETED-DATE-DA-A                                  DTSCS62
03414          MAP-COMPLETED-DATE-MO-A                                  DTSCS62
03415          MAP-COMPLETED-DATE-YR-A                                  DTSCS62
03416          MAP-DUE-DATE-DA-A                                        DTSCS62
03417          MAP-DUE-DATE-MO-A                                        DTSCS62
03418          MAP-DUE-DATE-YR-A                                        DTSCS62
03419          MAP-RELATED-EMP-NO-1-A                                   DTSCS62
03420          MAP-RELATED-EMP-NO-2-A                                   DTSCS62
03421          MAP-START-DATE-DA-A                                      DTSCS62
03422          MAP-START-DATE-MO-A                                      DTSCS62
03423          MAP-START-DATE-YR-A.                                     DTSCS62
03424                                                                   DTSCS62
03425      MOVE CATB-ASKIP-BRT-MDTON TO MAP-SIC-CD-A                    DTSCS62
03426                                   MAP-NAICS-CD-A                  DTSCS62
03427                                   MAP-OWN-CD-A.                   DTSCS62
03428                                                                   DTSCS62
03429      MOVE CATB-ASKIP-BRT-MDTON TO  MAP-EMP-NO-1-A                 DTSCS62
03430                                    MAP-EMP-NO-2-A                 DTSCS62
03431                                    MAP-PRIMARY-NAME-A             DTSCS62
03432                                    MAP-PROCESSED-DATE-A           DTSCS62
03433                                    MAP-WAGE-EXTRACT-DATE-A        DTSCS62
03434                                    MAP-TAX-EXTRACT-DATE-A.        DTSCS62
03435      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS62
03436  S5900-EXIT.                                                      DTSCS62
03437      EXIT.                                                        DTSCS62
03438      EJECT                                                        DTSCS62
03439 /*****************************************************************DTSCS62
03440 * MAP ROUTINES                                                   *DTSCS62
03441 ******************************************************************DTSCS62
03442  S9100-RECEIVE.                                                   DTSCS62
03443      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS62
03444                                                                   DTSCS62
03445      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS62
03446                                                                   DTSCS62
03447      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS62
03448                                                                   DTSCS62
03449      MOVE L851-AID TO LCCM-AID.                                   DTSCS62
03450      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS62
03451  S9100-EXIT.                                                      DTSCS62
03452      EXIT.                                                        DTSCS62
03453                                                                   DTSCS62
03454  S9200-SEND-DATAONLY.                                             DTSCS62
03455      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS62
03456                                                                   DTSCS62
03457      IF LCCM-NO-MSG                                               DTSCS62
03458          NEXT SENTENCE                                            DTSCS62
03459      ELSE                                                         DTSCS62
03460          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS62
03461                                                                   DTSCS62
03462      IF CURSOR-SET-GOTO                                           DTSCS62
03463          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS62
03464      ELSE                                                         DTSCS62
03465          MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L.                   DTSCS62
03466                                                                   DTSCS62
03467      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS62
03468                                                                   DTSCS62
03469      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS62
03470                                                                   DTSCS62
03471      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS62
03472  S9200-EXIT.                                                      DTSCS62
03473      EXIT.                                                        DTSCS62
03474                                                                   DTSCS62
03475  S9300-SEND-MAP.                                                  DTSCS62
03476      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS62
03477      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS62
03478      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS62
03479      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS62
03480                                                                   DTSCS62
03481      IF SCR-ACCESS-UPDATE                                         DTSCS62
03482          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS62
03483      ELSE                                                         DTSCS62
03484          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS62
03485                                                                   DTSCS62
03486      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS62
03487                                                                   DTSCS62
03488      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS62
03489                                                                   DTSCS62
03490      IF CURSOR-SET-NO                                             DTSCS62
03491          MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L.                   DTSCS62
03492                                                                   DTSCS62
03493      SET L851-SEND-88 TO TRUE.                                    DTSCS62
03494                                                                   DTSCS62
03495      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS62
03496                                                                   DTSCS62
03497      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS62
03498  S9300-EXIT.                                                      DTSCS62
03499      EXIT.                                                        DTSCS62
03500                                                                   DTSCS62
03501  S9310-UPDATE-FKEYS.                                              DTSCS62
03502      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS62
03503                                                                   DTSCS62
03504                                                                   DTSCS62
03505      IF LCCM-SCR-INQUIRE                                          DTSCS62
03506          MOVE CFKD-MOD TO MAP-KEY-MOD                             DTSCS62
03507          MOVE CFKD-DEL TO MAP-KEY-DEL                             DTSCS62
03508      ELSE                                                         DTSCS62
03509      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS62
03510          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS62
03511                             MAP-KEY-DEL.                          DTSCS62
03512  S9310-EXIT.                                                      DTSCS62
03513      EXIT.                                                        DTSCS62
03514                                                                   DTSCS62
03515  S9320-INQUIRY-FKEYS.                                             DTSCS62
03516      MOVE LOW-VALUES TO MAP-KEY-MOD                               DTSCS62
03517                         MAP-KEY-DEL.                              DTSCS62
03518                                                                   DTSCS62
03519 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS62
03520  S9320-EXIT.                                                      DTSCS62
03521      EXIT.                                                        DTSCS62
03522                                                                   DTSCS62
03523 *S9321-JUMP-KEYS.                                                 DTSCS62
03524 *    MOVE CFKD-REG-INQ                                            DTSCS62
03525 *      TO MAP-KEY-REG-INQ.                                        DTSCS62
03526 *    MOVE CFKD-AUDIT-RSLT-21                                      DTSCS62
03527 *      TO MAP-KEY-AUDIT-RSLT-21.                                  DTSCS62
03528 *    MOVE CFKD-ASSIGN-RPT-22                                      DTSCS62
03529 *      TO MAP-KEY-ASSIGN-RPT-22.                                  DTSCS62
03530 *S9321-EXIT.                                                      DTSCS62
03531 *    EXIT.                                                        DTSCS62
03532 *                                                                 DTSCS62
03533  S9330-DSCR-FIELDS.                                               DTSCS62
03534      IF WRK-MPRF-YES-88                                           DTSCS62
03535          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS62
03536      ELSE                                                         DTSCS62
03537          MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                     DTSCS62
03538                                                                   DTSCS62
03539      IF MAP-STATUS-CD = SPACES OR LOW-VALUES                      DTSCS62
03540          MOVE LOW-VALUES TO MAP-STATUS-CD-DESC                    DTSCS62
03541      ELSE                                                         DTSCS62
03542          MOVE MAP-STATUS-CD TO L036-CD                            DTSCS62
03543          PERFORM S036-EDIT-STATUS-CD THRU S036-EXIT               DTSCS62
03544          MOVE L036-SHORT-DSCR TO MAP-STATUS-CD-DESC.              DTSCS62
03545                                                                   DTSCS62
03546      IF MAP-FLD-REP-ID = SPACES OR LOW-VALUES                     DTSCS62
03547          MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC                   DTSCS62
03548      ELSE                                                         DTSCS62
03549          MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID                   DTSCS62
03550          PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT              DTSCS62
03551          MOVE L062-NAME TO MAP-FLD-REP-ID-DESC.                   DTSCS62
03552                                                                   DTSCS62
03553      IF MAP-ASSIGN-TYPE = SPACES OR LOW-VALUES                    DTSCS62
03554          MOVE LOW-VALUES TO MAP-ASSIGN-TYPE-DESC                  DTSCS62
03555      ELSE                                                         DTSCS62
03556          MOVE MAP-ASSIGN-TYPE TO L063-TYPE                        DTSCS62
03557          PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT        DTSCS62
03558          MOVE L063-DESCRIPTION TO MAP-ASSIGN-TYPE-DESC.           DTSCS62
03559                                                                   DTSCS62
03560      IF MAP-SOURCE-OP-ID = LOW-VALUES OR SPACES                   DTSCS62
03561          MOVE LOW-VALUES TO MAP-SOURCE-OP-ID-DESC                 DTSCS62
03562      ELSE                                                         DTSCS62
03563          IF MAP-SOURCE-OP-ID = LCCM-OP-ID                         DTSCS62
03564              MOVE LCCM-OP-NAME TO MAP-SOURCE-OP-ID-DESC           DTSCS62
03565          ELSE                                                     DTSCS62
03566              MOVE MAP-SOURCE-OP-ID TO L082-OP-ID                  DTSCS62
03567              PERFORM S082-OP-ID-EDIT THRU S082-EXIT               DTSCS62
03568              MOVE L082-NAME TO MAP-SOURCE-OP-ID-DESC.             DTSCS62
03569                                                                   DTSCS62
03570      MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.          DTSCS62
03571      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS62
03572      IF L018-NO-ENTRY OR L018-NOT-VALID                           DTSCS62
03573          MOVE LOW-VALUES TO MAP-RELATED-PRIMARY-NAME              DTSCS62
03574      ELSE                                                         DTSCS62
03575          MOVE LOW-VALUES TO MPRF-KEY-AREA                         DTSCS62
03576          MOVE L018-EMP-NO TO MPRF-EMP-NO                          DTSCS62
03577          SET MPRF-PRF-88 TO TRUE                                  DTSCS62
03578          MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA                      DTSCS62
03579          PERFORM S810-READ THRU S810-EXIT                         DTSCS62
03580          IF L810-OK-88                                            DTSCS62
03581              MOVE MSKL-REC TO MPRF-REC                            DTSCS62
03582              MOVE MPRF-PRIMARY-NAME TO MAP-RELATED-PRIMARY-NAME   DTSCS62
03583          ELSE                                                     DTSCS62
03584              MOVE 'NAME NOT AVAILABLE'                            DTSCS62
03585                TO MAP-RELATED-PRIMARY-NAME.                       DTSCS62
03586                                                                   DTSCS62
03587  S9330-EXIT. EXIT.                                                DTSCS62
03588                                                                   DTSCS62
03589  S9900-PREPARE-SEND.                                              DTSCS62
03590      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS62
03591                         LCCM-SCR-ID.                              DTSCS62
03592      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS62
03593      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS62
03594  S9900-EXIT.                                                      DTSCS62
03595      EXIT.                                                        DTSCS62
