137 lines
11 KiB
COBOL
137 lines
11 KiB
COBOL
00001 IDENTIFICATION DIVISION. 03/30/04
|
|
00002 PROGRAM-ID. DTSCU834. DTSCU834
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008
|
|
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU834
|
|
00005 DATE-COMPILED. DTSCU834
|
|
00006 SKIP3 DTSCU834
|
|
00007 ***** DTSCU834
|
|
00008 * DTSCU834
|
|
00009 * FUNCTION: NAIC FILE INPUT. DTSCU834
|
|
00010 * DTSCU834
|
|
00011 * DTSCU834
|
|
00012 * MODIFICATION LOG: DTSCU834
|
|
00013 * DTSCU834
|
|
00014 * 09/13/1998 INITIAL DEVELOPMENT. COPIED FROM DTSCU833. DTSCU834
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1.DTSCU834
|
|
00016 * DTSCU834
|
|
00017 * 03/26/2004 MODIFIED FOR NEW VERSION OF VSAM NAICS FILE. DTSCU834
|
|
00018 * WORK ORDER: PROGRAMMER: GD DTSCU834
|
|
00019 * DTSCU834
|
|
00020 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU834
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU834
|
|
00022 * WORK ORDER: PROGRAMMER: XXX DTSCU834
|
|
00023 * DTSCU834
|
|
00024 * DTSCU834
|
|
00025 * DESCRIPTION: DTSCU834
|
|
00026 * DTSCU834
|
|
00027 * READ THE SPECIFIED SIC DESCRIPTION RECORD FROM THE LMI DTSCU834
|
|
00028 * "NAIC DESCRIPTION" FILE. DTSCU834
|
|
00029 * DTSCU834
|
|
00030 * THE TAX SYSTEM DOES NOT UPDATE THE LMI "NAIC DESCRIPTION" DTSCU834
|
|
00031 * FILE. THUS, THE ONLY VALID COMMAND IS READ. DTSCU834
|
|
00032 * DTSCU834
|
|
00033 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE MODULE. DTSCU834
|
|
00034 * DTSCU834
|
|
00035 * IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN NORMAL, DTSCU834
|
|
00036 * NOT FOUND, CLOSED, OR DISABLED, THEN ABEND THE MODULE. DTSCU834
|
|
00037 * DTSCU834
|
|
00038 * DTSCU834
|
|
00039 ***** DTSCU834
|
|
00040 SKIP3 DTSCU834
|
|
00041 ENVIRONMENT DIVISION. DTSCU834
|
|
00042 SKIP3 DTSCU834
|
|
00043 DATA DIVISION. DTSCU834
|
|
00044 SKIP3 DTSCU834
|
|
00045 WORKING-STORAGE SECTION. DTSCU834
|
|
000455 77 PAN-VALET PICTURE X(24) VALUE '008DTSCU834 03/30/04'. DTSCU834
|
|
00046 SKIP3 DTSCU834
|
|
00047 01 WRK-AREA. DTSCU834
|
|
00048 05 WRK-ABEND-CD PIC X(04) VALUE 'U834'. DTSCU834
|
|
00049 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU834
|
|
00050 SKIP1 DTSCU834
|
|
00051 05 EMSG-NOT-AVAILABLE. DTSCU834
|
|
00052 10 FILLER PIC X(04) VALUE 'E091'. DTSCU834
|
|
00053 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU834
|
|
00054 10 EMSG-FILE-NAME PIC X(08). DTSCU834
|
|
00055 10 FILLER PIC X(33) DTSCU834
|
|
00056 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU834
|
|
00057 SKIP1 DTSCU834
|
|
00058 05 WRK-FILE-NAME PIC X(08) VALUE 'DTSFNAIC'.DTSCU834
|
|
00059 SKIP1 DTSCU834
|
|
00060 05 WRK-REC-LENGTH PIC S9(04) COMP DTSCU834
|
|
00061 VALUE +80. DTSCU834
|
|
00062 EJECT DTSCU834
|
|
00063 LINKAGE SECTION. DTSCU834
|
|
00064 SKIP3 DTSCU834
|
|
00065 01 DFHCOMMAREA. DTSCU834
|
|
00066 05 L834-CONTROL-BLOCK. DTSCU834
|
|
00067 ++INCLUDE DTSIL834 DTSCU834
|
|
00068 SKIP3 DTSCU834
|
|
00069 05 XNIC-REC. DTSCU834
|
|
00070 ++INCLUDE DTSIXNIC DTSCU834
|
|
00071 EJECT DTSCU834
|
|
00072 PROCEDURE DIVISION. DTSCU834
|
|
00073 SKIP2 DTSCU834
|
|
00074 MOVE SPACES TO L834-MSG-AREA. DTSCU834
|
|
00075 SET L834-OK-88 TO TRUE. DTSCU834
|
|
00076 SKIP1 DTSCU834
|
|
00077 IF L834-READ-88 DTSCU834
|
|
00078 PERFORM P1100-READ THRU P1100-EXIT DTSCU834
|
|
00079 ELSE DTSCU834
|
|
00080 PERFORM S899-ABEND THRU S899-EXIT. DTSCU834
|
|
00081 SKIP2 DTSCU834
|
|
00082 EXEC CICS DTSCU834
|
|
00083 RETURN DTSCU834
|
|
00084 END-EXEC. DTSCU834
|
|
00085 SKIP2 DTSCU834
|
|
00086 GOBACK. DTSCU834
|
|
00087 EJECT DTSCU834
|
|
00088 P1100-READ. DTSCU834
|
|
00089 SKIP1 DTSCU834
|
|
00090 EXEC CICS DTSCU834
|
|
00091 READ DTSCU834
|
|
00092 DATASET (WRK-FILE-NAME) DTSCU834
|
|
00093 INTO (XNIC-REC) DTSCU834
|
|
00094 LENGTH (WRK-REC-LENGTH) DTSCU834
|
|
00095 RIDFLD (XNIC-KEY-AREA) DTSCU834
|
|
00096 RESP (WRK-RESP-CD) DTSCU834
|
|
00097 END-EXEC. DTSCU834
|
|
00098 SKIP1 DTSCU834
|
|
00099 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU834
|
|
00100 OR DFHRESP (SYSIDERR) DTSCU834
|
|
00101 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU834
|
|
00102 GO TO P1100-EXIT. DTSCU834
|
|
00103 SKIP1 DTSCU834
|
|
00104 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU834
|
|
00105 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU834
|
|
00106 GO TO P1100-EXIT. DTSCU834
|
|
00107 SKIP1 DTSCU834
|
|
00108 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU834
|
|
00109 NEXT SENTENCE DTSCU834
|
|
00110 ELSE DTSCU834
|
|
00111 PERFORM S899-ABEND THRU S899-EXIT. DTSCU834
|
|
00112 P1100-EXIT. DTSCU834
|
|
00113 EXIT. DTSCU834
|
|
00114 EJECT DTSCU834
|
|
00115 S1100-NOT-AVAILABLE. DTSCU834
|
|
00116 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU834
|
|
00117 MOVE EMSG-NOT-AVAILABLE TO L834-MSG-AREA. DTSCU834
|
|
00118 SET L834-FILE-CLOSED-88 TO TRUE. DTSCU834
|
|
00119 S1100-EXIT. DTSCU834
|
|
00120 EXIT. DTSCU834
|
|
00121 SKIP3 DTSCU834
|
|
00122 S1200-NOT-FOUND. DTSCU834
|
|
00123 SET L834-NO-REC-88 TO TRUE. DTSCU834
|
|
00124 S1200-EXIT. DTSCU834
|
|
00125 EXIT. DTSCU834
|
|
00126 EJECT DTSCU834
|
|
00127 S899-ABEND. DTSCU834
|
|
00128 SKIP1 DTSCU834
|
|
00129 EXEC CICS DTSCU834
|
|
00130 ABEND DTSCU834
|
|
00131 ABCODE (WRK-ABEND-CD) DTSCU834
|
|
00132 END-EXEC. DTSCU834
|
|
00133 SKIP1 DTSCU834
|
|
00134 S899-EXIT. DTSCU834
|
|
00135 EXIT. DTSCU834
|