Invocación de Servicios C desde RPG.. 1

Introducción. 1

Invocación de parámetros enteros. 2

Invocación de parámetros flotantes. 6

Invocación de series numéricas. 12

 

                                                                                        

 ________



Invocación de Servicios C desde RPG

 

Introducción

 

En este documento haremos un resumen del formato de los parámetros que se utilizan en la presentación actual al invocar servicios C desde programas o servicios RPG y presentaremos algunos ejemplos guía.


En este resumen, distinguiremos entre parámetros numéricos, alfanuméricos y el paso de estructuras.

- Para los parámetros numéricos nativos de C, contemplaremos los enteros y los flotantes:

La invocación de cualquier parámetro entero se hará utilizando definiciones 10I 0

La invocación de cualquier parámetro flotante se hará utilizando definiciones 8F

La invocación de series numéricas se efectuará pasando su dirección


- Para los parámetros alfanuméricos se pasará su dirección; se especificará la opción OPTIONS(*STRING) en el prototipo
  en caso de utilizarse de entrada. Con ello, desde el RPG se puede invocar el procedimiento pasando como parámetro un campo
  alfanumérico o un literal, ya que el sistema proporcionará un puntero temporal donde copiará el valor del parámetro.

  Prácticamente todos los servicios de SRAGM, que se presenta en el resto de capítulos, hacen uso de esta funcionalidad.

 

- El paso de estructuras se realizará mediante su dirección.
 
  De nuevo, prácticamente todos los servicios de SRAGM, que se presenta en el resto de capítulos, hacen uso de esta
  funcionalidad.

 

El resto del capítulo se dedicará a presentar ejemplos de uso de parámetros numéricos enteros, flotantes y series numéricas.

 

 

                                                                                        

 ________

 

Invocación de parámetros enteros

 

Veamos un ejemplo de invocación a un generador aleatorio de números enteros. Es un interfaz de la rutina estándar de C rand():

El Prototipo en C es:


//-----------------------------------------------------------------
// FUNCION....: SRRCG_RAND
// DESCRIPCION: Genera nºs aleatorios, para uso en RPG            
// PARAMETROS.: Rango (En formato 1..N)                           
//              Semilla. Se restablece secuencia si no es nula    
// RETORNO....: NºAleatorio generado en el rango indicado         
//-----------------------------------------------------------------
int SRRCG_RAND(int iRango_p, int iSemilla_p)                      

 

El prototipo en RPG es:


* Números aleatorios (Rand)
DSRRCG_RAND       PR            10I 0                                      Numero Rand         
D P_Rango                       10I 0 VALUE                                Rango (1..Rango)  *I
D P_Semilla                     10I 0 VALUE                                Semilla opcional  *I

 

Un ejemplo de uso es:

 

 

/FREE                               
                                    

   // Genera nºaleatorio            

   XXRAND = SRRCG_RAND(9999:*ZEROS);

                                    

/END-FREE                           

 

Y una muestra de uso es:

 

 

 

 

El código completo es:

 

//-----------------------------------------------------------------          

// FUNCION....: SRRCG_RAND                                                   

// DESCRIPCION: Genera nºs aleatorios, para uso en RPG                        

// PARAMETROS.: Rango (En formato 1..N)                                      

//              Semilla. Se restablece secuencia si no es nula               

// RETORNO....: NºAleatorio generado en el rango indicado                    

//-----------------------------------------------------------------          

int SRRCG_RAND(int iRango_p, int iSemilla_p)                                 

{                                                                            

 int iRand = 0; // Random a calcular en el rango indicado, formato 1.N       

                                                                             

 // Filtro. Sin rango, devuelve rand standar                                 

 if (!iRango_p) return rand();                                                

                                                                             

                                                                             

 // Aplica semilla si se solicita,                                            

 // como en C srand debe ser > 1, se suma 1 para prevenir justo el 1 del RPG 

 if (iSemilla_p > 0) srand(iSemilla_p + 1);
                                          

                                          

 // Random en el rango solicitado         

 iRand = rand() * iRango_p / RAND_MAX + 1;

                                          

 return iRand;                            

}                                       

 

 

