giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DUTAS re-platformed to Raincode - Initial Source Code

Browse Source
This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

116
CICS/DTSCU063.cob Normal file
View File

@ -0,0 +1,116 @@
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