RPG

 

Ficheros virtuales

 

 

 

El banco de pruebas comienza cargando el fichero virtual con la función SRAGMV_WRITE que consiste en un bucle de llamadas a SRAGM_WRITE.

 

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

 

 

 

      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      * PPPPPP                        PPPPPP

      * SRAGMV_Write: Rutina para pruebas de SRAGM_WRITE

      * PPPPPP                        PPPPPP

      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

      * SALVA ITEMS

      *

      * LOS ELEMENTOS IMPARES EN FORMATO IJ = IJ

      * LOS ELEMENTOS PARES EN FORMATO   IJ = 100000 + IJ

      *

     PSRAGMV_Write     B                   EXPORT

      *

     DSRAGMV_Write     PI              N                                        0/1 Error         *O

     D P_FILE                        33    VALUE                                NombreFileActual  *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_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_WRITE, con comentarios adicionales en cursiva:

 

 

 

 

      /FREE

 

 

         // Bucle de carga

 

         for T_I = 1 to P_NUME;

            for T_J = 1 to P_NUME;

 

               T_K += 1;

 

 

               // Construye registro a guardar

              

                    // Son el mismo tipo de instrucciones que se emplearía para rellenar un formato

                    // de registro en formato calificado

 

 

 

               // Inicializa formato de salida

 

               clear DS8888;

 

 

               // Paso de claves directas

 

               DS8888.DSK.I = T_I;

               DS8888.DSK.J = T_J;

 

 

               // Paso de claves alternatives

 

               DS8888.DSD.IJ = P_NUME * (T_I - 1) + T_J;             // IJ condensado como N*(I-1) + J

 

               DS8888.DSK01.JI = P_NUME*P_NUME - DS8888.DSD.IJ + 1;  // IJ en recorrido inverso, de N*N a 1

 

 

 

               // Graba importes según convenio asociado a la paridad

 

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

                  DS8888.DSD.IMPT = 100000 + DS8888.DSD.IJ; // Pares

               else;

                  DS8888.DSD.IMPT = DS8888.DSD.IJ;          // Impares

               endif;

 

 

 

               // Graba registro construido. Es la instrucción principal de la rutina

 

                   // En un fichero normal la instrucción sería del tipo:   write REGDS DS8888;

 

 

            T_Resu = SRAGM_WRITE(P_FILE:%addr(DS8888));

 

 

                   // T_Resu recoge la posición relativa del registro en el fichero en función de su clave.

                   //        Si es nula, resulta que ya existía un registro con esa clave y por tanto no se ha grabado éste.

                   //        También se devuelve cero si hay algún otro tipo de error, como que el fichero no exista.

 

               if T_Resu = *ZEROS;

 

                  // Control de errores. Presenta mensaje y termina. Ver código fuente completo(*) para detalles    

                  ...

 

                  return *ON;

 

               endif;

 

 

 

               // Emite opcionalmente mensajes de estado cada P_Bloq registros

 

               if %rem(T_K:P_Bloq) = *ZEROS and P_DspSts = '1';

 

                  T_MENS = 'W: ' + %trim(P_FILE) + ' ' + %char(T_I) + ' ' + %char(T_J);

 

                  SRAGMV_Dsts(T_MENS);

 

               endif;

 

 

            endfor;

         endfor;

 

 

 

         // GRABA UN ULTIMO ELEMENTO 0 - 0

 

         *IN90 = SRAGMV_Write00(P_FILE:P_NUME:P_dspSts);

 

         if *IN90 and P_OnErr = '2';

            return *ON;

         endif;

 

 

 

         // GRABA UN ULTIMO ELEMENTO 9 - 9

 

         *IN90 = SRAGMV_Write99(P_FILE:P_NUME:P_dspSts);

 

         if *IN90 and P_OnErr = '2';

            return *ON;

         endif;

 

 

 

         // Fin de proceso satisfactorio

 

         return *OFF;

 

 

         Begsr *PSSR;

            SRAGG_AnotPSSR(P1STAT);

            return *On;

         Endsr;

 

 

      /END-FREE

 

     PSRAGMV_Write     E

 

 

 

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



Antes de la carga de datos:





Y tras la carga de datos:


 

 

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