H DFTNAME(MDRAND00)                                                   

H DECEDIT('0,') DATEDIT(*DMY.) FIXNBR(*ZONED:*INPUTPACKED)           

H OPTION(*SRCSTMT:*NODEBUGIO) EXPROPTS(*RESDECPOS)                   

H INDENT('|')                                                        

 *****************************************************************   

 *            *                                                      

 *  MDRAND00  *   GENERADOR DE NºS ALEATORIOS. Interfaz SRRCG_Rand   

 *            *                                                      

 *****************************************************************   

                                                                     

 ***                                                                 

 * *  DEFINICION DE ESTRUCTURA DE ESTADO                              

 ***                                                                 

D PROGSTATUS     SDS                                                 

D  P1STAT                 1    429                                   

                                                                      

                                                                     

 *-------------------------------------------------------------------*

 * DECLARACION DE PROTOTIPOS EXTERNOS                                *

D/COPY QCOPYSRC,PSRAGG                                            

D/COPY QCOPYSRC,PSRRCG                                            

                                                                  

                                                                   

 ***                                                              

 * *  PARAMETROS DE ENTRADA                                       

 ***                                                              

C     *ENTRY        PLIST                                         

C                   PARM                    XXRAND            4 0 

                                                                  

                                                                  

 /FREE                                                             

                                                                  

                                                                  

    // Genera nºaleatorio                                          

                                                                  

    XXRAND = SRRCG_RAND(9999:*ZEROS);                            

                                                      

                                                      

 /END-FREE                                            

                                                      

                                                      

 ***                                                  

 * *  FIN DE PROGRAMA                                  

 ***                                                  

C     ETFIN         TAG                               

C                   RETURN                            

 *                                                    

 *                                                                                                                          
 *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS            

 *        SSSSSS                        SSSSSS         

 *             MONITORIZACION DE ERRORES               

 *        SSSSSS                        SSSSSS         

 *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS            

 *                                                     

C     *PSSR         BEGSR                               

 *                                                     

C                   CALLP     SRAGG_AnotPSSR(P1STAT)   

C                   MOVE      *ON           *INLR      

C                   RETURN                             

 *                                                      

C     ENPSSR        ENDSR     '*CANCL'                                                   

 

      

                                                                                 

 ________

 

Invocación de parámetros flotantes

 

Veamos un ejemplo de invocación a un calculador de probabilidad P(N<X):

El Prototipo en C es:


//------------------------------------------------------------------------------

//                                                                              

// FUNCION....: SRRCS_PNM                                                      

//                                                                             

// DESCRIPCION: Probabilidad Distribución Normal(0,1): P(N<X)                  

//                                                                             

// Parámetros:                                                                 

//       (E) : ABSCISA -X- SOLICITADA                                           

//                                                                             

// Retorno   : PROBABILIDAD DISTRIBUCIÓN NORMAL(0,1): P(N<X)                   

//                                                                              

//                                                                             

//   DISTRIBUCION NORMAL.                                                      

//                                                                             

//                  1            PTO |  -T^2/2                                 

//       Q(X) = ------------  INTEGR.| E       DT                              

//              (2 * PI)^1/2    -INF |                                         

//                                                                              

//                                                                             

//       Es                                                                    
//                                                                              

//       Q(x) = [1 + erf(x/sqrt(2)]/2 = erfc(-x/sqrt(2))/2                     

//                                                                             

//       Donde                                                                  

//                                                                             

//       erf es la función de error y erfc su complementaria                   

//                                                                              

//        (Definidas en <math.h>)                                              

//                                                                             

//------------------------------------------------------------------------------

double SRRCS_PNM(double x)                                                     

 

