00001  IDENTIFICATION DIVISION.                                         02/02/99
00002  PROGRAM-ID.             DTSBU039.                                DTSBU039
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV003
00004  DATE-WRITTEN.           JULY 1994.                               DTSBU039
00005  DATE-COMPILED.                                                   DTSBU039
00006      SKIP3                                                        DTSBU039
00007 *****                                                             DTSBU039
00008 *                                                                 DTSBU039
00009 *    FUNCTION:  SIC EDIT/DESCRIPTION.                             DTSBU039
00010 *                                                                 DTSBU039
00011 *                                                                 DTSBU039
00012 *    MODIFICATION LOG:                                            DTSBU039
00013 *                                                                 DTSBU039
00014 *    07/12/94  CLONED FROM DTSCU039.                                 CL**2
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBU039
00016 *                                                                 DTSBU039
00017 *    02/02/1999  REVIEWED AND MODIFIED FOR DC.                       CL**2
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00019 *                                                                 DTSBU039
00020 *                                                                 DTSBU039
00021 *    DESCRIPTION:                                                 DTSBU039
00022 *                                                                 DTSBU039
00023 *    DTSBU039 EDITS SIC CODE.                                        CL**2
00024 *                                                                 DTSBU039
00025 *    DTSBU039 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION        CL**2
00026 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSBU039
00027 *    VALUE.                                                       DTSBU039
00028 *                                                                 DTSBU039
00029 *****                                                             DTSBU039
00030      SKIP3                                                        DTSBU039
00031  ENVIRONMENT DIVISION.                                            DTSBU039
00032      SKIP3                                                        DTSBU039
00033  DATA DIVISION.                                                   DTSBU039
00034      SKIP3                                                        DTSBU039
00035  WORKING-STORAGE SECTION.                                         DTSBU039
000355 77  PAN-VALET PICTURE X(24) VALUE '003DTSBU039  02/02/99'.       DTSBU039
00036      SKIP3                                                        DTSBU039
00037  01  WRK-AREA.                                                    DTSBU039
00038      05  WRK-ABEND-CODE              PIC S9(04)  COMP             DTSBU039
00039                                                  VALUE +039.      DTSBU039
00040      EJECT                                                        DTSBU039
00041  01  L933-LINK-AREA.                                              DTSBU039
00042      05  L933-CONTROL-BLOCK.                                      DTSBU039
00043  ++INCLUDE DTSIL933                                                  CL**2
00044      SKIP3                                                        DTSBU039
00045  01  XSIC-LINK-AREA.                                              DTSBU039
00046      05  XSIC-REC.                                                DTSBU039
00047  ++INCLUDE DTSIXSIC                                                  CL**2
00048      EJECT                                                        DTSBU039
00049  LINKAGE SECTION.                                                 DTSBU039
00050      SKIP3                                                        DTSBU039
00051  01  L039-LINK-AREA.                                              DTSBU039
00052  ++INCLUDE DTSIL039                                                  CL**2
00053      EJECT                                                        DTSBU039
00054  PROCEDURE DIVISION USING L039-LINK-AREA.                            CL**2
00055                                                                      CL**2
00056                                                                      CL**2
00057      PERFORM P1000-PROCESS THRU P1000-EXIT                        DTSBU039
00058                                                                      CL**2
00059                                                                      CL**2
00060      GOBACK.                                                      DTSBU039
00061      EJECT                                                        DTSBU039
00062  P1000-PROCESS.                                                   DTSBU039
00063      SET L039-SIC-NOT-VALID TO TRUE.                              DTSBU039
00064                                                                      CL**2
00065      MOVE 'NOT VALID' TO L039-SIC-SHORT-DSCR                      DTSBU039
00066                          L039-SIC-LONG-DSCR.                      DTSBU039
00067                                                                   DTSBU039
00068                                                                      CL**2
00069 *****SET L039-OWN-NOT-VALID TO TRUE.                                 CL**2
00070                                                                      CL**2
00071 *****MOVE 'NOT VALID' TO L039-OWN-SHORT-DSCR                         CL**2
00072 *************************L039-OWN-LONG-DSCR.                         CL**2
00073                                                                   DTSBU039
00074                                                                      CL**2
00075      MOVE SPACES TO L039-MSG-AREA.                                DTSBU039
00076                                                                   DTSBU039
00077                                                                      CL**2
00078      PERFORM P1100-SIC-CD THRU P1100-EXIT.                        DTSBU039
00079                                                                   DTSBU039
00080                                                                      CL**2
00081 *****PERFORM P1200-OWN-CD THRU P1200-EXIT.                           CL**2
00082  P1000-EXIT.                                                      DTSBU039
00083      EXIT.                                                        DTSBU039
00084      EJECT                                                        DTSBU039
00085  P1100-SIC-CD.                                                    DTSBU039
00086      IF L039-SIC-CD NUMERIC                                          CL**3
00087          NEXT SENTENCE                                            DTSBU039
00088      ELSE                                                         DTSBU039
00089          GO TO P1100-EXIT.                                        DTSBU039
00090                                                                   DTSBU039
00091      IF L039-SIC-CD = '9999'                                         CL**2
00092          MOVE 'NOT DETRM' TO L039-SIC-SHORT-DSCR                  DTSBU039
00093          MOVE 'NOT DETERMINED' TO L039-SIC-LONG-DSCR              DTSBU039
00094          SET L039-SIC-VALID TO TRUE                               DTSBU039
00095          GO TO P1100-EXIT.                                        DTSBU039
00096                                                                   DTSBU039
00097      MOVE L039-SIC-CD TO XSIC-KEY-AREA.                              CL**2
00098                                                                   DTSBU039
00099      MOVE '01' TO XSIC-LINE-NUMBER.                               DTSBU039
00100                                                                   DTSBU039
00101      SET L933-READ-88 TO TRUE.                                    DTSBU039
00102                                                                   DTSBU039
00103      PERFORM S933-SIC-I THRU S933-EXIT.                           DTSBU039
00104                                                                   DTSBU039
00105      IF L933-NO-REC-88                                            DTSBU039
00106          GO TO P1100-EXIT.                                        DTSBU039
00107                                                                   DTSBU039
00108      MOVE XSIC-SIC-DSCR TO L039-SIC-SHORT-DSCR                    DTSBU039
00109                            L039-SIC-LONG-DSCR.                    DTSBU039
00110                                                                   DTSBU039
00111      SET L039-SIC-VALID TO TRUE.                                  DTSBU039
00112  P1100-EXIT.                                                      DTSBU039
00113      EXIT.                                                        DTSBU039
00114      SKIP3                                                        DTSBU039
00115 *P1200-OWN-CD.                                                       CL**2
00116 *****IF L039-OWN-CD = '1 '                                           CL**2
00117 *********SET L039-OWN-VALID TO TRUE                                  CL**2
00118 *********MOVE 'FED GOV   '                                           CL**2
00119 ***********TO L039-OWN-SHORT-DSCR                                    CL**2
00120 *********MOVE 'FEDERAL GOVERNMENT'                                   CL**2
00121 ***********TO L039-OWN-LONG-DSCR                                     CL**2
00122 *****ELSE                                                            CL**2
00123 *****IF L039-OWN-CD = '2 '                                           CL**2
00124 *********SET L039-OWN-VALID TO TRUE                                  CL**2
00125 *********MOVE 'STATE GOV '                                           CL**2
00126 ***********TO L039-OWN-SHORT-DSCR                                    CL**2
00127 *********MOVE 'STATE GOVERNMENT'                                     CL**2
00128 ***********TO L039-OWN-LONG-DSCR                                     CL**2
00129 *****ELSE                                                            CL**2
00130 *****IF L039-OWN-CD = '3 '                                           CL**2
00131 *********SET L039-OWN-VALID TO TRUE                                  CL**2
00132 *********MOVE 'LOCAL GOV '                                           CL**2
00133 ***********TO L039-OWN-SHORT-DSCR                                    CL**2
00134 *********MOVE 'LOCAL GOVERNMENT'                                     CL**2
00135 ***********TO L039-OWN-LONG-DSCR                                     CL**2
00136 *****ELSE                                                            CL**2
00137 *****IF L039-OWN-CD = '4 '                                           CL**2
00138 *********SET L039-OWN-VALID TO TRUE                                  CL**2
00139 *********MOVE 'FOREIGN   '                                           CL**2
00140 ***********TO L039-OWN-SHORT-DSCR                                    CL**2
00141 *********MOVE 'FOREIGN'                                              CL**2
00142 ***********TO L039-OWN-LONG-DSCR                                     CL**2
00143 *****ELSE                                                            CL**2
00144 *****IF L039-OWN-CD = '5 '                                           CL**2
00145 *********SET L039-OWN-VALID TO TRUE                                  CL**2
00146 *********MOVE 'PRIVATE   '                                           CL**2
00147 ***********TO L039-OWN-SHORT-DSCR                                    CL**2
00148 *********MOVE 'PRIVATE'                                              CL**2
00149 ***********TO L039-OWN-LONG-DSCR.                                    CL**2
00150 *P1200-EXIT.                                                         CL**2
00151 *****EXIT.                                                           CL**2
00152      EJECT                                                        DTSBU039
00153  S933-SIC-I.                                                      DTSBU039
00154      CALL 'DTSBU933'                                                 CL**2
00155          USING L933-LINK-AREA                                     DTSBU039
00156                XSIC-LINK-AREA.                                    DTSBU039
00157  S933-EXIT.                                                       DTSBU039
00158      EXIT.                                                        DTSBU039
