110 lines
8.6 KiB
COBOL
110 lines
8.6 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/17/98
|
|
00002 PROGRAM-ID. DTSCU013 DTSCU013
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
|
00004 DATE-WRITTEN DECEMBER 1991. DTSCU013
|
|
00005 DATE-COMPILED. DTSCU013
|
|
00006 SKIP3 DTSCU013
|
|
00007 ***** DTSCU013
|
|
00008 * DTSCU013
|
|
00009 * FUNCTION: EDIT AND FORMAT EMPLOYEE COUNTS FROM SCREEN DTSCU013
|
|
00010 * DTSCU013
|
|
00011 * DTSCU013
|
|
00012 * MODIFICATION LOG: DTSCU013
|
|
00013 * DTSCU013
|
|
00014 * 08/03/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU013 CL**2
|
|
00015 * AND TXCU013. DTSCU013
|
|
00016 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00017 * DTSCU013
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU013
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU013
|
|
00020 * WORK ORDER: PROGRAMMER: DTSCU013
|
|
00021 * DTSCU013
|
|
00022 * DESCRIPTION: DTSCU013
|
|
00023 * DTSCU013
|
|
00024 * EDIT AND FORMAT L013-S-CNT, PLACING FORMATTED DTSCU013
|
|
00025 * VALUE IN L013-CNT DTSCU013
|
|
00026 * DTSCU013
|
|
00027 * EDIT FOR AMOUNT WITH NO DECIMAL PLACES DTSCU013
|
|
00028 * NEGATIVE VALUES ARE ALLOWED DTSCU013
|
|
00029 * DTSCU013
|
|
00030 ***** DTSCU013
|
|
00031 SKIP3 DTSCU013
|
|
00032 ENVIRONMENT DIVISION. DTSCU013
|
|
00033 DATA DIVISION. DTSCU013
|
|
00034 SKIP3 DTSCU013
|
|
00035 WORKING-STORAGE SECTION. DTSCU013
|
|
000355 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU013 09/17/98'. DTSCU013
|
|
00036 01 WRK-AREA. DTSCU013
|
|
00037 05 VALID-NUMBER-IND PIC X(01). DTSCU013
|
|
00038 05 NEGATIVE-FOUND-IND PIC X(01). DTSCU013
|
|
00039 05 WS-SUB PIC S9(04) COMP. DTSCU013
|
|
00040 05 IN-SUB PIC S9(04) COMP. DTSCU013
|
|
00041 05 WS-AREA PIC 9(10). CL**4
|
|
00042 LINKAGE SECTION. DTSCU013
|
|
00043 01 DFHCOMMAREA. DTSCU013
|
|
00044 ++INCLUDE DTSIL013 CL**3
|
|
00045 PROCEDURE DIVISION. DTSCU013
|
|
00046 INSPECT L013-S-CNT CONVERTING LOW-VALUE TO SPACE. DTSCU013
|
|
00047 SKIP2 DTSCU013
|
|
00048 IF L013-S-CNT = SPACES DTSCU013
|
|
00049 SET L013-NO-ENTRY TO TRUE CL**2
|
|
00050 MOVE ZERO TO L013-CNT DTSCU013
|
|
00051 GO TO INIT0199-GO-BACK. DTSCU013
|
|
00052 CL**2
|
|
00053 SET L013-VALID TO TRUE. CL**2
|
|
00054 MOVE +0 TO L013-CNT. CL**2
|
|
00055 MOVE 0 TO WS-AREA. CL**2
|
|
00056 MOVE 'N' TO VALID-NUMBER-IND. CL**2
|
|
00057 MOVE 'N' TO NEGATIVE-FOUND-IND. CL**2
|
|
00058 MOVE +11 TO WS-SUB. CL**4
|
|
00059 PERFORM P1000-LOOP THRU P1000-LOOP-EXIT CL**2
|
|
00060 VARYING IN-SUB FROM +10 BY -1 CL**4
|
|
00061 UNTIL IN-SUB < 1. DTSCU013
|
|
00062 CL**2
|
|
00063 IF L013-NOT-VALID DTSCU013
|
|
00064 GO TO INIT0199-GO-BACK. DTSCU013
|
|
00065 CL**2
|
|
00066 IF NEGATIVE-FOUND-IND = 'Y' DTSCU013
|
|
00067 COMPUTE L013-CNT = WS-AREA * -1 DTSCU013
|
|
00068 ELSE DTSCU013
|
|
00069 MOVE WS-AREA TO L013-CNT. DTSCU013
|
|
00070 CL**2
|
|
00071 IF (L013-MIN-CNT NOT < +0) AND CL**2
|
|
00072 (L013-CNT < +0) DTSCU013
|
|
00073 SET L013-INVALID-NEGATIVE TO TRUE CL**2
|
|
00074 SET L013-NOT-VALID TO TRUE CL**2
|
|
00075 GO TO INIT0199-GO-BACK. CL**2
|
|
00076 CL**2
|
|
00077 IF (L013-CNT < L013-MIN-CNT) OR CL**2
|
|
00078 (L013-CNT > L013-MAX-CNT) DTSCU013
|
|
00079 SET L013-EXCEEDS-MIN-MAX TO TRUE CL**2
|
|
00080 SET L013-NOT-VALID TO TRUE. CL**2
|
|
00081 INIT0199-GO-BACK. DTSCU013
|
|
00082 EXEC CICS DTSCU013
|
|
00083 RETURN DTSCU013
|
|
00084 END-EXEC. DTSCU013
|
|
00085 GOBACK. DTSCU013
|
|
00086 P1000-LOOP. DTSCU013
|
|
00087 IF L013-S-CNT (IN-SUB : 1) = SPACE OR CL**2
|
|
00088 L013-S-CNT (IN-SUB : 1) = LOW-VALUE OR CL**2
|
|
00089 L013-S-CNT (IN-SUB : 1) = ',' CL**2
|
|
00090 GO TO P1000-LOOP-EXIT. CL**2
|
|
00091 SKIP1 DTSCU013
|
|
00092 IF L013-S-CNT (IN-SUB : 1) = '-' DTSCU013
|
|
00093 IF NEGATIVE-FOUND-IND = 'Y' CL**2
|
|
00094 SET L013-NOT-NUMERIC TO TRUE CL**2
|
|
00095 SET L013-NOT-VALID TO TRUE CL**2
|
|
00096 GO TO P1000-LOOP-EXIT CL**2
|
|
00097 ELSE DTSCU013
|
|
00098 MOVE 'Y' TO NEGATIVE-FOUND-IND CL**2
|
|
00099 GO TO P1000-LOOP-EXIT. CL**2
|
|
00100 CL**2
|
|
00101 IF L013-S-CNT (IN-SUB : 1) NUMERIC DTSCU013
|
|
00102 SUBTRACT 1 FROM WS-SUB DTSCU013
|
|
00103 MOVE L013-S-CNT (IN-SUB : 1) TO WS-AREA (WS-SUB : 1) DTSCU013
|
|
00104 MOVE 'Y' TO VALID-NUMBER-IND DTSCU013
|
|
00105 ELSE DTSCU013
|
|
00106 SET L013-NOT-NUMERIC TO TRUE CL**2
|
|
00107 SET L013-NOT-VALID TO TRUE. CL**2
|
|
00108 P1000-LOOP-EXIT. EXIT. CL**2
|