El prototipo en RPG es:


 
*--------------------------------------------------------------------*                        

 * SRRCS_PNM : PROBABILIDAD DISTRIBUCIÓN NORMAL(0,1): P(N<X)          *                        

 * Parámetros:                                                        *                        

 *       (E) : ABSCISA -X- SOLICITADA                                 *                        

 * Retorno   : PROBABILIDAD DISTRIBUCIÓN NORMAL(0,1): P(N<X)          *                        

 *--------------------------------------------------------------------*                        

DSRRCS_PNM        PR             8F                                        P(N<X)            *O

D P_X                            8F   VALUE                                ABSCISA -X-       *I

 

Un ejemplo de uso es:

 

/FREE  

                                    

   // Invocación X --> P                    

                                          

   XXP = %dech(SRRCS_PNM(%float(XXX)):10:9);

                                    

/END-FREE                           

 

Y una muestra de uso es:

 

 

 

El código completo es:

 

//------------------------------------------------------------------------------

//                                                                             

// FUNCION....: SRRCS_PNM                                                      

//                                                                              

// DESCRIPCION: Probabilidad Distribución Normal(0,1): P(N<X)                  

//                                                                             

// Parámetros:                                                                  

//       (E) : ABSCISA -X- SOLICITADA                                          

//                                                                             

// Retorno   : PROBABILIDAD DISTRIBUCIÓN NORMAL(0,1): P(N<X)                   

//                                                                             

//                                                                             

//   DISTRIBUCION NORMAL.                                                       

//                                                                             

//                  1            PTO |  -T^2/2                                 

//       Q(X) = ------------  INTEGR.| E       DT                               

//              (2 * PI)^1/2    -INF |                                         

//                                                                             

//                                                                              

//       Es                                                                    
//                                                                             

//       Q(x) = [1 + erf(x/sqrt(2)]/2 = erfc(-x/sqrt(2))/2                     

//                                                                              

//       Donde                                                                 

//                                                                             

//       erf es la función de error y erfc su complementaria                   

//                                                                             

//        (Definidas en <math.h>)                                              

//                                                                              

//------------------------------------------------------------------------------

double SRRCS_PNM(double x)             

{                                              

 double y = 0.0; // Valor de retorno           

                                               

 // Filtro valores extremos significativos     

 if (x >  6.25) return 1.0;                    

 if (x < -6.25) return 0.0;                    

                                                

 // Formulación                                

 y = erfc(-x/R2) / 2.0;                        

 return y;                                     

}         

H DFTNAME(MDRAND00)                                                    

H DECEDIT('0,') DATEDIT(*DMY.) FIXNBR(*ZONED:*INPUTPACKED)             

H OPTION(*SRCSTMT:*NODEBUGIO) EXPROPTS(*RESDECPOS)                     

H INDENT('|')                                                          

 *****************************************************************     

 *            *                                                        

 *  MDRAND00  *   GENERADOR DE NºS ALEATORIOS. Interfaz SRRCG_Rand     

 *            *                                                        

 *****************************************************************     

                                                                       

 ***                                                                   

 * *  DEFINICION DE ESTRUCTURA DE ESTADO                                

 ***                                                                   

D PROGSTATUS     SDS                                                   

D  P1STAT                 1    429                                     

                                                                        

                                                                       

 *-------------------------------------------------------------------* 

 * DECLARACION DE PROTOTIPOS EXTERNOS                                *
*-------------------------------------------------------------------*

D/COPY QCOPYSRC,PSRAGG                                               

D/COPY QCOPYSRC,PSRRCG                                               

                                                                      

                                                                     

 ***                                                                 

 * *  PARAMETROS DE ENTRADA                                          

 ***                                                                 

C     *ENTRY        PLIST                                            

C                   PARM                    XXRAND            4 0    
                                                                 

                                                                

