97 lines
7.6 KiB
COBOL
97 lines
7.6 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/01/98
|
|
00002 PROGRAM-ID. DTSCU022 DTSCU022
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
|
|
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU022
|
|
00005 DATE-COMPILED. DTSCU022
|
|
00006 SKIP3 DTSCU022
|
|
00007 ***** DTSCU022
|
|
00008 * DTSCU022
|
|
00009 * FUNCTION: EDIT AND FORMAT ASSIGN-YR AND ASSIGN-SEQ DTSCU022
|
|
00010 * DTSCU022
|
|
00011 * DTSCU022
|
|
00012 * MODIFICATION LOG: DTSCU022
|
|
00013 * DTSCU022
|
|
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU022. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSCU022
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU022
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU022
|
|
00019 * WORK ORDER: PROGRAMMER: DTSCU022
|
|
00020 * DTSCU022
|
|
00021 * DTSCU022
|
|
00022 * DESCRIPTION: DTSCU022
|
|
00023 * DTSCU022
|
|
00024 ***** DTSCU022
|
|
00025 SKIP3 DTSCU022
|
|
00026 ENVIRONMENT DIVISION. DTSCU022
|
|
00027 DATA DIVISION. DTSCU022
|
|
00028 SKIP3 DTSCU022
|
|
00029 WORKING-STORAGE SECTION. DTSCU022
|
|
000295 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU022 09/01/98'. DTSCU022
|
|
00030 01 WRK-AREA. DTSCU022
|
|
00031 05 WRK-ASSIGN-AREA. DTSCU022
|
|
00032 10 WRK-ASSIGN-YR PIC 9(04). DTSCU022
|
|
00033 10 WRK-ASSIGN-SEQ PIC 9(05). DTSCU022
|
|
00034 05 WRK-COMPLETE-ASSIGN-NO REDEFINES WRK-ASSIGN-AREA DTSCU022
|
|
00035 PIC 9(09). DTSCU022
|
|
00036 EJECT DTSCU022
|
|
00037 01 DTSIL007-COMM-AREA. CL**2
|
|
00038 ++INCLUDE DTSIL007 CL**3
|
|
00039 EJECT DTSCU022
|
|
00040 01 DTSIL013-COMM-AREA. CL**2
|
|
00041 ++INCLUDE DTSIL013 CL**3
|
|
00042 EJECT DTSCU022
|
|
00043 LINKAGE SECTION. DTSCU022
|
|
00044 01 DFHCOMMAREA. DTSCU022
|
|
00045 ++INCLUDE DTSIL022 CL**3
|
|
00046 EJECT DTSCU022
|
|
00047 PROCEDURE DIVISION. DTSCU022
|
|
00048 SKIP2 DTSCU022
|
|
00049 SET L022-NOT-VALID TO TRUE. DTSCU022
|
|
00050 MOVE +0 TO L022-ASSIGN-NO. DTSCU022
|
|
00051 SKIP2 DTSCU022
|
|
00052 IF (L022-S-ASSIGN-YR = SPACES OR LOW-VALUES) DTSCU022
|
|
00053 AND DTSCU022
|
|
00054 (L022-S-ASSIGN-SEQ = SPACES OR LOW-VALUES) DTSCU022
|
|
00055 SET L022-NO-ENTRY TO TRUE DTSCU022
|
|
00056 GO TO INIT0199-GO-BACK. DTSCU022
|
|
00057 SKIP1 DTSCU022
|
|
00058 SET L007-FROM-YR-2 TO TRUE. DTSCU022
|
|
00059 MOVE L022-S-ASSIGN-YR TO L007-YR-2-X. DTSCU022
|
|
00060 PERFORM S007-CONVERT-EDIT-YR THRU S007-EXIT. DTSCU022
|
|
00061 IF L007-VALID-YR DTSCU022
|
|
00062 MOVE L007-YR-4-9 TO WRK-ASSIGN-YR DTSCU022
|
|
00063 ELSE DTSCU022
|
|
00064 GO TO INIT0199-GO-BACK. DTSCU022
|
|
00065 SKIP1 DTSCU022
|
|
00066 MOVE L022-S-ASSIGN-SEQ-AREA TO L013-S-CNT-AREA. DTSCU022
|
|
00067 MOVE +1 TO L013-MIN-CNT. DTSCU022
|
|
00068 MOVE +99999 TO L013-MAX-CNT. DTSCU022
|
|
00069 PERFORM S013-CONVERT-EDIT-SEQ THRU S013-EXIT. DTSCU022
|
|
00070 IF L013-VALID DTSCU022
|
|
00071 MOVE L013-CNT TO WRK-ASSIGN-SEQ DTSCU022
|
|
00072 ELSE DTSCU022
|
|
00073 GO TO INIT0199-GO-BACK. DTSCU022
|
|
00074 SKIP1 DTSCU022
|
|
00075 MOVE WRK-COMPLETE-ASSIGN-NO TO L022-ASSIGN-NO. DTSCU022
|
|
00076 SET L022-VALID TO TRUE. DTSCU022
|
|
00077 INIT0199-GO-BACK. DTSCU022
|
|
00078 EXEC CICS DTSCU022
|
|
00079 RETURN DTSCU022
|
|
00080 END-EXEC. DTSCU022
|
|
00081 GOBACK. DTSCU022
|
|
00082 SKIP3 DTSCU022
|
|
00083 S007-CONVERT-EDIT-YR. DTSCU022
|
|
00084 EXEC CICS DTSCU022
|
|
00085 LINK PROGRAM ('DTSCU007') CL**2
|
|
00086 COMMAREA (DTSIL007-COMM-AREA) CL**2
|
|
00087 END-EXEC. DTSCU022
|
|
00088 S007-EXIT. EXIT. DTSCU022
|
|
00089 SKIP3 DTSCU022
|
|
00090 S013-CONVERT-EDIT-SEQ. DTSCU022
|
|
00091 EXEC CICS DTSCU022
|
|
00092 LINK PROGRAM ('DTSCU013') CL**2
|
|
00093 COMMAREA (DTSIL013-COMM-AREA) CL**2
|
|
00094 END-EXEC. DTSCU022
|
|
00095 S013-EXIT. EXIT. DTSCU022
|