[Gallosuarez]

America111:

Bueno pues aquí tenemos el primer esbozo . Se debe de considerar como eso, es decir, una versión de prueba que no está lista para entrar a producción. Falta muchas protecciones, además de agregarle el código para la homoclave y el dígito verificador.

Lo programé en la versión 2.5, sin embargo creo que funcionaría desde la 2.1 (falta confirmar). Utilicé dominios en la declaración de variables (enorme ventaja de conservar consistencia en el tipo de datos entre tablas y procedimientos almacenados). No utilicé ningún UDF (ventaja que se traduce al utilizar diferentes plataformas: Linux, Mac, UNIX, Windows, etc). Planeo, para después, agregar una tabla de Personal donde utilizaré los dominios antes mencionados, además de un campo calculado para el nombre completo que estaría indexado para hacer búsquedas rapidísimas que no sean sensibles a mayúscula o a los acentos (tal y como sucede en el cálculo del RFC).
Se usa de la siguiente manera:

Código SQL [-]
SELECT RFC
FROM CALC_RFC('Del Real', 'Anzures', 'José Antonio', '04/14/1972')

ó

SELECT RFC
FROM CALC_RFC('DEL REAL', 'ANZURES', 'JOSÉ ANTONIO', '04/14/1972')

etc, etc

Código:

Código SQL [-]
/******************** DOMINIOS *********************/
CREATE DOMAIN DOM_AMATERNO
 AS Varchar(27)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_APATERNO
 AS Varchar(27)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_NOMBRECMPLTO
 AS Varchar(93)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_NOMBRES
 AS Varchar(37)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_RFC
 AS Varchar(13)
 COLLATE ES_ES_CI_AI;

/********** PROCEDIMIENTO VOCAL_MAYUSCULA ***********/
SET TERM ^ ;
CREATE PROCEDURE VOCAL_MAYUSCULA (
    C Char(1) COLLATE ES_ES_CI_AI)
RETURNS (
    VOCAL Char(1) )
AS
BEGIN
  VOCAL = C;
  IF (C IN ('Á')) THEN VOCAL = 'A';
  IF (C IN ('É')) THEN VOCAL = 'E';
  IF (C IN ('Í')) THEN VOCAL = 'I';
  IF (C IN ('Ó')) THEN VOCAL = 'O';
  IF (C IN ('Ú')) THEN VOCAL = 'U';
END^
SET TERM ; ^

/********** PROCEDIMIENTO CALC_RFC ***********/
SET TERM ^ ;
CREATE PROCEDURE CALC_RFC (
    APATERNO_PARAM DOM_APATERNO,
    AMATERNO_PARAM DOM_AMATERNO,
    NOMBRES_PARAM DOM_NOMBRES,
    F_NACIMIENTO Date )
RETURNS (
    RFC DOM_RFC )
AS
DECLARE dd CHAR(2); /* día de nacimiento */
DECLARE mm CHAR(2); /* mes de nacimiento */
DECLARE aa CHAR(2); /* año de nacimiento */
DECLARE APaterno DOM_APATERNO = '';
DECLARE AMaterno DOM_APATERNO = '';
DECLARE Nombres DOM_NOMBRES = '';
DECLARE Nombre1 DOM_NOMBRES = '';
DECLARE APaterno1 DOM_APATERNO = '';
DECLARE NombreCmplto DOM_NOMBRECMPLTO = '';
DECLARE PosEspacio INTEGER = 0; 
DECLARE PrimeraVocal CHAR(1) = ''; /* primera vocal interna */
DECLARE Cadena VARCHAR(24) = '';
DECLARE i INTEGER = 1;
DECLARE LongCadena INTEGER = 0; /* longitud de cadena */
BEGIN
  dd = LPAD(CAST(EXTRACT(DAY FROM F_NACIMIENTO) AS VARCHAR(2)), 2, '0');
  mm = LPAD(CAST(EXTRACT(MONTH FROM F_NACIMIENTO) AS VARCHAR(2)), 2, '0');
  aa = RIGHT(CAST(EXTRACT(YEAR FROM F_NACIMIENTO) AS VARCHAR(4)), 2);
  
  APaterno = TRIM(APATERNO_PARAM);
  AMaterno = TRIM(AMATERNO_PARAM);
  Nombres = TRIM(NOMBRES_PARAM);
  
  /* Bucle para procesar nombre(s) */
  WHILE (1 = 1) DO
  BEGIN
    PosEspacio = IIF(POSITION(' ', Nombres) = 0, 1, POSITION(' ', Nombres));
    Nombre1 = SUBSTRING(Nombres FROM 1 FOR PosEspacio - 1);
    IF (Nombre1 NOT IN ('JOSE','MARIA','MA.','MA','DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN')
      OR (PosEspacio - 1) = 0) THEN LEAVE;
    Nombres = SUBSTRING(Nombres FROM PosEspacio + 1);
  END
  
  /* Bucle para procesar apellido(s) paterno */
  WHILE (1 = 1) DO
  BEGIN
    PosEspacio = IIF(POSITION(' ', APaterno) = 0, 1, POSITION(' ', APaterno));
    APaterno1 = SUBSTRING(APaterno FROM 1 FOR PosEspacio - 1);
    IF (APaterno1 NOT IN ('DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN')
      OR (PosEspacio - 1) = 0) THEN LEAVE;
    APaterno = SUBSTRING(APaterno FROM PosEspacio + 1);
  END
    
  /* Bucle para buscar primera vocal interna en el apellido paterno */
  Cadena = SUBSTRING(APaterno FROM 2);
  LongCadena = CHAR_LENGTH(Cadena);
  i = 1;
  WHILE (i < LongCadena) DO
  BEGIN
    EXECUTE PROCEDURE VOCAL_MAYUSCULA(SUBSTRING(Cadena FROM 1 FOR 1))
    RETURNING_VALUES PrimeraVocal;
    IF (PrimeraVocal IN ('A', 'E', 'I', 'O', 'U')) THEN LEAVE;
    Cadena = SUBSTRING(Cadena FROM 2);
    i = i + 1;
  END
  
  /* Concatena todo los resultados */
  RFC = UPPER(LEFT(APaterno, 1) || PrimeraVocal || COALESCE(LEFT(AMaterno, 1), 'X') ||
    LEFT(Nombres, 1));
  
  /* Elimina palabras "feas" */
  IF (RFC IN ('BUEI','BUEY','CACA','CACO','CAGA','CAGO','CAKA','CAKO','COGE','COJA',
    'COJE','COJI','COJO','CULO','FETO','GUEY','JOTO','KACA','KACO','KAGA',
    'KAGO','KAKA','KOGE','KOJO','KULO','MAME','MAMO','MEAR','MEAS','MEON',
    'MION','MOCO','MULA','PEDA','PEDO','PENE','PUTA','PUTO','QULO','RUIN','RATA')) THEN
    RFC = SUBSTRING(RFC FROM 1 FOR 3) || 'X';
      
  /* Concatena fecha de nacimiento */  
  RFC = RFC || aa || mm || dd;
  SUSPEND;
END^
SET TERM ; ^

Saludos,
Gerardo Suárez Trejo