DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
121
CICS/DTSCU062.cob
Normal file
121
CICS/DTSCU062.cob
Normal file
@ -0,0 +1,121 @@
|
||||
00001 IDENTIFICATION DIVISION. 09/08/98
|
||||
00002 PROGRAM-ID. DTSCU062. DTSCU062
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
||||
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU062
|
||||
00005 DATE-COMPILED. DTSCU062
|
||||
00006 SKIP3 DTSCU062
|
||||
00007 ***** DTSCU062
|
||||
00008 * DTSCU062
|
||||
00009 * FUNCTION: FIELD REP ID EDIT/DESCRIPTION. DTSCU062
|
||||
00010 * DTSCU062
|
||||
00011 * DTSCU062
|
||||
00012 * MODIFICATION LOG: DTSCU062
|
||||
00013 * DTSCU062
|
||||
00014 * 08/30/98 INITIAL DEVELOPMENT. COPIED FROM MACCU062 CL**2
|
||||
00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2
|
||||
00016 * DTSCU062
|
||||
00017 * DTSCU062
|
||||
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU062
|
||||
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU062
|
||||
00020 * WORK ORDER: PROGRAMMER: XXX DTSCU062
|
||||
00021 * DTSCU062
|
||||
00022 * DTSCU062
|
||||
00023 * DESCRIPTION: DTSCU062
|
||||
00024 * DTSCU062
|
||||
00025 * DTSCU062 EDITS FIELD REP ID. CL**2
|
||||
00026 * DTSCU062
|
||||
00027 * DTSCU062 RETURNS A RESULT INDICATOR AND (IF FIELD REP ID IS CL**2
|
||||
00028 * FOUND) L062-RETURN-AREA. DTSCU062
|
||||
00029 * DTSCU062
|
||||
00030 * IF FIELD REP ID IS NOT FOUND, THEN RETURN SPACES IN DTSCU062
|
||||
00031 * L062-RETURN-AREA, EXCEPT FOR 'NOT VALID' IN L062-NAME. DTSCU062
|
||||
00032 * DTSCU062
|
||||
00033 * DTSCU062 READS A REFERENCE FILE FFID RECORD. CL**2
|
||||
00034 * DTSCU062
|
||||
00035 ***** DTSCU062
|
||||
00036 SKIP3 DTSCU062
|
||||
00037 ENVIRONMENT DIVISION. DTSCU062
|
||||
00038 SKIP3 DTSCU062
|
||||
00039 DATA DIVISION. DTSCU062
|
||||
00040 SKIP3 DTSCU062
|
||||
00041 WORKING-STORAGE SECTION. DTSCU062
|
||||
000415 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU062 09/08/98'. DTSCU062
|
||||
00042 SKIP3 DTSCU062
|
||||
00043 01 WRK-AREA. DTSCU062
|
||||
00044 05 WRK-ABEND-CODE PIC X(04) VALUE 'U062'. DTSCU062
|
||||
00045 CL**3
|
||||
00046 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU062
|
||||
00047 EJECT DTSCU062
|
||||
00048 01 L831-COMM-AREA. DTSCU062
|
||||
00049 05 L831-CONTROL-AREA. DTSCU062
|
||||
00050 ++INCLUDE DTSIL831 CL**3
|
||||
00051 SKIP3 DTSCU062
|
||||
00052 05 FSKL-REC. DTSCU062
|
||||
00053 ++INCLUDE DTSIFSKL CL**3
|
||||
00054 SKIP3 DTSCU062
|
||||
00055 05 FFID-REC REDEFINES FSKL-REC. DTSCU062
|
||||
00056 ++INCLUDE DTSIFFID CL**3
|
||||
00057 EJECT DTSCU062
|
||||
00058 LINKAGE SECTION. DTSCU062
|
||||
00059 SKIP3 DTSCU062
|
||||
00060 01 DFHCOMMAREA. DTSCU062
|
||||
00061 ++INCLUDE DTSIL062 CL**3
|
||||
00062 EJECT DTSCU062
|
||||
00063 PROCEDURE DIVISION. DTSCU062
|
||||
00064 SKIP2 DTSCU062
|
||||
00065 SET L062-NOT-VALID TO TRUE. CL**3
|
||||
00066 CL**3
|
||||
00067 MOVE SPACE TO L062-RETURN-AREA. DTSCU062
|
||||
00068 CL**3
|
||||
00069 MOVE 'NOT VALID' TO L062-NAME. DTSCU062
|
||||
00070 CL**3
|
||||
00071 CL**3
|
||||
00072 MOVE LOW-VALUE TO FFID-KEY-AREA. DTSCU062
|
||||
00073 CL**3
|
||||
00074 SET FFID-FID-88 TO TRUE. DTSCU062
|
||||
00075 CL**3
|
||||
00076 MOVE L062-FLD-REP-ID TO FFID-FLD-REP-ID. DTSCU062
|
||||
00077 CL**3
|
||||
00078 PERFORM S831-READ THRU S831-EXIT. CL**3
|
||||
00079 CL**3
|
||||
00080 IF L831-OK-88 DTSCU062
|
||||
00081 SET L062-VALID TO TRUE CL**3
|
||||
00082 MOVE FFID-DATA-AREA TO L062-RETURN-AREA DTSCU062
|
||||
00083 ELSE DTSCU062
|
||||
00084 IF L831-FILE-CLOSED-88 DTSCU062
|
||||
00085 SET L062-FILE-CLOSED TO TRUE CL**3
|
||||
00086 MOVE L831-MSG-AREA TO L062-MSG-AREA. DTSCU062
|
||||
00087 CL**3
|
||||
00088 CL**3
|
||||
00089 EXEC CICS DTSCU062
|
||||
00090 RETURN DTSCU062
|
||||
00091 END-EXEC. DTSCU062
|
||||
00092 CL**3
|
||||
00093 CL**3
|
||||
00094 GOBACK. DTSCU062
|
||||
00095 EJECT CL**3
|
||||
00096 S831-READ. DTSCU062
|
||||
00097 SET L831-READ-88 TO TRUE. DTSCU062
|
||||
00098 GO TO S831-REF-FILE. DTSCU062
|
||||
00099 CL**3
|
||||
00100 S831-REF-FILE. DTSCU062
|
||||
00101 EXEC CICS DTSCU062
|
||||
00102 LINK DTSCU062
|
||||
00103 PROGRAM('DTSCU831') CL**2
|
||||
00104 COMMAREA(L831-COMM-AREA) DTSCU062
|
||||
00105 END-EXEC. DTSCU062
|
||||
00106 S831-EXIT. DTSCU062
|
||||
00107 EXIT. DTSCU062
|
||||
00108 CL**3
|
||||
00109 CL**3
|
||||
00110 CL**3
|
||||
00111 ****************** S899-ABEND NOT USED. DTSCU062
|
||||
00112 *S899-ABEND. DTSCU062
|
||||
00113 * SKIP1 DTSCU062
|
||||
00114 * EXEC CICS DTSCU062
|
||||
00115 * ABEND DTSCU062
|
||||
00116 * ABCODE (WRK-ABEND-CODE) DTSCU062
|
||||
00117 * END-EXEC. DTSCU062
|
||||
00118 * SKIP1 DTSCU062
|
||||
00119 *S899-EXIT. DTSCU062
|
||||
00120 * EXIT. DTSCU062
|
||||
Reference in New Issue
Block a user