RPG

 

Ficheros virtuales

 

 

 

El banco de pruebas verifica la actualización de registros con la función SRAGMV_UPDATE que consiste en dos bucles de llamadas a SRAGM_UPDATE.

 

En la primera se cambian los registros pares del formato 100000 + IJ a IJ, y en la segunda se restablecen a su valor original, todo ello seguido de un ciclo de verificación que accede a los datos con SRAGM_CHAIN la rutina de acceso por clave.

 

Hay que destacar que ambas rutinas se aplican sobre la vía de acceso lógica, pero el interfaz de presentación hace uso de la vía de acceso principal.

 

 

Un extracto del detalle del código fuente sigue a continuación:

 

 

 

      *
      *
      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP
      * PPPPPP                        PPPPPP
      * SRAGMV_Update: Rutina para pruebas de SRAGM_UPDATE
      * PPPPPP                        PPPPPP
      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP
      *
      * ACTUALIZA ITEMS
      * Opción por defecto: Formato conjunto (Formato_0 & Formato_1)
      * Formato 0:                                      Formato 1:
      * 1) LOS ELEMENTOS PARES EN FORMATO IJ: IJ        3) LOS ELEMENTOS PARES EN FORMATO IJ: 100000 + IJ
      * 2) VERIFICA                                     4) VERIFICA
      *
     PSRAGMV_UPDATE    B                   EXPORT
      *
     DSRAGMV_UPDATE    PI              N                                        0/1 Error         *O
     D P_LF                          33    VALUE                                NombrFileLFactual1*I
     D P_NUME                         6  0 VALUE                                NºElementosPrueba2*I
     D P_Bloq                         6  0 VALUE                                NºEl.bloque DSPLY3*I
     D P_OnErr                        1    VALUE                                0=Iter1=Leav2=Fin4*I
     D P_DspSts                       1    VALUE                                0/1 emitir dspd  5*I
     D P_Formato                      1    VALUE OPTIONS(*NOPASS)               0:1+2 1:3+4 /*ALL6*I
 
      ***
      * * DEFINICION DE CAMPOS E INDICADORES
      ***
      *
      * Paso de parámetros opcionales
     D T_Parm          S             10I 0
      *
      * SRAGM
     D T_I             S              6  0
     D T_J             S              6  0
     D T_K             S              6  0
     D T_IJ            S              6  0
     D T_JI            S              6  0
     D T_Erro          S             10I 0
     D T_MENS          S             80
     D T_Resu          S             10I 0
 
      * Instancia de DS8888c para soporte de DS8888 virtual
     DDS8888           DS                  LIKEDS(DS8888c) INZ

 

 

 

Insertamos ahora la definición de DS8888 para tenerla a mano:

 

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

      *  DS8888   *  Banco de pruebas de SRAGM

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

 

      ***

      * *  Definición fichero virtual DS8888

      ***

     D DS8888c         DS                  QUALIFIED BASED(pDS8888c)            Soporte  DS8888

     D  DSK                                LIKEDS(DSCc)                         ClavesPF DS8888

     D  DSK01                              LIKEDS(DSC01c)                       ClavesLF DS8888

     D  DSD                                LIKEDS(DSDc)                         Datos    DS8888

 

      ***

      * *  Definición claves PF (Es la definición de una red [I,J], como en la emulación de una hoja de cálculo)

      ***

     D DSCc            DS                  QUALIFIED BASED(pDSCc)

     D  I                            10S 0                                      I

     D  J                            10S 0                                      J

 

      ***

      * *  Definición claves LF (Orden inverso)

      ***

     D DSC01c          DS                  QUALIFIED BASED(pDSC01c)

     D  JI                           10S 0                                      N*N - IJ + 1

 

      ***

      * *  Definición datos fichero virtual DS8888

      ***

     D DSDc            DS                  QUALIFIED BASED(pDSDc)

     D  IJ                           10S 0                                      N*(I-1) + J

     D  IMPT                         10S 0                                      [100000]+N*(I-1) + J

      * La constante [100000] se añadirá/retirará en los UPDATE de prueba

 

 

 

Continuamos con el fuente del código de SRAGMV_UPDATE:

 
 
      /FREE
 
 
         // Proceso para nº de parámetros limitado (Es el uso por defecto de la rutina. Se autoinvocan los dos pasos)
 
         T_Parm = %parms();
         if T_Parm <= 5;
 
            *IN90 = SRAGMV_Update(P_LF:P_NUME:P_Bloq:P_OnErr:P_DspSts:'0');
            *IN90 = SRAGMV_Update(P_LF:P_NUME:P_Bloq:P_OnErr:P_DspSts:'1');
            return *IN90;
 
         endif;
 
 
 
         // ACTUALIZA ITEMS, SEGÚN FORMATO
 
         for T_I = 1 to P_NUME;
            for T_J = 1 to P_NUME;
 
               T_K += 1;
 
 
               // Indice I,J. Selecciona sólo elementos pares
 
               T_IJ = P_NUME * (T_I - 1) + T_J;
 
               if %rem(T_IJ:2) <> *ZEROS; // Elude impares
                  iter;
               endif;
 
 
               // Construye registro a actualizar, según formato solicitado
 
               clear DS8888;
 
               DS8888.DSK.I = T_I;
               DS8888.DSK.J = T_J;
 
               DS8888.DSD.IJ = P_NUME * (T_I - 1) + T_J;
 
               DS8888.DSK01.JI = P_NUME*P_NUME - DS8888.DSD.IJ + 1;
 
               DS8888.DSD.IMPT = DS8888.DSD.IJ;
               if P_Formato = '1';
                  DS8888.DSD.IMPT = 100000 + DS8888.DSD.IJ;
               endif;
 
 
 
               // Actualiza. Sentencia principal de la rutina
 
            T_Resu = SRAGM_UPDATE(P_LF:%addr(DS8888.DSK01):%addr(DS8888));
 
 
               // Mensaje de error
 
               if T_Resu = *ZEROS;
 
                  // Control de errores
                  ...
                  return *ON;
        
               endif;
 
 
               // Mensaje de estado
 
               if %rem(T_K:P_Bloq) = *ZEROS and P_DspSts = '1';
 
                  T_MENS = 'U: ' + %trim(P_LF) + ' ' + %char(DS8888.DSK01.JI);
                  SRAGMV_Dsts(T_MENS);
 
               endif;
 
           endfor;
        endfor;
 
 
 
        // VERIFICA ITEMS SEGÚN FORMATO
 
        for T_I = 1 to P_NUME;
           for T_J = 1 to P_NUME;
 
              T_K += 1;
 
 
              // Indice I,J. Sólo toma elementos pares
 
              T_IJ = P_NUME * (T_I - 1) + T_J;
 
              if %rem(T_IJ:2) <> *ZEROS; // Elude impares
                 iter;
              endif;
 
 
               // Lee por chain sobre la vía lógica
 
               clear DS8888;
 
               DS8888.DSK01.JI = P_NUME*P_NUME - T_IJ + 1;
 
            T_Resu = SRAGM_CHAIN(P_LF:%addr(DS8888.DSK01):%addr(DS8888));
 
 
               // Mensaje de error
 
               if T_Resu = *ZEROS;
 
                  // Control de errors
                  ...
                  return *ON;
 
 
               endif;
 
 
               // Mensaje de error por lectura impropia
 
               if (P_Formato = '0' and DS8888.DSD.IMPT <> DS8888.DSD.IJ)
               or (P_Formato = '1' and
                   DS8888.DSD.IMPT <> (100000 + DS8888.DSD.IJ) );
 
                  // Control de errors
                  ...
                  return *ON;
 
               endif;
 
 
               // Mensaje de estado
 
               if %rem(T_K:P_Bloq) = *ZEROS and P_DspSts = '1';
                  
                  // Mensaje de estado
 
                  ...
 
               endif;
 
            endfor;
         endfor;
 
 
 
         // Fin de proceso satisfactorio
 
         return *OFF;
 
 
         Begsr *PSSR;
            SRAGG_AnotPSSR(P1STAT);
            return *On;
         Endsr;
 
 
      /END-FREE
 
     PSRAGMV_Update    E

 

 

 

 

 

      /FREE

 

 

 

 

Veamos ahora una muestra gráfica del resultado para un fichero de tamaño 324 = 18 x 18:

 

 

Tras la primera actualización:


 

 

 

Tras la restauración después de la segunda actualización:


 

 

 

El código del interfaz de presentación se encuentra en

 

 Archivo de pantalla CCD8810: http://iseries.ficherosvirtuales.com/QDDSSRC/QDDSSRC.CCD8810

 Código del programa CC8810 : http://iseries.ficherosvirtuales.com/QRPGLESRC/QRPGLESRC.CC8810

 Código adicional DS8810  . : http://iseries.ficherosvirtuales.com/QRPGLESRC/QRPGLESRC.COCCD_8810

 

Donde se invocan los servicios de prueba que se extrajeron de CC8888 y se volcaron al programa de servicio SRAGMV


      Prototipos de exportación: http://iseries.ficherosvirtuales.com/QCOPYSRC/QCOPYSRC.PSRAGMV
  (*) Fuente principal . . . . : http://iseries.ficherosvirtuales.com/QRPGLESRC/QRPGLESRC.SRAGMV 
      Fuente de enlace . . . . : http://iseries.ficherosvirtuales.com/QSRVSRC/QSRVSRC.SSRAGMV