DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
136
CICS/DTSCU834.cob
Normal file
136
CICS/DTSCU834.cob
Normal file
@ -0,0 +1,136 @@
|
||||
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
|
||||
Reference in New Issue
Block a user