DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
85
CICS/DTSCU073.cob
Normal file
85
CICS/DTSCU073.cob
Normal 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
|
||||
Reference in New Issue
Block a user