DBA Data[Home] [Help]

PACKAGE BODY: APPS.HRI_BPL_TREND_WRKFC_SQL

Source


1 PACKAGE BODY hri_bpl_trend_wrkfc_sql AS
2 /* $Header: hribtwrk.pkb 120.5 2005/06/24 02:30:34 cbridge noship $ */
3 --
4 --
5 g_column_select   VARCHAR2(1000);
6 g_column_bucket   VARCHAR2(1000);
7 g_rtn             VARCHAR2(30) := '
8 ';
9 --
10 --
11 /******************************************************************************/
12 /* PROCESS FLOW                                                               */
13 /* ============                                                               */
14 /* The main entry point is the get_sql function. The processing is as follows */
15 /*                                                                            */
16 /* SELECT                                                                     */
17 /* ------                                                                     */
18 /* Templates for the measure columns are set by the set_metadata function.    */
19 /* Appropriate measures are then added to the select list using the template  */
20 /* depending on the input trend parameter record                              */
21 /*                                                                            */
22 /* A list of all the measure columns added is maintained and returned to the  */
23 /* calling function so that outer layers of SQL can reference all the columns */
24 /*                                                                            */
25 /* FROM                                                                       */
26 /* ----                                                                       */
27 /* The set_fact_table function in HRI_BPL_FACT_WRKFC_SQL is used to determine */
28 /* the appropriate fact object.                                               */
29 /*                                                                            */
30 /* WHERE                                                                      */
31 /* -----                                                                      */
32 /* set_conditions adds in any extra conditions required e.g. in top 4         */
33 /* countries a filter on the top 4 country codes is added                     */
34 /*                                                                            */
35 /* If the fact object is a snapshot MV then the date join will be an equality */
36 /* join rather than a between                                                 */
37 /*                                                                            */
38 /* A parameter date_join_type controls whether the fact is sampled at the     */
39 /* start or end of the trend period. This is used for e.g. the headcount for  */
40 /* turnover calculation which may be a start/end average                      */
41 /*                                                                            */
42 /* SQL RETURNED                                                               */
43 /* ============                                                               */
44 /* The SQL is returned along with a list of all the measure columns in the    */
45 /* SELECT list:                                                               */
46 /*                                                                            */
47 /*   SELECT                                                                   */
48 /*    Period Id (Date)                                                        */
49 /*    Period Order                                                            */
50 /*    Measure Columns                                                         */
51 /*   FROM                                                                     */
52 /*    Table of periods to plot (sub-query)                                    */
53 /*    Snapshot/standard fact object                                           */
54 /*   WHERE                                                                    */
55 /*    Filter on selected manager                                              */
56 /*    Date filter (varies with snapshot/standard fact)                        */
57 /*    Additional filters (e.g. top 4 countries)                               */
58 /*                                                                            */
59 /* An outer layer of SQL is added for the TURNOVER calculation.               */
60 /* An outer layer of SQL is added that brings in periods with no data by      */
61 /* doing a UNION ALL with the trend periods table.                            */
62 /*                                                                            */
63 /******************************************************************************/
64 --
65 -- Sets select column templates for accessing the workforce fact
66 --
67 PROCEDURE set_metadata IS
68 --
69 BEGIN
70 --
71 g_column_select := 'NVL(SUM(<measure>), 0)';
72 g_column_bucket :=
73 'NVL(SUM(CASE WHEN fact.<bucket> = <value>
74              THEN <measure>
75              ELSE 0
76         END), 0)';
77 --
78 END set_metadata;
79 --
80 --
81 -- -------------------------------------------------------------------------
82 -- This procedure is for future use only - applies dimension level parameter
83 -- conditions. Currently all trend reports are run from the main page which
84 -- does not have any additional parameters.
85 -- -------------------------------------------------------------------------
86 --
87 PROCEDURE analyze_parameters
88  (p_bind_tab         IN hri_oltp_pmv_util_param.HRI_PMV_BIND_TAB_TYPE,
89   p_fact_conditions  OUT NOCOPY VARCHAR2,
90   p_parameter_count  OUT NOCOPY PLS_INTEGER) IS
91 
92   l_parameter_name   VARCHAR2(100);
93 
94 BEGIN
95 
96 /* Initialize parameter count */
97   p_parameter_count := 0;
98 
99 /* Loop through parameters that have been set */
100   l_parameter_name := p_bind_tab.FIRST;
101 
102   WHILE (l_parameter_name IS NOT NULL) LOOP
103     IF (l_parameter_name = 'GEOGRAPHY+COUNTRY' OR
104         l_parameter_name = 'GEOGRAPHY+AREA' OR
105         l_parameter_name = 'JOB+JOB_FAMILY' OR
106         l_parameter_name = 'JOB+JOB_FUNCTION' OR
107         l_parameter_name = 'HRI_PRFRMNC+HRI_PRFMNC_RTNG_X' OR
108         l_parameter_name = 'HRI_PRSNTYP+HRI_WKTH_WKTYP' OR
109         l_parameter_name = 'HRI_LOW+HRI_LOW_BAND_X') THEN
110 
111     /* Dynamically set conditions for parameter */
112       p_fact_conditions := p_fact_conditions ||
113         'AND fact.' || hri_mtdt_dim_lvl.g_dim_lvl_mtdt_tab
114                         (l_parameter_name).fact_viewby_col ||
115         ' IN (' || p_bind_tab(l_parameter_name).pmv_bind_string || ')' || g_rtn;
116 
117     /* Keep count of parameters set */
118       p_parameter_count := p_parameter_count + 1;
119 
120     END IF;
121 
122   /* Move to next parameter */
123     l_parameter_name := p_bind_tab.NEXT(l_parameter_name);
124 
125   END LOOP;
126 
127 END analyze_parameters;
128 --
129 -- -------------------------------------------------------------------------
130 -- This function returns a string which contains the columns in the fact
131 -- that have to be selected. The columns that are to be selected are
132 -- specified as the metadata.
133 -- -------------------------------------------------------------------------
134 --
135 PROCEDURE set_select
136  (p_parameter_rec    IN hri_oltp_pmv_util_param.HRI_PMV_PARAM_REC_TYPE,
137   p_bucket_dim       IN VARCHAR2,
138   p_include_hdc      IN VARCHAR2,
139   p_include_pasg_cnt IN VARCHAR2,
140   p_include_pasg_pow IN VARCHAR2,
141   p_include_extn_cnt IN VARCHAR2,
142   p_include_extn_pow IN VARCHAR2,
143   p_include_hdc_trn  IN VARCHAR2,
144   p_include_sal      IN VARCHAR2,
145   p_use_snapshot     IN BOOLEAN,
146   p_select_sql       OUT NOCOPY VARCHAR2,
147   p_measure_columns  OUT NOCOPY hri_oltp_pmv_query_trend.trend_measure_cols_type)
148 IS
149 
150   -- template
151   l_column_bucket  VARCHAR2(1000);
152   -- table of bucket values
153   l_bucket_tab        hri_mtdt_dim_lvl.dim_lvl_buckets_tabtype;
154   --
155   -- For forming the select statement
156   --
157   l_measure_hdc       VARCHAR2(1000);
158   l_measure_sal       VARCHAR2(1000);
159 
160   l_measure_pasg_cnt  VARCHAR2(1000);
161   l_measure_pasg_pow  VARCHAR2(1000);
162   l_measure_extn_cnt  VARCHAR2(1000);
163   l_measure_extn_pow  VARCHAR2(1000);
164 
165   l_measure_count     PLS_INTEGER;
166   --
167 BEGIN
168 -- Initialize measure count and columns
169   l_measure_count := 0;
170   IF p_use_snapshot THEN
171     l_measure_hdc := 'fact.curr_total_hdc_end';
172 
173     l_measure_sal := 'hri_oltp_view_currency.convert_currency_amount
174 (fact.anl_slry_currency,
175  :GLOBAL_CURRENCY,
176  &BIS_CURRENT_ASOF_DATE,
177  fact.curr_total_anl_slry_end,
178  :GLOBAL_RATE)';
179 
180    l_measure_pasg_cnt := 'fact.curr_total_pasg_cnt_end';
181    l_measure_pasg_pow := 'fact.curr_total_pow_end';
182 
183    l_measure_extn_cnt := 'fact.curr_extn_asg_cnt_end';
184    l_measure_extn_pow := 'fact.curr_total_pow_extn_end';
185 
186   ELSE
187     l_measure_hdc := 'fact.total_headcount';
188 
189     l_measure_sal := 'hri_oltp_view_currency.convert_currency_amount
190 (fact.anl_slry_currency,
191  :GLOBAL_CURRENCY,
192  &BIS_CURRENT_ASOF_DATE,
193  fact.total_anl_slry,
194  :GLOBAL_RATE)';
195 
196    l_measure_pasg_cnt := 'fact.total_primary_asg_cnt';
197    l_measure_pasg_pow := 'fact.total_primary_asg_pow+' ||
198                          '(fact.total_primary_asg_cnt * (tro.period_as_of_date-fact.effective_start_date))';
199 
200    l_measure_extn_cnt := 'fact.total_extn_asg_cnt';
201    l_measure_extn_pow := 'fact.total_primary_extn_pow+' ||
202                          '(fact.total_extn_asg_cnt * (tro.period_as_of_date-fact.effective_start_date))';
203 
204 
205   END IF;
206 -- Check whether buckets are used
207   IF p_bucket_dim IS NOT NULL THEN
208 
209   -- Set the template to use the bucket column
210     l_column_bucket := REPLACE(g_column_bucket, '<bucket>',
211                                hri_mtdt_dim_lvl.g_dim_lvl_mtdt_tab
212                                 (p_bucket_dim).fact_viewby_col);
213 
214   -- Get a pl/sql table containing the buckets for the given bucket dimension
215     IF (p_bucket_dim = 'HRI_LOW+HRI_LOW_BAND_X') THEN
216       hri_mtdt_dim_lvl.set_low_band_buckets(p_parameter_rec.wkth_wktyp_sk_fk);
217       l_bucket_tab := hri_mtdt_dim_lvl.g_low_band_buckets_tab;
218     ELSIF (p_bucket_dim = 'HRI_PRFRMNC+HRI_PRFMNC_RTNG_X') THEN
219       l_bucket_tab := hri_mtdt_dim_lvl.g_prfmnc_band_buckets_tab;
220     ELSIF (p_bucket_dim = 'GEOGRAPHY+COUNTRY') THEN
221       l_bucket_tab := hri_mtdt_dim_lvl.g_country_buckets_tab;
222     ELSIF (p_bucket_dim = 'HRI_PRSNTYP+HRI_WKTH_WKTYP') THEN
223       l_bucket_tab := hri_mtdt_dim_lvl.g_wkth_wktyp_tab;
224     END IF;
225   END IF;
226 
227   -- Add headcount columns
228   IF (p_include_hdc = 'Y') THEN
229     p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
230                                               '<measure>', l_measure_hdc) ||
231                      '  period_hdc' || g_rtn;
232 
233     l_measure_count := l_measure_count + 1;
234     p_measure_columns(l_measure_count) := 'period_hdc';
235 
236     -- Add headcount start column if available (using snapshots) and if it is
237     -- required for the turnover calculation
238     -- do not add to list of returned measures
239     IF (p_use_snapshot AND
240         p_include_hdc_trn = 'Y') THEN
241       p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
242                                               '<measure>', 'fact.curr_total_hdc_start') ||
243                      '  period_hdc_start' || g_rtn;
244     END IF;
245 
246     -- Loop through buckets to add required columns
247     IF p_bucket_dim IS NOT NULL THEN
248       FOR i IN l_bucket_tab.FIRST..l_bucket_tab.LAST LOOP
249         p_select_sql := p_select_sql || ',' ||
250           REPLACE(REPLACE(l_column_bucket,
251                             '<measure>', l_measure_hdc),
252                   '<value>', l_bucket_tab(i).bucket_id_string) ||
253          '  period_hdc_' || l_bucket_tab(i).bucket_name || g_rtn;
254         l_measure_count := l_measure_count + 1;
255         p_measure_columns(l_measure_count) := 'period_hdc_' ||
256                                               l_bucket_tab(i).bucket_name;
257         -- Add headcount start column if available (using snapshots) and if it is
258         -- required for the turnover calculation
259         -- do not add to list of returned measures
260         IF (p_use_snapshot AND
261             p_include_hdc_trn = 'Y') THEN
262           p_select_sql := p_select_sql || ',' ||
263             REPLACE(REPLACE(l_column_bucket,
264                               '<measure>', 'fact.curr_total_hdc_start'),
265                     '<value>', l_bucket_tab(i).bucket_id_string) ||
266                          '  period_hdc_start_' || l_bucket_tab(i).bucket_name || g_rtn;
267         END IF;
268       END LOOP;
269     END IF;
270 
271   END IF;
272 
273   -- Add salary columns
274   IF (p_include_sal = 'Y') THEN
275     p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
276                                             '<measure>', l_measure_sal) ||
277                      '  period_sal_end' || g_rtn;
278 
279     l_measure_count := l_measure_count + 1;
280     p_measure_columns(l_measure_count) := 'period_sal_end';
281 
282     -- Loop through buckets to add required columns
283     IF p_bucket_dim IS NOT NULL THEN
284       FOR i IN l_bucket_tab.FIRST..l_bucket_tab.LAST LOOP
285         p_select_sql := p_select_sql || ',' ||
286           REPLACE(REPLACE(l_column_bucket,
287                           '<measure>', l_measure_sal),
288                   '<value>', l_bucket_tab(i).bucket_id_string) ||
289           '  period_sal_' || l_bucket_tab(i).bucket_name || g_rtn;
290         l_measure_count := l_measure_count + 1;
291         p_measure_columns(l_measure_count) := 'period_sal_' ||
292                                               l_bucket_tab(i).bucket_name;
293       END LOOP;
294     END IF;
295 
296   END IF;
297   --
298 
299   -- Add Primary Assignment Count columns
300   IF (p_include_pasg_cnt = 'Y') THEN
301    p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
302                                             '<measure>', l_measure_pasg_cnt) ||
303                      '  period_pasg_cnt' || g_rtn;
304 
305     l_measure_count := l_measure_count + 1;
306     p_measure_columns(l_measure_count) := 'period_pasg_cnt';
307   END IF;
308 
309   -- Add Primary Assignment Period of Work columns
310   IF (p_include_pasg_pow = 'Y') THEN
311    p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
312                                             '<measure>', l_measure_pasg_pow) ||
313                      '  period_pasg_pow' || g_rtn;
314 
315     l_measure_count := l_measure_count + 1;
316     p_measure_columns(l_measure_count) := 'period_pasg_pow';
317   END IF;
318 
319   -- Add Extension Assignment Count columns
320   IF (p_include_extn_cnt = 'Y') THEN
321    p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
322                                             '<measure>', l_measure_extn_cnt) ||
323                      '  period_extn_cnt' || g_rtn;
324 
325     l_measure_count := l_measure_count + 1;
326     p_measure_columns(l_measure_count) := 'period_extn_cnt';
327   END IF;
328 
329   -- Add Contingent Worker Extension Period of Work columns
330   IF (p_include_extn_pow = 'Y') THEN
331    p_select_sql := p_select_sql || ',' || REPLACE(g_column_select,
332                                             '<measure>', l_measure_extn_pow) ||
333                      '  period_extn_pow' || g_rtn;
334 
335     l_measure_count := l_measure_count + 1;
336     p_measure_columns(l_measure_count) := 'period_extn_pow';
337   END IF;
338 
339 END set_select;
340 --
341 -- -------------------------------------------------------------------------
342 -- This procedure returns conditions apart from the common conditions that
343 -- are present in a typical trend SQL.
344 -- -------------------------------------------------------------------------
345 --
346 PROCEDURE set_conditions(p_bucket_dim           IN VARCHAR2,
347                          p_fact_condition       IN OUT NOCOPY VARCHAR2)
348 IS
349   --
350   --
351 BEGIN
352   --
353   -- Set the country condition only when the bucket dimension is country
354   --
355   IF p_bucket_dim = 'GEOGRAPHY+COUNTRY' THEN
356     --
357     p_fact_condition := p_fact_condition ||
358 'AND fact.geo_country_code IN
359    (:GEO_COUNTRY_CODE1,
360     :GEO_COUNTRY_CODE2,
361     :GEO_COUNTRY_CODE3,
362     :GEO_COUNTRY_CODE4)' || g_rtn;
363     --
364   END IF;
365   --
366 END set_conditions;
367 
368 --
369 -- -------------------------------------------------------------------------
370 -- This function returns the inner SQL that is required for genrating the
371 -- headcount trend reports
372 --
373 -- INPUT PARAMETERS:
374 --  p_parameter_rec: Parameters passed to the report
375 --  p_bind_tab: The bind strings for PMV and SQL mode
376 --  p_bind_format : SQL or PMV format
377 --  p_include_hdc : Should headcount be included
378 --  p_include_sal : Should Salary be included
379 --  p_past_trend: Set if SQL has to be generated for past periods
380 --  p_future_trend: Set if SQL has to be generated for future periods
381 -- -------------------------------------------------------------------------
382 --
383 PROCEDURE get_sql
384  (p_parameter_rec     IN hri_oltp_pmv_util_param.HRI_PMV_PARAM_REC_TYPE,
385   p_bind_tab          IN hri_oltp_pmv_util_param.HRI_PMV_BIND_TAB_TYPE,
386   p_trend_sql_params  IN hri_oltp_pmv_query_trend.trend_sql_params_type,
387   p_date_join_type    IN VARCHAR2,
388   p_fact_sql          OUT NOCOPY VARCHAR2,
389   p_measure_columns   OUT NOCOPY hri_oltp_pmv_query_trend.trend_measure_cols_type,
390   p_use_snapshot      OUT NOCOPY BOOLEAN)
391 IS
392   --
393   l_trend_periods_tbl    VARCHAR2(32767);
394   l_select_sql           VARCHAR2(32767);
395   l_fact_table           VARCHAR2(100);
396   l_date_join            VARCHAR2(1000);
397   l_fact_condition       VARCHAR2(1000);
398   l_use_snapshot         BOOLEAN;
399   l_parameter_rec        hri_oltp_pmv_util_param.HRI_PMV_PARAM_REC_TYPE;
400   l_param_conditions     VARCHAR2(1000);
401   l_parameter_count      PLS_INTEGER;
402   --
403 BEGIN
404   -- -----------------------------------------------------------------------
405   -- FROM CLAUSE
406   -- -----------------------------------------------------------------------
407   analyze_parameters
408    (p_bind_tab         => p_bind_tab,
409     p_fact_conditions  => l_param_conditions,
410     p_parameter_count  => l_parameter_count);
411   --
412   -- Fetch the SQL for the table of periods
413   --
414   l_trend_periods_tbl := '(' ||
415                   HRI_OLTP_PMV_QUERY_TIME.get_time_clause
416                    (p_past_trend   => p_trend_sql_params.past_trend,
417                     p_future_trend => p_trend_sql_params.future_trend) || ')';
418   --
419   -- Set the fact table
420   --
421   l_parameter_rec := p_parameter_rec;
422   l_parameter_rec.view_by := 'HRI_PERSON+HRI_PER_USRDR_H';
423   hri_bpl_fact_sup_wrkfc_sql.set_fact_table
424    (p_parameter_rec => l_parameter_rec,
425     p_bucket_dim => p_trend_sql_params.bucket_dim,
426     p_include_sal => p_trend_sql_params.include_sal,
427     p_parameter_count => 0,
428     p_single_param => NULL,
429     p_use_snapshot => l_use_snapshot,
430     p_fact_table => l_fact_table);
431   --
432   -- -----------------------------------------------------------------------
433   -- SELECT CLAUSE
434   -- -----------------------------------------------------------------------
435   --
436   -- Set the select column templates
437   --
438   set_metadata;
439   --
440   --
441   -- Fetches the column in the select clause. If p_group_by is true then
442   -- all the columns will be summed up. Common columns included in all
443   -- trend reports will not be fetched
444   --
445   set_select
446    (p_parameter_rec => l_parameter_rec,
447     p_bucket_dim => p_trend_sql_params.bucket_dim,
448     p_include_hdc => p_trend_sql_params.include_hdc,
449     p_include_pasg_cnt  => p_trend_sql_params.include_pasg_cnt,
450     p_include_pasg_pow  => p_trend_sql_params.include_pasg_pow,
451     p_include_extn_cnt  => p_trend_sql_params.include_extn_cnt,
452     p_include_extn_pow  => p_trend_sql_params.include_extn_pow,
453     p_include_hdc_trn => p_trend_sql_params.include_hdc_trn,
454     p_include_sal => p_trend_sql_params.include_sal,
455     p_use_snapshot => l_use_snapshot,
456     p_select_sql => l_select_sql,
457     p_measure_columns => p_measure_columns);
458   --
459   --
460   -- -----------------------------------------------------------------------
461   -- WHERE CLAUSE
462   -- -----------------------------------------------------------------------
463   --
464   -- Get the conditions for the where clause. Common conditions included in all
465   -- trend reports will not be fetched
466   --
467   set_conditions
468    (p_bucket_dim          => p_trend_sql_params.bucket_dim,
469     p_fact_condition      => l_fact_condition);
470   --
471   -- Set the date join on period start / end
472   --
473   IF (p_date_join_type = 'PERIOD_START') THEN
474     l_date_join := 'AND tro.period_start_date - 1 ';
475   ELSE -- 'PERIOD_END'
476     l_date_join := 'AND tro.period_as_of_date ';
477   END IF;
478   --
479   -- Finish off the date join depending on whether a snapshot is used
480   --
481   IF l_use_snapshot THEN
482     l_date_join := l_date_join || '= fact.effective_date' || g_rtn;
483     l_fact_condition := l_fact_condition ||
484 'AND fact.period_type = &PERIOD_TYPE
485 AND fact.comparison_type IN (&TIME_COMPARISON_TYPE, ''TREND'')' || g_rtn;
486   ELSE
487     l_date_join := l_date_join || 'BETWEEN fact.effective_start_date ' ||
488                                   'AND fact.effective_end_date' || g_rtn;
489   END IF;
490 
491   IF (p_trend_sql_params.include_extn_cnt = 'Y' or p_trend_sql_params.include_extn_pow = 'Y') THEN
492      l_fact_condition := l_fact_condition
493        || 'AND fact.wkth_wktyp_sk_fk = ''CWK'' '|| g_rtn ;
494   END IF;
495 
496   --
497   -- -----------------------------------------------------------------------
498   -- BUILD THE SQL
499   -- -----------------------------------------------------------------------
500   --
501   p_fact_sql :=
502 'SELECT /*+ LEADING(tro) INDEX(fact) */
503  tro.period_as_of_date
504 ,tro.period_order' || g_rtn ||
505  l_select_sql ||
506 'FROM
507  ' || l_trend_periods_tbl || '  tro
508 ,' || l_fact_table || '  fact
509 WHERE fact.supervisor_person_id = &HRI_PERSON+HRI_PER_USRDR_H' || g_rtn ||
510  l_date_join ||
511  l_fact_condition ||
512  l_param_conditions ||
513 'GROUP BY
514  tro.period_order
515 ,tro.period_as_of_date';
516 
517   p_use_snapshot := l_use_snapshot;
518 
519 END get_sql;
520 
521 END hri_bpl_trend_wrkfc_sql;