/FREE                                                           

                                                                

                                                                 

   // Genera nºaleatorio                                        

                                                                

   XXRAND = SRRCG_RAND(9999:*ZEROS);                   
        

                                                                 

  /END-FREE                                             

                                                       

                                                       

 ***                                                    

 * *  FIN DE PROGRAMA                                  

 ***                                                   

C     ETFIN         TAG                                

C                   RETURN                             

 *                                                      

 *                                                     

 *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS            

 *        SSSSSS                        SSSSSS         

 *             MONITORIZACION DE ERRORES                

 *        SSSSSS                        SSSSSS         

 *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS            

 *                                                     

C     *PSSR         BEGSR                              

 *                                                      

C                   CALLP     SRAGG_AnotPSSR(P1STAT)   

C                   MOVE      *ON           *INLR                                                                      
C                   RETURN                      

 *                                             

C     ENPSSR        ENDSR     '*CANCL'                                               

      

                                                                                 

 ________

 

Invocación de series numéricas

 

Veamos un ejemplo de invocación a un generador de series de números aleatorios sin repetición:

El Prototipo en C es:


//------------------------------------------------------------------------------

//                                                                              

// FUNCION....: SRRCS_RANDN                                                     

//                                                                               

// DESCRIPCION: Obtiene una serie de números aleatorios, sin repetición         

//              Invoca a SRRCG_RAND para obtener los ítems y a SRRCW para         

//              garantizar la unicidad. Formalmente, ordena por insercción.     

//                                                                              

// PARAMETROS.:                                                                 

//        (E) : iNumItems_p: Numero de elementos de la serie.                   

//        (E) : iRango_p   : Rango (En formato 1..N). Debe superar a iNumItems_p

//        (E) : iOrdenar_p : 0/1 Devolver la serie ordenada de menor a mayor    

//        (E) : iSemilla_p : Se restablece secuencia si no es nula              

//        (S) : S          : Serie de elementos obtenidos                       

// RETORNO....: 0 ok, <>0 Error                                                 

//------------------------------------------------------------------------------

short int SRRCS_RANDN(int iNumItems_p, int iRango_p, short int iOrdenar_p,      

                      int iSemilla_p,  int *S)                                  

 

El prototipo en RPG es:


                         

* Obtiene una serie de números aleatorios, sin repetición                                     

DSRRCS_RANDN      PR            10I 0                                      0/1 Error         *O

D P_NumItems                    10I 0 VALUE                                NºItems pedidos   *I

D P_Rango                       10I 0 VALUE                                Rango ítems       *I

D P_Orden                       10I 0 VALUE                                0/1 Devolver ord. *I

D P_Semilla                     10I 0 VALUE                                Semilla generación*I

D P_pSd                           *   VALUE                                Serie resultado(O)*I

 

 

Un ejemplo de uso es:


* Paso de resultados desde SRRCG_RANDN
D S               S             10I 0 DIM(6)                               Serie extraída
 

/FREE  

                                    

   // Proceso núcleo: Genera 6 nºs aleatorios sin repetición en el rango (1,49)

                                                                             

   T_ERRO = SRRCS_RANDN(6:49:1:T_NSEM:%addr(S));                               

                                    

/END-FREE                           

 

Y una muestra de uso es:

 

 

El código completo es:

 

 

             CMD        PROMPT('Visualz.RND: LOTO')

 

 

/*********************************************************************/

/*          *                                                        */

/* MDCLDR49 * CL DE PROCESO DEL MANDATO DR49: VISUALIZAR 6 NUM:1..49 */

/*          *                                                        */

/*********************************************************************/

             PGM                                                       

                                                                        

                                                                       

/* --- DECLARACION DE VARIABLES */                                     

                                                                       

             DCL        VAR(&TTSNUM) TYPE(*CHAR) LEN(17) /* Serie de + 

                          números resultante, obtenida en MDDR4901 */  

                                                                       

                                                                        

