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

92
Batch/DTSBU062.cob Normal file
View File

@ -0,0 +1,92 @@
00001 IDENTIFICATION DIVISION. 11/05/98
00002 PROGRAM-ID. DTSBU062. DTSBU062
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
00004 DATE-WRITTEN. JULY 1994. DTSBU062
00005 DATE-COMPILED. DTSBU062
00006 SKIP3 DTSBU062
00007 ***** DTSBU062
00008 * DTSBU062
00009 * FUNCTION: FIELD REP ID EDIT/DESCRIPTION. DTSBU062
00010 * DTSBU062
00011 * DTSBU062
00012 * MODIFICATION LOG: DTSBU062
00013 * DTSBU062
00014 * 07/12/94 CLONED FROM DTSCU062. CL**2
00015 * WORK ORDER: PROGRAMMER: RHC DTSBU062
00016 * DTSBU062
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU062
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU062
00019 * WORK ORDER: PROGRAMMER: XXX DTSBU062
00020 * DTSBU062
00021 * DTSBU062
00022 * DESCRIPTION: DTSBU062
00023 * DTSBU062
00024 * DTSBU062 EDITS FIELD REP ID. CL**2
00025 * DTSBU062
00026 * DTSBU062 RETURNS A RESULT INDICATOR AND (IF FIELD REP ID IS CL**2
00027 * FOUND) L062-RETURN-AREA. DTSBU062
00028 * DTSBU062
00029 * IF FIELD REP ID IS NOT FOUND, THEN RETURN SPACES IN DTSBU062
00030 * L062-RETURN-AREA, EXCEPT FOR 'NOT VALID' IN L062-NAME. DTSBU062
00031 * DTSBU062
00032 * DTSBU062 READS A REFERENCE FILE FFID RECORD. CL**2
00033 * DTSBU062
00034 ***** DTSBU062
00035 SKIP3 DTSBU062
00036 ENVIRONMENT DIVISION. DTSBU062
00037 SKIP3 DTSBU062
00038 DATA DIVISION. DTSBU062
00039 SKIP3 DTSBU062
00040 WORKING-STORAGE SECTION. DTSBU062
000405 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU062 11/05/98'. DTSBU062
00041 SKIP3 DTSBU062
00042 01 WRK-AREA. DTSBU062
00043 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU062
00044 VALUE +062. DTSBU062
00045 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU062
00046 EJECT DTSBU062
00047 01 L931-LINK-AREA. DTSBU062
00048 05 L931-CONTROL-AREA. DTSBU062
00049 ++INCLUDE DTSIL931 CL**3
00050 SKIP3 DTSBU062
00051 01 FFID-LINK-AREA. DTSBU062
00052 05 FFID-REC. DTSBU062
00053 ++INCLUDE DTSIFFID CL**3
00054 EJECT DTSBU062
00055 LINKAGE SECTION. DTSBU062
00056 SKIP3 DTSBU062
00057 01 L062-LINK-AREA. DTSBU062
00058 ++INCLUDE DTSIL062 CL**2
00059 EJECT DTSBU062
00060 PROCEDURE DIVISION DTSBU062
00061 USING L062-LINK-AREA. DTSBU062
00062 SKIP2 DTSBU062
00063 MOVE '2' TO L062-RESULT-IND. DTSBU062
00064 MOVE SPACE TO L062-RETURN-AREA. DTSBU062
00065 MOVE 'NOT VALID' TO L062-NAME. DTSBU062
00066 SKIP1 DTSBU062
00067 MOVE LOW-VALUE TO FFID-KEY-AREA. DTSBU062
00068 SET FFID-FID-88 TO TRUE. DTSBU062
00069 MOVE L062-FLD-REP-ID TO FFID-FLD-REP-ID. DTSBU062
00070 SKIP1 DTSBU062
00071 PERFORM S931-READ DTSBU062
00072 THRU DTSBU062
00073 S931-EXIT. DTSBU062
00074 SKIP1 DTSBU062
00075 IF L931-OK-88 DTSBU062
00076 MOVE '1' TO L062-RESULT-IND DTSBU062
00077 MOVE FFID-DATA-AREA TO L062-RETURN-AREA. DTSBU062
00078 SKIP2 DTSBU062
00079 GOBACK. DTSBU062
00080 SKIP3 DTSBU062
00081 S931-READ. DTSBU062
00082 SET L931-READ-88 TO TRUE. DTSBU062
00083 GO TO S931-REF-FILE. DTSBU062
00084 S931-REF-FILE. DTSBU062
00085 SKIP1 DTSBU062
00086 CALL 'DTSBU931' CL**2
00087 USING L931-LINK-AREA DTSBU062
00088 FFID-LINK-AREA. DTSBU062
00089 SKIP1 DTSBU062
00090 S931-EXIT. DTSBU062
00091 EXIT. DTSBU062