69 lines
5.4 KiB
COBOL
69 lines
5.4 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/06/98
|
|
00002 PROGRAM-ID. DTSCU018 DTSCU018
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU018
|
|
00005 DATE-COMPILED. DTSCU018
|
|
00006 SKIP3 DTSCU018
|
|
00007 ***** DTSCU018
|
|
00008 * DTSCU018
|
|
00009 * FUNCTION: EDIT AND FORMAT EMPLOYER NUMBER FROM SCREEN DTSCU018
|
|
00010 * DTSCU018
|
|
00011 * DTSCU018
|
|
00012 * MODIFICATION LOG: DTSCU018
|
|
00013 * DTSCU018
|
|
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU018. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSCU018
|
|
00017 * DTSCU018
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU018
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU018
|
|
00020 * WORK ORDER: PROGRAMMER: DTSCU018
|
|
00021 * DTSCU018
|
|
00022 * DTSCU018
|
|
00023 * DESCRIPTION: DTSCU018
|
|
00024 * DTSCU018
|
|
00025 ***** DTSCU018
|
|
00026 SKIP3 DTSCU018
|
|
00027 ENVIRONMENT DIVISION. DTSCU018
|
|
00028 DATA DIVISION. DTSCU018
|
|
00029 SKIP3 DTSCU018
|
|
00030 WORKING-STORAGE SECTION. DTSCU018
|
|
000305 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU018 08/06/98'. DTSCU018
|
|
00031 01 WRK-AREA. DTSCU018
|
|
00032 10 WRK-EMP-NO. DTSCU018
|
|
00033 15 WRK-EMP-A-9 PIC 9(03). DTSCU018
|
|
00034 15 WRK-EMP-B-9 PIC 9(03). DTSCU018
|
|
00035 10 WRK-COMP-EMP-NO REDEFINES WRK-EMP-NO DTSCU018
|
|
00036 PIC 9(06). DTSCU018
|
|
00037 LINKAGE SECTION. DTSCU018
|
|
00038 01 DFHCOMMAREA. DTSCU018
|
|
00039 ++INCLUDE DTSIL018 CL**3
|
|
00040 PROCEDURE DIVISION. DTSCU018
|
|
00041 SKIP2 DTSCU018
|
|
00042 IF L018-S-EMP-NO1 = SPACES OR LOW-VALUES DTSCU018
|
|
00043 AND L018-S-EMP-NO2 = SPACES OR LOW-VALUES DTSCU018
|
|
00044 MOVE ZERO TO L018-EMP-NO DTSCU018
|
|
00045 SET L018-NO-ENTRY TO TRUE CL**2
|
|
00046 GO TO INIT0199-GO-BACK. DTSCU018
|
|
00047 IF L018-S-EMP-NO1 NOT NUMERIC DTSCU018
|
|
00048 OR L018-S-EMP-NO2 NOT NUMERIC DTSCU018
|
|
00049 PERFORM S-NOT-VALID THRU S-EXIT DTSCU018
|
|
00050 GO TO INIT0199-GO-BACK. DTSCU018
|
|
00051 MOVE L018-S-EMP-NO1 TO WRK-EMP-A-9. DTSCU018
|
|
00052 MOVE L018-S-EMP-NO2 TO WRK-EMP-B-9. DTSCU018
|
|
00053 IF WRK-COMP-EMP-NO = ZERO DTSCU018
|
|
00054 PERFORM S-NOT-VALID THRU S-EXIT DTSCU018
|
|
00055 GO TO INIT0199-GO-BACK. DTSCU018
|
|
00056 SET L018-VALID TO TRUE. CL**2
|
|
00057 MOVE WRK-COMP-EMP-NO TO L018-EMP-NO. DTSCU018
|
|
00058 INIT0199-GO-BACK. DTSCU018
|
|
00059 EXEC CICS DTSCU018
|
|
00060 RETURN DTSCU018
|
|
00061 END-EXEC. DTSCU018
|
|
00062 GOBACK. DTSCU018
|
|
00063 S-NOT-VALID. DTSCU018
|
|
00064 SET L018-NOT-VALID TO TRUE. CL**2
|
|
00065 MOVE ZERO TO L018-EMP-NO. DTSCU018
|
|
00066 S-EXIT. DTSCU018
|
|
00067 EXIT. DTSCU018
|