117 lines
9.2 KiB
COBOL
117 lines
9.2 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/07/12
|
|
00002 PROGRAM-ID. DTSCU063. DTSCU063
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
|
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU063
|
|
00005 DATE-COMPILED. DTSCU063
|
|
00006 SKIP3 DTSCU063
|
|
00007 ***** DTSCU063
|
|
00008 * DTSCU063
|
|
00009 * FUNCTION: ASSIGNMENT TYPE EDIT/DESCRIPTION. DTSCU063
|
|
00010 * DTSCU063
|
|
00011 * DTSCU063
|
|
00012 * MODIFICATION LOG: DTSCU063
|
|
00013 * DTSCU063
|
|
00014 * 11/11/98 INITIAL DEVELOPMENT. COPIED FROM MACCU063 DTSCU063
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1 DTSCU063
|
|
00016 * DTSCU063
|
|
00017 * DTSCU063
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU063
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU063
|
|
00020 * WORK ORDER: PROGRAMMER: XXX DTSCU063
|
|
00021 * DTSCU063
|
|
00022 * DTSCU063
|
|
00023 * DESCRIPTION: DTSCU063
|
|
00024 * DTSCU063
|
|
00025 * DTSCU063 IS PASSED AN ASSIGN-TYPE. DTSCU063
|
|
00026 * DTSCU063 DETERMINES IF THE ASSIGN-TYPE IS VALID AND DTSCU063
|
|
00027 * RETURNS A RESULT INDICATOR AND (IF ASSIGN-TYPE IS VALID) DTSCU063
|
|
00028 * L063-DATA-AREA. DTSCU063
|
|
00029 * DTSCU063
|
|
00030 * IF ASSIGN-TYPE IS NOT VALID, RETURN SPACES IN L063-DATA-AREA,DTSCU063
|
|
00031 * EXCEPT RETURN 'NOT VALID' IN L063-DESCRIPTION. DTSCU063
|
|
00032 * DTSCU063
|
|
00033 * DTSCU063 READS A REFERENCE FILE FFAT RECORD TO DETERMINE DTSCU063
|
|
00034 * THE VALIDITY OF L063-TYPE AND TO FIND THE DESCRIPTION, ETC. DTSCU063
|
|
00035 * DTSCU063
|
|
00036 ***** DTSCU063
|
|
00037 SKIP3 DTSCU063
|
|
00038 ENVIRONMENT DIVISION. DTSCU063
|
|
00039 SKIP3 DTSCU063
|
|
00040 DATA DIVISION. DTSCU063
|
|
00041 SKIP3 DTSCU063
|
|
00042 WORKING-STORAGE SECTION. DTSCU063
|
|
000425 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU063 02/07/12'. DTSCU063
|
|
00043 SKIP3 DTSCU063
|
|
00044 01 WRK-AREA. DTSCU063
|
|
00045 05 WRK-ABEND-CODE PIC X(04) VALUE 'U063'. DTSCU063
|
|
00046 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU063
|
|
00047 EJECT DTSCU063
|
|
00048 01 L831-COMM-AREA. DTSCU063
|
|
00049 05 L831-CONTROL-BLOCK. DTSCU063
|
|
00050 ++INCLUDE DTSIL831 DTSCU063
|
|
00051 SKIP3 DTSCU063
|
|
00052 05 FSKL-REC. DTSCU063
|
|
00053 ++INCLUDE DTSIFSKL DTSCU063
|
|
00054 SKIP3 DTSCU063
|
|
00055 05 FFAT-REC REDEFINES FSKL-REC. DTSCU063
|
|
00056 ++INCLUDE DTSIFFAT DTSCU063
|
|
00057 EJECT DTSCU063
|
|
00058 LINKAGE SECTION. DTSCU063
|
|
00059 SKIP3 DTSCU063
|
|
00060 01 DFHCOMMAREA. DTSCU063
|
|
00061 ++INCLUDE DTSIL063 DTSCU063
|
|
00062 EJECT DTSCU063
|
|
00063 PROCEDURE DIVISION. DTSCU063
|
|
00064 SKIP2 DTSCU063
|
|
00065 MOVE '2' TO L063-RESULT-IND. DTSCU063
|
|
00066 MOVE SPACE TO L063-DATA-AREA. DTSCU063
|
|
00067 MOVE +0 TO L063-DEFAULT-DUE-DAYS. DTSCU063
|
|
00068 MOVE 'NOT VALID' TO L063-DESCRIPTION. DTSCU063
|
|
00069 SKIP1 DTSCU063
|
|
00070 MOVE LOW-VALUE TO FFAT-KEY-AREA. DTSCU063
|
|
00071 SET FFAT-FAT-88 TO TRUE. DTSCU063
|
|
00072 MOVE L063-TYPE TO FFAT-TYPE. DTSCU063
|
|
00073 SKIP1 DTSCU063
|
|
00074 PERFORM S831-READ DTSCU063
|
|
00075 THRU DTSCU063
|
|
00076 S831-EXIT. DTSCU063
|
|
00077 SKIP1 DTSCU063
|
|
00078 IF L831-OK-88 DTSCU063
|
|
00079 MOVE '1' TO L063-RESULT-IND DTSCU063
|
|
00080 MOVE FFAT-DATA-AREA TO L063-DATA-AREA DTSCU063
|
|
00081 ELSE DTSCU063
|
|
00082 IF L831-FILE-CLOSED-88 DTSCU063
|
|
00083 MOVE '3' TO L063-RESULT-IND DTSCU063
|
|
00084 MOVE L831-MSG-AREA TO L063-MSG-AREA. DTSCU063
|
|
00085 SKIP2 DTSCU063
|
|
00086 EXEC CICS DTSCU063
|
|
00087 RETURN DTSCU063
|
|
00088 END-EXEC. DTSCU063
|
|
00089 SKIP2 DTSCU063
|
|
00090 GOBACK. DTSCU063
|
|
00091 SKIP3 DTSCU063
|
|
00092 S831-READ. DTSCU063
|
|
00093 SET L831-READ-88 TO TRUE. DTSCU063
|
|
00094 GO TO S831-REF-FILE. DTSCU063
|
|
00095 S831-REF-FILE. DTSCU063
|
|
00096 SKIP1 DTSCU063
|
|
00097 EXEC CICS DTSCU063
|
|
00098 LINK DTSCU063
|
|
00099 PROGRAM('DTSCU831') DTSCU063
|
|
00100 COMMAREA(L831-COMM-AREA) DTSCU063
|
|
00101 END-EXEC. DTSCU063
|
|
00102 SKIP1 DTSCU063
|
|
00103 S831-EXIT. DTSCU063
|
|
00104 EXIT. DTSCU063
|
|
00105 SKIP2 DTSCU063
|
|
00106 ****************** S899-ABEND NOT USED. DTSCU063
|
|
00107 *S899-ABEND. DTSCU063
|
|
00108 * SKIP1 DTSCU063
|
|
00109 * EXEC CICS DTSCU063
|
|
00110 * ABEND DTSCU063
|
|
00111 * ABCODE (WRK-ABEND-CODE) DTSCU063
|
|
00112 * END-EXEC. DTSCU063
|
|
00113 * SKIP1 DTSCU063
|
|
00114 *S899-EXIT. DTSCU063
|
|
00115 * EXIT. DTSCU063
|