[firebase-br] Pegar Mes anterior e Posterior

[Luciano Carneiro]

----- Original Message ----- 
From: "Euler Jr." <euler em siginformatica.com.br>
To: "FireBase" <lista em firebase.com.br>
Sent: Friday, June 24, 2005 11:14 AM
Subject: Re: [firebase-br] Pegar Mes anterior e Posterior


> Criei a SP para esta finalidade. O código está abaixo:
>
> SET TERM # ;
> RECREATE PROCEDURE MES(MESANO CHAR(6)) RETURNS (ANTES CHAR(6),
> DEPOIS CHAR(6)) AS
... etc

Se quiser pode usar estas duas SPs que servem para este propósito:

CREATE PROCEDURE INC_DEC_PERI(
    WPER VARCHAR(7),
    WQTD SMALLINT)
RETURNS (
    R_INC_DEC_PERI VARCHAR(7))
AS
DECLARE VARIABLE WMES SMALLINT;
DECLARE VARIABLE WANO SMALLINT;
begin
wmes = cast(substring(:wper from 1 for 2) as SmallInt) + :wqtd;
wano = cast(substring(:wper from 4 for 4) as SmallInt);

if (:wqtd < 0) then
 begin
  while (:wmes < 1) do begin
   wmes = :wmes + 12;
   wano = :wano - 1;
  end
 end
else begin
 while (:wmes > 12) do begin
  wmes = :wmes - 12;
  wano = :wano + 1;
 end
end

select r_IntZero from IntZero(:wmes, 2) into r_Inc_Dec_peri;
r_Inc_Dec_Peri = :r_inc_dec_peri || '/' || cast(:wano as varchar(4));

Em conjunto com esta

CREATE PROCEDURE INTZERO(
    WINT BIGINT,
    WTAM INTEGER)
RETURNS (
    R_INTZERO VARCHAR(36))
AS
begin
if (:wint is null) then
 select r_replicate from replicate(:wtam, ' ') into r_IntZero;
else
 select r_Sright from S_Right('000000000000000000' || cast(:wint as
varchar(18)), :wtam) into :r_intzero;

suspend;
end

e com + esta

CREATE PROCEDURE REPLICATE(
    WQTD INTEGER,
    WVAR VARCHAR(255))
RETURNS (
    R_REPLICATE VARCHAR(255))
AS
begin
r_replicate = '';

while (:wqtd > 0) do begin
 r_replicate = r_replicate || :wvar;
 wqtd = :wqtd - 1;
end

suspend;
end

e + esta

CREATE PROCEDURE S_RIGHT(
    WVAR VARCHAR(255),
    WQTD INTEGER)
RETURNS (
    R_SRIGHT VARCHAR(255))
AS
DECLARE VARIABLE K INTEGER;
begin
if (:wvar is not null) then begin
 select r_Len from Len(:wvar) into :k;

 if (:wqtd >= :k) then
  r_sright = :wvar;
 else
  select r_Copy from Copy(:wvar, ((:k - :wqtd) + 1), :wqtd) into :r_sright;
end

suspend;
end

e + esta

CREATE PROCEDURE LEN(
    WSTR VARCHAR(2048))
RETURNS (
    R_LEN SMALLINT)
AS
DECLARE VARIABLE L varchar(10);
begin
if (:wstr = 'MithBuster') then
 r_Len = 10;
else begin
 wstr = :wstr || 'MithBuster';
 r_Len = 0;
 l = substring(:wstr from 1 for 10);

 while (:l <> 'MithBuster') do begin
  r_Len = :r_Len + 1;
  wstr = substring(:wstr from 2 for 1023);
  l = substring(:wstr from 1 for 10);
 end
end

suspend;
end

e + esta

CREATE PROCEDURE COPY(
    WVAR VARCHAR(1024),
    WINI INTEGER,
    WTAM INTEGER)
RETURNS (
    R_COPY VARCHAR(1024))
AS
DECLARE VARIABLE I INTEGER;
DECLARE VARIABLE J INTEGER;
DECLARE VARIABLE K INTEGER;
begin
select r_Len from Len(:wvar) into :i;
j = 1;
k = 1;
r_copy = '';

while ((:wvar is not null) and (:i > 0) and (j <= :wtam)) do begin
 if (:k >= :wini) then begin
  r_copy = :r_copy || substring(:wvar from 1 for 1);
  j = j + 1;
 end

 wvar = substring(:wvar from 2 for 1023);
 k = :k + 1;
 i = :i - 1;
end

suspend;
end

Luciano C Santos