122 lines
9.6 KiB
COBOL
122 lines
9.6 KiB
COBOL
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
|