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