/* --- VARIABLES PARA RUTINA DE CONTROL DE ERROR (ETDSPMSGER)        */

             DCL        VAR(&TTMSID) TYPE(*CHAR) LEN(07) /* -------- + 

                         Identificacion de Mensaje recibido en la    + 

                         rutina de verificacion                      */

             DCL        VAR(&TTMSG) TYPE(*CHAR) LEN(80) /* ------- + 

                          Texto parcial de Mensaje */                 

             DCL        VAR(&TTMSGT) TYPE(*CHAR) LEN(256) /* ------- +

                          Texto completo del mensaje */               

             DCL        VAR(&TTMSDT) TYPE(*CHAR) LEN(132) /* ------- +

                         Texto de Mensaje recibido en la rutina de   +

                         verificacion                                */

             DCL        VAR(&TTMSGF) TYPE(*CHAR) LEN(10) /* -------- +

                          Fichero de mensajes */                      

             DCL        VAR(&TTMSGL) TYPE(*CHAR) LEN(10) /* -------- +

                          Libreria de Fichero de mensajes */          
             DCL        VAR(&TTMENS) TYPE(*CHAR) LEN(80) /* -------- +

                          Para envio de mensajes de estado CPF9898   */

                                                                       

                                                                      

/*********************************************************************/

/* --- MONITORIZACION GENERAL: DIRECCIONAMIENTO A RUTINA DE MENSAJES */

/*********************************************************************/

             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ETDSPMSGER))  

             RMVMSG     CLEAR(*ALL)                                   

                                                                       
                                                                       

                                                                       

/* *************************************************************** */  

/* NÚCLEO DE PROCESO Y MENSAJE DE SALIDA                           */  

/* *************************************************************** */  

             CALL       PGM(MDDR4901) PARM(&TTSNUM)                    

             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&TTSNUM) + 

                          MSGTYPE(*INFO)                               

                                                                       

             GOTO       CMDLBL(ETFIN)                                  

                                                                        

                                                                       

/*********************************************************************/

/* --- RUTINA DE RECEPCION Y PRESENTACION DE MENSAJES DE ERROR       */

/*********************************************************************/

                                                                       

