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

109
Batch/DTSBU082.cob Normal file
View File

@ -0,0 +1,109 @@
00001 IDENTIFICATION DIVISION. 09/18/98
00002 PROGRAM-ID. DTSBU082. DTSBU082
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
00004 DATE-WRITTEN. JULY 1994. DTSBU082
00005 DATE-COMPILED. DTSBU082
00006 SKIP3 DTSBU082
00007 ***** DTSBU082
00008 * DTSBU082
00009 * FUNCTION: OPERATOR ID EDIT/LOOKUP. DTSBU082
00010 * DTSBU082
00011 * DTSBU082
00012 * MODIFICATION LOG: DTSBU082
00013 * DTSBU082
00014 * 09/17/98 CLONED FROM MACCU082. CL**2
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
00016 * DTSBU082
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU082
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU082
00019 * WORK ORDER: PROGRAMMER: XXX DTSBU082
00020 * DTSBU082
00021 * DTSBU082
00022 * DESCRIPTION: DTSBU082
00023 * DTSBU082
00024 * DTSBU082 IS PASSED L082-OP-ID. CL**2
00025 * DTSBU082
00026 * REFERENCE FILE OPERATOR ID RECORDS ARE READ (VIA A LINK TO DTSBU082
00027 * DTSBU931) TO VALIDATE THE OPERATOR ID. CL**2
00028 * IF NO OPERATOR ID RECORD IS FOUND, THEN RETURN DTSBU082
00029 * 'NOT VALID' IN L082-OP-NAME (AS WELL AS THE APPROPRIATE DTSBU082
00030 * L082-RETURN-IND). DTSBU082
00031 * DTSBU082
00032 ***** DTSBU082
00033 SKIP3 DTSBU082
00034 ENVIRONMENT DIVISION. DTSBU082
00035 SKIP3 DTSBU082
00036 DATA DIVISION. DTSBU082
00037 SKIP3 DTSBU082
00038 WORKING-STORAGE SECTION. DTSBU082
000385 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU082 09/18/98'. DTSBU082
00039 SKIP3 DTSBU082
00040 01 WRK-AREA. DTSBU082
00041 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU082
00042 VALUE +082. DTSBU082
00043 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU082
00044 EJECT DTSBU082
00045 01 L931-LINK-AREA. DTSBU082
00046 05 L931-CONTROL-BLOCK. DTSBU082
00047 ++INCLUDE DTSIL931 CL**2
00048 EJECT DTSBU082
00049 01 FOPR-LINK-AREA. DTSBU082
00050 05 FOPR-REC. DTSBU082
00051 ++INCLUDE DTSIFOPR CL**2
00052 EJECT DTSBU082
00053 LINKAGE SECTION. DTSBU082
00054 SKIP3 DTSBU082
00055 01 L082-LINK-AREA. DTSBU082
00056 ++INCLUDE DTSIL082 CL**2
00057 EJECT DTSBU082
00058 PROCEDURE DIVISION DTSBU082
00059 USING L082-LINK-AREA. DTSBU082
00060 SKIP2 DTSBU082
00061 SET L082-NOT-VALID-OP TO TRUE. DTSBU082
00062 SKIP1 DTSBU082
00063 MOVE SPACE TO L082-DATA-AREA. DTSBU082
00064 SKIP1 DTSBU082
00065 MOVE 'NOT VALID' TO L082-NAME. DTSBU082
00066 SKIP1 DTSBU082
00067 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU082
00068 SKIP2 DTSBU082
00069 GOBACK. DTSBU082
00070 EJECT DTSBU082
00071 P1000-PROCESS. DTSBU082
00072 MOVE LOW-VALUES TO FOPR-KEY-AREA. DTSBU082
00073 SET FOPR-OPR-88 TO TRUE. DTSBU082
00074 MOVE L082-OP-ID TO FOPR-OP-ID. DTSBU082
00075 SKIP1 DTSBU082
00076 PERFORM S931-REF-READ THRU S931-EXIT. DTSBU082
00077 SKIP1 DTSBU082
00078 IF L931-NO-REC-88 DTSBU082
00079 GO TO P1000-EXIT. DTSBU082
00080 SKIP1 DTSBU082
00081 MOVE FOPR-TYPE TO L082-TYPE. DTSBU082
00082 MOVE FOPR-NAME TO L082-NAME. DTSBU082
00083 MOVE FOPR-TITLE TO L082-TITLE. DTSBU082
00084 MOVE FOPR-UNIT-NAME TO L082-UNIT-NAME. DTSBU082
00085 MOVE FOPR-BUREAU-NAME TO L082-BUREAU-NAME. DTSBU082
00086 MOVE FOPR-PHONE-NUMBERS TO L082-PHONE-NUMBERS. DTSBU082
00087 MOVE FOPR-UNIT-ID TO L082-UNIT-ID. DTSBU082
00088 MOVE FOPR-FLD-REP-ID TO L082-FLD-REP-ID. DTSBU082
00089 MOVE FOPR-FLD-DESK-IND TO L082-FLD-DESK-IND. DTSBU082
00090 MOVE FOPR-ACCOUNTING-DESK-IND TO L082-ACCOUNTING-DESK-IND. CL**2
00091 MOVE FOPR-EMAIL-ADDRESS TO L082-EMAIL-ADDRESS. CL**2
00092 SKIP1 DTSBU082
00093 SET L082-VALID-OP TO TRUE. DTSBU082
00094 P1000-EXIT. DTSBU082
00095 EXIT. DTSBU082
00096 EJECT DTSBU082
00097 S931-REF-READ. DTSBU082
00098 SET L931-READ-88 TO TRUE. DTSBU082
00099 GO TO S931-LINK-REF. DTSBU082
00100 SKIP1 DTSBU082
00101 S931-LINK-REF. DTSBU082
00102 SKIP1 DTSBU082
00103 CALL 'DTSBU931' CL**2
00104 USING L931-LINK-AREA DTSBU082
00105 FOPR-LINK-AREA. DTSBU082
00106 SKIP1 DTSBU082
00107 S931-EXIT. DTSBU082
00108 EXIT. DTSBU082