00001  IDENTIFICATION DIVISION.                                         02/17/99
00002  PROGRAM-ID.             DTSBD620.                                DTSBD620
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           JANUARY 1992.                            DTSBD620
00005  DATE-COMPILED.                                                   DTSBD620
00006      SKIP3                                                        DTSBD620
00007 *****                                                             DTSBD620
00008 *                                                                 DTSBD620
00009 *    FUNCTION:  FUTA CURRENT YEAR CERTIFICATION RECORDS           DTSBD620
00010 *               SORT AND ELIMINATION OF DUPLICATES.               DTSBD620
00011 *                                                                 DTSBD620
00012 *                                                                 DTSBD620
00013 *    MODIFICATION LOG:                                            DTSBD620
00014 *                                                                 DTSBD620
00015 *    11/03/92  INITIAL DEVELOPMENT.                               DTSBD620
00016 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD620
00017 *                                                                 DTSBD620
00018 *    09/20/94  REWRITE FOR MONTANA.                               DTSBD620
00019 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD620
00020 *                                                                 DTSBD620
00021 *    02/17/1999  REVIEWED AND MODIFIED FOR DC.                       CL**2
00022 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00023 *                                                                    CL**2
00024 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00025 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00026 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00027 *                                                                 DTSBD620
00028 *                                                                 DTSBD620
00029 *  DESCRIPTION:                                                   DTSBD620
00030 *                                                                 DTSBD620
00031 *    INITIATION.                                                  DTSBD620
00032 *                                                                 DTSBD620
00033 *      SORTS THE FUTA CURRENT YEAR CERTIFICATION RECORDS          DTSBD620
00034 *      AND DROPS ANY DUPLICATES.                                  DTSBD620
00035 *                                                                 DTSBD620
00036 *      THIS PROGRAM GUARDS AGAINST DUPLICATE CURRENT YEAR         DTSBD620
00037 *      CERTIFICATION REQUESTS ON THE CERTIFICATION REQUEST        DTSBD620
00038 *      TAPE RECEIVED FROM THE IRS.                                DTSBD620
00039 *                                                                 DTSBD620
00040 *                                                                 DTSBD620
00041 *****                                                             DTSBD620
00042      SKIP3                                                        DTSBD620
00043  ENVIRONMENT DIVISION.                                            DTSBD620
00044      SKIP2                                                        DTSBD620
00045  INPUT-OUTPUT SECTION.                                            DTSBD620
00046                                                                      CL**2
00047  FILE-CONTROL.                                                    DTSBD620
00048      SELECT INPUT-FILE ASSIGN TO DTSFIN.                             CL**2
00049      SELECT OUTPUT-FILE ASSIGN TO DTSFOUT.                           CL**2
00050      SELECT SORT-FILE ASSIGN TO SORTFILE.                         DTSBD620
00051      EJECT                                                        DTSBD620
00052  DATA DIVISION.                                                   DTSBD620
00053      SKIP3                                                        DTSBD620
00054  FILE SECTION.                                                    DTSBD620
00055      SKIP3                                                        DTSBD620
00056  FD  INPUT-FILE                                                   DTSBD620
00057      RECORDING MODE IS F                                          DTSBD620
00058      BLOCK CONTAINS 0 RECORDS                                     DTSBD620
00059      LABEL RECORDS ARE STANDARD.                                  DTSBD620
00060                                                                      CL**2
00061  01  INPUT-REC.                                                   DTSBD620
00062  ++INCLUDE DTSIX971                                                  CL**2
00063      SKIP3                                                        DTSBD620
00064  FD  OUTPUT-FILE                                                  DTSBD620
00065      RECORDING MODE IS F                                          DTSBD620
00066      BLOCK CONTAINS 0 RECORDS                                     DTSBD620
00067      LABEL RECORDS ARE STANDARD.                                  DTSBD620
00068                                                                      CL**2
00069  01  OUTPUT-REC.                                                  DTSBD620
00070  ++INCLUDE DTSIX971                                                  CL**2
00071      SKIP3                                                        DTSBD620
00072  SD  SORT-FILE.                                                   DTSBD620
00073                                                                      CL**2
00074  01  SORT-REC.                                                    DTSBD620
00075  ++INCLUDE DTSIX971                                                  CL**2
00076      EJECT                                                        DTSBD620
00077  WORKING-STORAGE SECTION.                                         DTSBD620
000775 77  PAN-VALET PICTURE X(24) VALUE '002DTSBD620  02/17/99'.       DTSBD620
00078      SKIP3                                                        DTSBD620
00079  01  WRK-AREA.                                                    DTSBD620
00080      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +620.DTSBD620
00081                                                                      CL**2
00082      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD620'.   CL**2
00083                                                                      CL**2
00084      05  ABEND-MSG                   PIC  X(60).                  DTSBD620
00085                                                                      CL**2
00086                                                                      CL**2
00087      05  IN-REC-CNT                  PIC S9(07)  COMP-3.          DTSBD620
00088                                                                      CL**2
00089      05  DUP-REC-DROPPED-CNT         PIC S9(07)  COMP-3.          DTSBD620
00090                                                                      CL**2
00091      05  OUT-REC-CNT                 PIC S9(07)  COMP-3.          DTSBD620
00092                                                                      CL**2
00093                                                                      CL**2
00094      05  IN-EOF-IND                  PIC  X(01).                  DTSBD620
00095                                                                      CL**2
00096                                                                      CL**2
00097      05  SORT-EOR-IND                PIC  X(01).                  DTSBD620
00098                                                                      CL**2
00099                                                                      CL**2
00100      05  HOLD-KEY-AREA               PIC  X(04).                  DTSBD620
00101      EJECT                                                        DTSBD620
00102  PROCEDURE DIVISION.                                              DTSBD620
00103                                                                      CL**2
00104                                                                      CL**2
00105      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD620
00106                                                                   DTSBD620
00107                                                                      CL**2
00108      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD620
00109                                                                   DTSBD620
00110                                                                      CL**2
00111      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD620
00112                                                                      CL**2
00113                                                                      CL**2
00114      GOBACK.                                                      DTSBD620
00115      EJECT                                                        DTSBD620
00116  I0000-INITIATE.                                                  DTSBD620
00117      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    DTSBD620
00118                                                                      CL**2
00119                                                                      CL**2
00120      MOVE +0 TO IN-REC-CNT                                        DTSBD620
00121                 DUP-REC-DROPPED-CNT                               DTSBD620
00122                 OUT-REC-CNT.                                      DTSBD620
00123  I0000-EXIT.                                                      DTSBD620
00124      EXIT.                                                        DTSBD620
00125      SKIP3                                                        DTSBD620
00126  I1000-OPEN-FILES.                                                DTSBD620
00127      OPEN INPUT INPUT-FILE.                                       DTSBD620
00128                                                                   DTSBD620
00129      OPEN OUTPUT OUTPUT-FILE.                                     DTSBD620
00130  I1000-EXIT.                                                      DTSBD620
00131      EXIT.                                                        DTSBD620
00132      EJECT                                                        DTSBD620
00133  P0000-PROCESS.                                                   DTSBD620
00134      SORT SORT-FILE                                               DTSBD620
00135          ON ASCENDING KEY X971-KEY-AREA OF SORT-REC               DTSBD620
00136          INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT           DTSBD620
00137          OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT.        DTSBD620
00138  P0000-EXIT.                                                      DTSBD620
00139      EXIT.                                                        DTSBD620
00140      EJECT                                                        DTSBD620
00141  P1000-PRE-SORT.                                                  DTSBD620
00142      MOVE 'N' TO IN-EOF-IND.                                      DTSBD620
00143                                                                      CL**2
00144                                                                      CL**2
00145      PERFORM P1100-INPUT-RELEASE THRU P1100-EXIT                  DTSBD620
00146          UNTIL IN-EOF-IND = 'Y'.                                  DTSBD620
00147                                                                      CL**2
00148                                                                      CL**2
00149      DISPLAY ' '.                                                 DTSBD620
00150                                                                      CL**2
00151      DISPLAY '*** DTSBD620 PRE SORT STATISTICS'.                     CL**2
00152                                                                      CL**2
00153      DISPLAY IN-REC-CNT                                           DTSBD620
00154              ' RECORDS INCLUDED IN SORT'.                         DTSBD620
00155  P1000-EXIT.                                                      DTSBD620
00156      EXIT.                                                        DTSBD620
00157      SKIP3                                                        DTSBD620
00158  P1100-INPUT-RELEASE.                                             DTSBD620
00159      READ INPUT-FILE                                              DTSBD620
00160          AT END                                                   DTSBD620
00161              MOVE 'Y' TO IN-EOF-IND                               DTSBD620
00162              GO TO P1100-EXIT.                                    DTSBD620
00163                                                                      CL**2
00164                                                                      CL**2
00165      ADD +1 TO IN-REC-CNT.                                        DTSBD620
00166                                                                      CL**2
00167      MOVE INPUT-REC TO SORT-REC.                                  DTSBD620
00168                                                                      CL**2
00169      RELEASE SORT-REC.                                            DTSBD620
00170  P1100-EXIT.                                                      DTSBD620
00171      EXIT.                                                        DTSBD620
00172      EJECT                                                        DTSBD620
00173  P2000-POST-SORT.                                                 DTSBD620
00174      MOVE LOW-VALUES TO HOLD-KEY-AREA.                            DTSBD620
00175                                                                      CL**2
00176                                                                      CL**2
00177      MOVE 'N' TO SORT-EOR-IND.                                    DTSBD620
00178                                                                      CL**2
00179      PERFORM P2100-PROCESS-RETURN THRU P2100-EXIT                 DTSBD620
00180          UNTIL SORT-EOR-IND = 'Y'.                                DTSBD620
00181                                                                      CL**2
00182                                                                      CL**2
00183      DISPLAY ' '.                                                 DTSBD620
00184                                                                      CL**2
00185      DISPLAY '*** DTSBD620 POST SORT STATISTICS'.                    CL**2
00186                                                                      CL**2
00187      DISPLAY DUP-REC-DROPPED-CNT                                  DTSBD620
00188              ' RECORDS DROPPED (DUPLICATE EMP NO)'.               DTSBD620
00189                                                                      CL**2
00190      DISPLAY OUT-REC-CNT                                          DTSBD620
00191              ' RECORDS OUTPUT'.                                   DTSBD620
00192  P2000-EXIT.                                                      DTSBD620
00193      EXIT.                                                        DTSBD620
00194      SKIP3                                                        DTSBD620
00195  P2100-PROCESS-RETURN.                                            DTSBD620
00196      RETURN SORT-FILE                                             DTSBD620
00197          AT END                                                   DTSBD620
00198              MOVE 'Y' TO SORT-EOR-IND                             DTSBD620
00199              GO TO P2100-EXIT.                                    DTSBD620
00200                                                                      CL**2
00201                                                                      CL**2
00202      IF X971-KEY-AREA OF SORT-FILE                                DTSBD620
00203          = HOLD-KEY-AREA                                          DTSBD620
00204          ADD +1 TO DUP-REC-DROPPED-CNT                            DTSBD620
00205      ELSE                                                         DTSBD620
00206          MOVE X971-KEY-AREA OF SORT-FILE                          DTSBD620
00207            TO HOLD-KEY-AREA                                       DTSBD620
00208          ADD +1 TO OUT-REC-CNT                                    DTSBD620
00209          MOVE SORT-REC TO OUTPUT-REC                              DTSBD620
00210          WRITE OUTPUT-REC.                                        DTSBD620
00211  P2100-EXIT.                                                      DTSBD620
00212      EXIT.                                                        DTSBD620
00213      EJECT                                                        DTSBD620
00214  T0000-TERMINATE.                                                 DTSBD620
00215      CLOSE INPUT-FILE                                             DTSBD620
00216            OUTPUT-FILE.                                           DTSBD620
00217  T0000-EXIT.                                                      DTSBD620
00218      EXIT.                                                        DTSBD620
00219      EJECT                                                        DTSBD620
00220  S999-ABEND.                                                      DTSBD620
00221      DISPLAY '*** DTSBD620 ABENDING - '                              CL**2
00222              ABEND-MSG.                                           DTSBD620
00223                                                                      CL**2
00224      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00225  S999-EXIT.                                                       DTSBD620
00226      EXIT.                                                        DTSBD620