/* RECIBE MENSAJE DE ERROR */                                          

 ETDSPMSGER:                                                           

             RCVMSG     MSG(&TTMSGT) MSGDTA(&TTMSDT) MSGID(&TTMSID) +  
                           MSGF(&TTMSGF) MSGFLIB(&TTMSGL)             

                                                                       

                                                                      

 /* PRESENTA IDENTIFICADOR Y MENSAJE SI ESTAN CARGADOS */             

              IF         COND((&TTMSGT *NE ' ') *OR (&TTMSID *NE ' +  

                           ')) THEN(DO)                               

                                                                      

              IF         COND(&TTMSID *NE ' ') THEN(DO)               

 /* PRESENTA IDENTIFICADOR DE MENSAJE */                               

              CHGVAR     VAR(&TTMENS) VALUE(&TTMSID)                  

              DSPM       MSG(&TTMENS)                                 

              SNDPGMMSG  MSG(&TTMSID) MSGTYPE(*DIAG)                  

                                                                       

 /* PRESENTA TEXTO DE MENSAJE */                                      

              CHGVAR     VAR(&TTMENS) VALUE(&TTMSGT)                  

              DSPM       MSG(&TTMENS)                                  

              SNDPGMMSG  MSGID(&TTMSID) MSGF(&TTMSGL/&TTMSGF) +       

                           MSGDTA(&TTMSDT) MSGTYPE(*INFO)             

                                                                      
/* VUELVE A BUCLE DE RECEPCION TRAS PRESENTAR MSG.CON ID.*/          

             GOTO       CMDLBL(ETDSPMSGER)                           

             ENDDO                                                   

                                                                     

                                                                     

/* PRESENTA TEXTO DE MENSAJE SIN ID.*/                               

             CHGVAR     VAR(&TTMENS) VALUE(&TTMSGT)                  

             DSPM       MSG(&TTMENS)                                  

             SNDPGMMSG  MSG(&TTMSGT) MSGTYPE(*DIAG)                  

                                                                     

/* VUELVE A BUCLE DE RECEPCION TRAS PRESENTAR ID. Y/O MSG.*/         

             GOTO       CMDLBL(ETDSPMSGER)                           

             ENDDO                                                   

                                                                     

                                                                      

             DSPC       /* BORRA DSPM */                             

                                                                     

                                                                     

/* PRESENTA MENSAJE FINAL DE ERROR */                                

             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('DR49.- +
                           Error o errores durante la ejecucion del +   

                           mandato. Ver mensajes de nivel inferior') +  

                           MSGTYPE(*ESCAPE)                             

                                                                        

                                                                        

 /*********************************************************************/

 /* --- FIN DE PROGRAMA                                               */

 /*********************************************************************/

                                                                         

  ETFIN:                                                                
             ENDPGM 

        

H DFTNAME(MDDR4901)                                                     

H DECEDIT('0,') DATEDIT(*DMY.) FIXNBR(*ZONED:*INPUTPACKED)               

H OPTION(*SRCSTMT:*NODEBUGIO) EXPROPTS(*RESDECPOS)                      

H INDENT('|')                                                           

 *****************************************************************      

 *            *                                                          

 *  MDDR4901  *   Extrae 6 NºS ALEATORIOS U(1,49)                       

 *            *                                                         

 *****************************************************************      

                                                                        

 ***                                                                    

 * *  DEFINICION DE ESTRUCTURA DE ESTADO                                

 ***                                                                     

D PROGSTATUS     SDS                                                    

D  P1STAT                 1    429                                      

                                                                         

                                                                        

 *-------------------------------------------------------------------*  

 * DECLARACION DE PROTOTIPOS INTERNOS                                *  
*-------------------------------------------------------------------*                         

                                                                                               

 * Núcleo de proceso                                                                            

DPrProc           PR            17                                         S.Randoms generados 

                                                                                               

                                                                                                

 *-------------------------------------------------------------------*                         

 * DECLARACION DE PROTOTIPOS INTERNOS PARA PROCEDIMIENTOS EXTERNOS   *                         

 *-------------------------------------------------------------------*                         

                                                                                               

 * MQ5630                                                                                       

DMQ5630           PR                  EXTPGM('MQ5630')                                         

D P_NSEC                        30  0                                      NºSECUENCIA       *O

                                                                                                

                                                                                               

 *-------------------------------------------------------------------*                          

 * DECLARACION DE PROTOTIPOS EXTERNOS                                *                         

 *-------------------------------------------------------------------*                         

D/COPY QCOPYSRC,PSRAGG                                                                          

D/COPY QCOPYSRC,PSRRCS                                                                         
                                                                                              

 ***                                                                                           

 * *  PARAMETROS DE ENTRADA                                                                   

 ***                                                                                           

C     *ENTRY        PLIST                                                                     

C                   PARM                    XXSNUM           17            Num.generados 1..6*O

                                                                                               

                                                                                              

 /FREE                                                                                        

                                                                                               

                                                                                              

   // Proceso núcleo                                                                           

                                                                                              

   XXSNUM = PrProc();                                                                         

                                                                                               

                                                                                              

 /END-FREE                                                                                    

                                                                                               

 ***                                                                                          

 * *  FIN DE PROGRAMA                                                                          
***                                                                 

C     ETFIN         TAG                                              

C                   RETURN                                           

 *                                                                    

 *                                                                   

 *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS                          

 *        SSSSSS                        SSSSSS                       

 *             MONITORIZACION DE ERRORES                             

 *        SSSSSS                        SSSSSS                       

 *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS                          

 *                                                                    

C     *PSSR         BEGSR                                            

 *                                                                   

C                   CALLP     SRAGG_AnotPSSR(P1STAT)                 

C                   RETURN                                           

 *                                                                   

C     ENPSSR        ENDSR     '*CANCL'                               

                                                                      

                                                                     

 *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP                          
*       PPPPPP                        PPPPPP                                              

 *         IMPLEMENTACION DE PROCEDIMIENTOS.                                               

 *       PPPPPP       INTERNOS         PPPPPP                                              

 *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP                                                 

 *                                                                                         

 *                                                                                         

 *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP                                                 

 *        PPPPPP                        PPPPPP                                             

 * PrProc: Núcleo de proceso                                                               

 *        PPPPPP                        PPPPPP                                             

 *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP                                                

 *                                                                                         

PPrProc           B                                                                         

 *                                                                                         

DPrProc           PI            17                                         Núcleo de proceso

                                                                                           

 ***                                                                                       

 * *  CAMPOS DE TRABAJO E INDICADORES                                                       

 ***                                                                                       

 *                                                                                         
* Valor de retorno                                                                             

D T_SN            S             17                                         Paso resultado      

 *                                                                                             

 * Paso de resultados desde SRRCG_RANDN                                                        

D T_I             S             10I 0                                                          

D T_ALFA          S              5                                         S.PARCIAL NºALEATOR 

D T_NUME          S              5S 0                                      S.PARCIAL NºALEATOR 

D SN              S              3    DIM(6)                               S.PARCIAL NºALEATOR 

 *                                                                                              

 * MQ5630                                                                                      

D T_STAM          S             30  0                                      NºSECUENCIA       *O

D T_NSEC          S             30S 0                                      NºALEATORIO       *O

 *                                                                                             

 * SRRCG_RANDN                                                                                  

D T_ERRO          S             10I 0                                      0/1 Error           

D T_NSEM          S             10I 0                                      NºSEMILLA SRAND     

D S               S             10I 0 DIM(6)                               Serie extraída      

                                                                                               

                                                                                                

 /FREE                                                                                         

                                                                                               
                                                                                 

                                                                                

    // NºSecuencia basado en STAMP extendido: AAAAMMDDhhmmsslllJJJJJJNNNNNNN (Puede sustituirse por un contador simple)                                     

                                                                                

    MQ5630(T_STAM);                                                             

    T_NSEC = T_STAM;                                                            

                                                                                

                                                                                

    // Pasa nºsecuencia a formato INT                                           

                                                                                 

    T_NSEM = %rem(T_NSEC:32767) + 1;                                            

                                                                                

                                                                                 

    // Proceso núcleo: Genera 6 nºs aleatorios sin repetición en el rango (1,49)

                                                                                

    T_ERRO = SRRCS_RANDN(6:49:1:T_NSEM:%addr(S));                               

                                                                                

                                                                                

    // Pasa resultados                                                           

                                                                                

                                                                                 

   for T_I = 1 to 6;                                                              

                                                                                 

      T_NUME  = S(T_I);                                                          

      T_ALFA  = %editc(T_NUME:'3');                                               

      SN(T_I) = %subst(T_ALFA:4:2);                                              

                                                                                 

   endfor;                                                                        

                                                                                 

                                                                                 

   // Valor de retorno                                                            

                                                                                 

   T_SN = SN(1)+SN(2)+SN(3)+SN(4)+SN(5)+%subst(SN(6):1:2);                       

   return T_SN;                                                                   

                                                                                 

                                                                                 

/END-FREE                                                                        

                                                                                  

                                                                                 

***                                                                              
* *  MONITORIZACION DE ERRORES                          

 ***                                                     

C     *PSSR         BEGSR                                

C                   CALLP     SRAGG_AnotPSSR(P1STAT)     

C                   RETURN    *ZEROS                     

C     ENPSSR        ENDSR                                

                                                         

PPrProc           E                                                                                                                              
 

      

                                                                                 

 ________

 

 

iSeries ficheros virtuales