DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
65
CICS/DTSCU027.cob
Normal file
65
CICS/DTSCU027.cob
Normal file
@ -0,0 +1,65 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/22/98
|
||||
00002 PROGRAM-ID. DTSCU027 DTSCU027
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
|
||||
00004 DATE-WRITTEN OCTOBER 1998. CL**4
|
||||
00005 DATE-COMPILED. DTSCU027
|
||||
00006 SKIP3 DTSCU027
|
||||
00007 ***** DTSCU027
|
||||
00008 * DTSCU027
|
||||
00009 * FUNCTION: EDIT AND FORMAT DC BUSINESS TAX NUMBER CL**2
|
||||
00010 * DTSCU027
|
||||
00011 * DTSCU027
|
||||
00012 * THE BUSINESS TAX NUMBER ENTERED MUST BE NUMERIC AND GREATER CL**3
|
||||
00013 * THAN ZERO. CL**3
|
||||
00014 * CL**3
|
||||
00015 * MODIFICATION LOG: DTSCU027
|
||||
00016 * DTSCU027
|
||||
00017 * 08/03/1998 INITIAL DEVELOPMENT. CREATED FOR DC. CL**2
|
||||
00018 * WORK ORDER: PROGRAMMER: CL**2
|
||||
00019 * DTSCU027
|
||||
00020 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU027
|
||||
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU027
|
||||
00022 * WORK ORDER: PROGRAMMER: DTSCU027
|
||||
00023 * DTSCU027
|
||||
00024 * DTSCU027
|
||||
00025 * DESCRIPTION: DTSCU027
|
||||
00026 * DTSCU027
|
||||
00027 ***** DTSCU027
|
||||
00028 SKIP3 DTSCU027
|
||||
00029 ENVIRONMENT DIVISION. DTSCU027
|
||||
00030 DATA DIVISION. DTSCU027
|
||||
00031 SKIP3 DTSCU027
|
||||
00032 WORKING-STORAGE SECTION. DTSCU027
|
||||
000325 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU027 10/22/98'. DTSCU027
|
||||
00033 EJECT DTSCU027
|
||||
00034 LINKAGE SECTION. DTSCU027
|
||||
00035 01 DFHCOMMAREA. DTSCU027
|
||||
00036 ++INCLUDE DTSIL027 CL**2
|
||||
00037 EJECT DTSCU027
|
||||
00038 PROCEDURE DIVISION. DTSCU027
|
||||
00039 DTSCU027-MAIN. CL**2
|
||||
00040 SET L027-NOT-VALID TO TRUE. CL**2
|
||||
00041 MOVE +0 TO L027-BTN. CL**2
|
||||
00042 SKIP2 DTSCU027
|
||||
00043 IF (L027-S-BTN = SPACES OR LOW-VALUES) CL**2
|
||||
00044 SET L027-NO-ENTRY TO TRUE CL**2
|
||||
00045 GO TO DTSCU027-MAIN-EXIT CL**2
|
||||
00046 END-IF. CL**2
|
||||
00047 SKIP1 DTSCU027
|
||||
00048 IF L027-S-BTN NUMERIC CL**2
|
||||
00049 IF L027-S-BTN > ZERO CL**2
|
||||
00050 MOVE L027-S-BTN-N TO L027-BTN CL**5
|
||||
00051 SET L027-VALID TO TRUE CL**2
|
||||
00052 ELSE CL**2
|
||||
00053 SET L027-NOT-VALID TO TRUE CL**2
|
||||
00054 END-IF CL**2
|
||||
00055 ELSE CL**2
|
||||
00056 SET L027-NOT-VALID TO TRUE CL**2
|
||||
00057 END-IF. CL**2
|
||||
00058 SKIP1 DTSCU027
|
||||
00059 DTSCU027-MAIN-EXIT. CL**2
|
||||
00060 EXEC CICS DTSCU027
|
||||
00061 RETURN DTSCU027
|
||||
00062 END-EXEC. DTSCU027
|
||||
00063 GOBACK. DTSCU027
|
||||
00064 SKIP3 DTSCU027
|
||||
Reference in New Issue
Block a user