RPG

 

Ficheros virtuales

 

 

En SRAGMV_SETLL el banco de pruebas verifica la conjunción del uso de SETLL & READE, SETGT & READPE y SETGTT & READE.

 

Estas rutinas, aunque sin el resultado gráfico del UPDATE o el DELETE, son básicas en el procesamiento algorítmico.

 

 

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

 

 

      *

      *

      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      * PPPPPP                         PPPPPP

      * Rutina pruebas de SRAGM_SETLL, READE, ...

      * PPPPPP                         PPPPPP

      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PSRAGMV_Setll     B                   EXPORT

      *

     DSRAGMV_Setll     PI              N                                        0/1 Error         *O

     D P_PF                          33    VALUE                                NombreFilePFactual*I

     D P_NUME                         6  0 VALUE                                NºElementos prueba*I

     D P_Bloq                         6  0 VALUE                                NºEl.bloque DSPLY *I

     D P_OnErr                        1    VALUE                                0=Ite 1=Leav 2=Fin*I

     D P_DspSts                       1    VALUE                                0/1 emitir dspd   *I

 

      ***

      * * DEFINICION DE CAMPOS E INDICADORES

      ***

     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_Bloq          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_SETLL:

 
 

 

      /FREE

 

 

         // Sitúa por SETLL (I=1)

 

         clear DS8888;

 

         DS8888.DSK.I = 1;

 

       T_Resu = SRAGM_SETLL(P_PF:%addr(DS8888):%size(DS8888.DSK01)); // %size(i)

 

 

 

 

         // Lee por igual (I=1) hacia adelante

 

         for T_J = 1 to P_NUME;

 

            T_K += 1;

 

          T_Resu = SRAGM_READE(P_PF:%addr(DS8888):%size(DS8888.DSK01): // %size(i)

                                                    %addr(DS8888));

 

            if T_Resu = *ZEROS;

 

               // Control de errores

 

               . . .

 

               return *ON;

 

            endif;

 

 

            // Error por lectura impropia

 

            if (%rem(DS8888.DSD.IJ:2) = *ZEROS and

                DS8888.DSD.IMPT <> 100000 + DS8888.DSD.IJ)

            or

               (%rem(DS8888.DSD.IJ:2) <> *ZEROS and

                DS8888.DSD.IMPT <> DS8888.DSD.IJ);

 

               // Control de errores

 

               . . .

 

               return *ON;

 

 

            endif;

 

 

         endfor;

 

 

 

         // Sitúa por SETGT (I=1) [EN SRAGM UN SETGT PARCIAL SITÚA AL FINAL DE UN BLOQUE PARA PERMITIR READPE DE TODO EL BLOQUE]

 

         clear DS8888;

 

         DS8888.DSK.I = 1;

 

         T_Resu = SRAGM_SETGT(P_PF:%addr(DS8888):%size(DS8888.DSK01)); // %size(i)

 

 

 

         // Lee por igual (I=1) hacia atrás

 

         for T_J = P_NUME downto 1;

 

            T_K += 1;

 

          T_Resu = SRAGM_READPE(P_PF:%addr(DS8888):

                                     %size(DS8888.DSK01): // %size(i)

                                     %addr(DS8888));

            if T_Resu = *ZEROS;

 

               // Control de errores

 

               . . .

 

               return *ON;

 

            endif;

 

 

            // Mensaje de error por lectura impropia

 

            if (%rem(DS8888.DSD.IJ:2) = *ZEROS and

                DS8888.DSD.IMPT <> 100000 + DS8888.DSD.IJ)

            or

               (%rem(DS8888.DSD.IJ:2) <> *ZEROS and

                DS8888.DSD.IMPT <> DS8888.DSD.IJ);

 

 

               // Control de errores

 

               . . .

 

               return *ON;

 

            endif;

 

 

         endfor;

 

 

 

         // Sitúa por SETGTT (I=0) [EN SRAGM UN SETGTT PARCIAL SITÚA TRAS EL FINAL DE UN BLOQUE PARA PERMITIR READE DEL BLOQUE SIGUIENTE]

 

         clear DS8888;

 

         DS8888.DSK.I = 0;

 

         T_Resu = SRAGM_SETGTT(P_PF:%addr(DS8888):%size(DS8888.DSK01)); // %size(i)

 

 

 

         // Lee por igual (I=1) hacia adelante

 

         DS8888.DSK.I = 1;

 

         for T_J = 1 to P_NUME;

 

            T_K += 1;

 

            T_Resu = SRAGM_READE(P_PF:%addr(DS8888):

                                    %size(DS8888.DSK01): // %size(i)

                                    %addr(DS8888));

            if T_Resu = *ZEROS;

 

               // Control de errores

 

               . . .

 

               return *ON;

 

            endif;

 

 

 

            // Mensaje de error por lectura impropia

 

            if (%rem(DS8888.DSD.IJ:2) = *ZEROS and

                DS8888.DSD.IMPT <> 100000 + DS8888.DSD.IJ)

            or

               (%rem(DS8888.DSD.IJ:2) <> *ZEROS and

                DS8888.DSD.IMPT <> DS8888.DSD.IJ);

 

 

               // Control de errores

 

               . . .

 

               return *ON;

 

            endif;

 

 

 

 

         // Fin de proceso satisfactorio

 

         return *OFF;

 

 

      /END-FREE

 

 

     PSRAGMV_SETLL    E

 

 

 

Veamos ahora una muestra gráfica del fichero de soporte recorrido en las rutinas anteriores para un tamaño 324 = 18 x 18:


 

 

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