Repository navigation
Expand file tree
/
Copy pathDKRSTR
More file actions
113 lines (105 loc) · 4.34 KB
/
Copy pathDKRSTR
File metadata and controls
113 lines (105 loc) · 4.34 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
/*********************************************************************/
/* ÁÕÔÇ Ç ÑÏÕÔÉÍÁ */
/* ÐÁÉÑÍÅÉ ÓÁÍ INPUT : YEAR = ÅÔÏÓ ANAFORAS */
/* */
/* ÊÁÉ ÅÐÉÓÔÑÅÖÅÉ FIRST CHAR(06) = ÇÌÅÑÏÌÇÍÉÁ ÐÑÙÔÏÕ ÅÊÔÏÊÉÓÌÏÕ */
/* SECOND CHAR(06) = ÇÌÅÑÏÌÇÍÉÁ ÄÅÕÔÅÑÏÕ ÅÊÔÏÊÉÓÌ */
/* -1 ÁÍ ÅÉÍÁÉ ËÁÈÏÓ ÔÏ INPUT */
/* ×ÑÇÓÉÌÏÐÏÉźÔÅ ÓÔÏ ÐÑÏÃÑÁÌÌÁ DK512 */
/*********************************************************************/
/* ÍÐÊ 15-02-2007 */
/*********************************************************************/
DKRSTR : PROC(YEAR,FIRST,SECOND)
OPTIONS(FETCHABLE) RETURNS( FIXED (1));
DCL YEAR FIXED(4);
DCL P_YEAR PIC'(4)9';
DCL RC FIXED(1);
DCL FIRST CHAR(06); /*DDMMYY*/
DCL SECOND CHAR(06); /*DDMMYY*/
/*DCL DAY_OF_WEEK FIXED DEC(1,0);*/
DCL I FIXED DEC(1,0);
DCL ADDR BUILTIN ;
DCL ONCODE BUILTIN ;
EXEC SQL INCLUDE SQLCA; 01510500
EXEC SQL INCLUDE START; 01510500
/**************************************************************
* A100_FIND_FIRST_PERIOD START *
**************************************************************/
A100_FIND_FIRST_PERIOD: PROC RETURNS(CHAR(6) );
DCL R_STR CHAR(6);
DCL 1 P_DATE BASED(ADDR(START_DATE)),
2 PICDD PIC'(2)9',
2 F1 CHAR(1) ,
2 PICMM PIC'(2)9',
2 F2 CHAR(3) ,
2 PICYY PIC'(2)9';
P_YEAR = YEAR;
START_DATE = '14.'!!'06.'!!P_YEAR;
PUT SKIP LIST (' START_DATE ', START_DATE);
DO I = 1 TO 7;
PICDD = PICDD + 1;
DAY_OF_WEEK = 0;
EXEC SQL SELECT DAYOFWEEK(DATE(:START_DATE))
INTO :DAY_OF_WEEK FROM SYSIBM.SYSDUMMY1 ;
IF SQLCODE = 0 THEN DO;
IF DAY_OF_WEEK = 6 THEN DO;
R_STR = SUBSTR(START_DATE,1,2)!!SUBSTR(START_DATE,4,2)!!
SUBSTR(START_DATE,9,2);
PUT SKIP LIST (' FROM ROUTINE ', R_STR);
RETURN (R_STR);
END;
END;
ELSE
PUT SKIP LIST (' SQLCODE ', CHAR(SQLCODE));
END;
END A100_FIND_FIRST_PERIOD;
/**************************************************************
* A100_FIND_FIRST_PERIOD END *
**************************************************************/
/**************************************************************
* A200_FIND_SECOND_PERIOD START *
**************************************************************/
A200_FIND_SECOND_PERIOD: PROC RETURNS(CHAR(6) );
DCL R_STR CHAR(6);
DCL 1 P_DATE BASED(ADDR(START_DATE)),
2 PICDD PIC'(2)9',
2 F1 CHAR(1) ,
2 PICMM PIC'(2)9',
2 F2 CHAR(3) ,
2 PICYY PIC'(2)9';
P_YEAR = YEAR;
START_DATE = '14.'!!'12.'!!P_YEAR;
PUT SKIP LIST (' START_DATE ', START_DATE);
DO I = 1 TO 7;
PICDD = PICDD + 1;
DAY_OF_WEEK = 0;
EXEC SQL SELECT DAYOFWEEK(DATE(:START_DATE))
INTO :DAY_OF_WEEK FROM SYSIBM.SYSDUMMY1 ;
IF SQLCODE = 0 THEN DO;
IF DAY_OF_WEEK = 6 THEN DO;
R_STR = SUBSTR(START_DATE,1,2)!!SUBSTR(START_DATE,4,2)!!
SUBSTR(START_DATE,9,2);
PUT SKIP LIST (' FROM ROUTINE ', R_STR);
RETURN (R_STR);
END;
END;
ELSE
PUT SKIP LIST (' SQLCODE ', CHAR(SQLCODE));
END;
END A200_FIND_SECOND_PERIOD;
/**************************************************************
* A200_FIND_SECOND_PERIOD END *
**************************************************************/
ON ERROR BEGIN;
ON ERROR SYSTEM;
PUT SKIP LIST( 'ERROR ');
RC = -1;
GOTO R_POINT;
END;
FIRST = A100_FIND_FIRST_PERIOD();
SECOND = A200_FIND_SECOND_PERIOD();
RC = 0;
R_POINT:;
RETURN (RC);
END DKRSTR ;