DUTAS re-platformed to Raincode - Initial Source Code

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

85
CICS/DTSCU073.cob Normal file
View File

@ -0,0 +1,85 @@
00001 IDENTIFICATION DIVISION. 09/08/98
00002 PROGRAM-ID. DTSCU073. DTSCU073
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU073
00005 DATE-COMPILED. DTSCU073
00006 SKIP3 DTSCU073
00007 ***** DTSCU073
00008 * DTSCU073
00009 * FUNCTION: TELEPHONE NUMBER EDIT. DTSCU073
00010 * DTSCU073
00011 * DTSCU073
00012 * MODIFICATION LOG: DTSCU073
00013 * DTSCU073
00014 * 08/30/98 INITIAL DEVELOPMENT. COPIED FROM MACCU073. CL**2
00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2
00016 * DTSCU073
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU073
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU073
00019 * WORK ORDER: PROGRAMMER: XXX DTSCU073
00020 * DTSCU073
00021 * DTSCU073
00022 * DESCRIPTION: DTSCU073
00023 * DTSCU073
00024 * DTSCU073 IS PASSED L073-TELEPHONE. DTSCU073 EDITS CL**2
00025 * L073-TELEPHONE AND RETURNS L073-RESULT-IND. DTSCU073
00026 * DTSCU073
00027 * L073-ST AND L073-ZIP ARE NOT USED. IN THE FUTURE, DTSCU073
00028 * TIGHTER EDITS ON L073-TELEPHONE COULD UTILIZE L073-ST AND DTSCU073
00029 * L073-ZIP. DTSCU073
00030 * DTSCU073
00031 ***** DTSCU073
00032 CL**3
00033 ENVIRONMENT DIVISION. DTSCU073
00034 CL**3
00035 DATA DIVISION. DTSCU073
00036 CL**3
00037 WORKING-STORAGE SECTION. DTSCU073
000375 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU073 09/08/98'. DTSCU073
00038 CL**3
00039 01 WRK-AREA. DTSCU073
00040 05 WRK-ABEND-CODE PIC X(04) VALUE 'U073'. DTSCU073
00041 CL**3
00042 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU073
00043 EJECT DTSCU073
00044 LINKAGE SECTION. DTSCU073
00045 SKIP3 DTSCU073
00046 01 DFHCOMMAREA. DTSCU073
00047 ++INCLUDE DTSIL073 CL**3
00048 EJECT DTSCU073
00049 PROCEDURE DIVISION. DTSCU073
00050 CL**3
00051 SET L073-VALID TO TRUE. DTSCU073
00052 CL**3
00053 IF L073-TELEPHONE NOT = SPACE DTSCU073
00054 IF L073-AREA-CD = SPACE DTSCU073
00055 IF L073-ST = 'DC' CL**2
00056 MOVE '202' TO L073-AREA-CD CL**2
00057 ELSE DTSCU073
00058 SET L073-NOT-VALID TO TRUE. DTSCU073
00059 *********ELSE DTSCU073
00060 *************IF L073-AREA-CD < 201 DTSCU073
00061 *************OR L073-AREA-CD (2:1) > '1' DTSCU073
00062 *************** SET L073-NOT-VALID TO TRUE. DTSCU073
00063 CL**3
00064 PROCEDURE-EXIT. DTSCU073
00065 CL**3
00066 CL**3
00067 EXEC CICS DTSCU073
00068 RETURN DTSCU073
00069 END-EXEC. DTSCU073
00070 CL**3
00071 CL**3
00072 GOBACK. DTSCU073
00073 CL**3
00074 CL**3
00075 ****************** S899-ABEND NOT USED. DTSCU073
00076 *S899-ABEND. DTSCU073
00077 * SKIP1 DTSCU073
00078 * EXEC CICS DTSCU073
00079 * ABEND DTSCU073
00080 * ABCODE (WRK-ABEND-CODE) DTSCU073
00081 * END-EXEC. DTSCU073
00082 * SKIP1 DTSCU073
00083 *S899-EXIT. DTSCU073
00084 * EXIT. DTSCU073