¿ Quieres imprimir esta página ? Volver a la página principal de Recursos iSeries AS400 ¿ Necesitas ayuda ? En pruebas
Recursos iSeries AS400. Compartiendo generamos conocimiento
Novedades en Recursos iSeries AS400
Últimas noticias del iSeries AS400
Programa de mantenimiento dinámico con Pushbuttons

Categoría : Programación
Autor : Pedro Molina
Título : Programa de mantenimiento dinámico con Pushbuttons


Descripción del truco:
Este programa, es para mantenimiento de un archivo, el cual despliega inicialmente el contenido de los registros dentro de un Subfile.

Además permite navegar a traves del archivo utilizando pushbuttons, ej: Inicio, Previo, Siguiente, Ultimo, Busqueda.

Este programa simula (si se puede decir de esta manera) el control del mismo como si estuvieras con un programa de Windows) aqui no se utilizan para nada los indicadores como se utilizaban o aún se utilizan en otros programas ej, IF *in03, o cuando se hace un encadenamiento, encender un indicador, no esto ya no.

Bueno, ahi les mando los textos por si lo quieren probar, lo unico que tienen que hacer es copiar a los miembros correspondientes en su AS/400, compilarlos en X librería y listo !! para que jueguen con el.


Código en formato texto
Fecha 10-02-2004

DDS's para archivo Fisico COBMCLI (Maestro Cobranzas Clientes)

UNIQUE R RCLIC CODCLI 7 0 COLHDG('COD.CLIENTE') NOMCLI 40 COLHDG('NOMBRE CTE.') TIPCOB 3 0 COLHDG('TIPO COBRANZA') DIRECC 40 COLHDG('DIRECCION') CONTACTO 40 COLHDG('CONTACTO') PUESTO 20 COLHDG('PUESTO') TELEFO 15 COLHDG('TELEFONO') CELULAR 15 COLHDG('CELULAR') FAX 15 COLHDG('FAX') RTN 10 COLHDG('R.T.N.') STSCTE 1 COLHDG('STATUS') K CODCLI
DDS's para archivo de Pantalla DSPFILE
A*%%TS SD 20040204 135553 PEDROM REL-V5R1M0 5722-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A INDARA
A CA03(03 'SALIR')
A CA12(12 'CANCELAR')
A R P01
A*%%TS SD 20040204 135553 PEDROM REL-V5R1M0 5722-WDS
A CF10(10 'Confirmar')
A CF20(20 'Inicio Archivo')
A CF21(21 'Reg. Previo')
A CF22(22 'Reg. Siguiente')
A CF23(23 'Ultimo Reg.')
A CF24(24 'Ubicar Regto.')
A CF04(04 'Eliminar Registro')
A 1 63DATE
A EDTCDE(Y)
A DSPATR(HI)
A 1 72TIME
A DSPATR(HI)
A 1 2'BANCO POPULAR S.A.'
A DSPATR(HI)
A COLOR(BLU)
A DSPATR(UL)
A 3 2' -
A -
A '
A DSPATR(HI)
A DSPATR(UL)
A COLOR(BLU)
A 1 22'COBMNT01'
A COLOR(BLU)
A BTNNAV 2Y 0B 4 4PSHBTNFLD((*NUMROW 1))
A PSHBTNCHC(1 'INICIO' CF20)
A PSHBTNCHC(2 'PREVIO' CF21)
A PSHBTNCHC(3 'SIGTE.' CF22)
A PSHBTNCHC(4 'ULTIMO' CF23)
A PSHBTNCHC(6 'BUSCAR' CF24)
A 7 2'Cod. Cte.'
A 8 2'Segm Cob.'
A WOMCTE 40A B 7 20DSPATR(HI)
A 16 DSPATR(PR)
A 24 2' -
A -
A '
A DSPATR(HI)
A DSPATR(UL)
A COLOR(BLU)
A BTNCMD 2Y 0B 4 67PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'CONFIRMAR' CF10)
A BTNCM1 2Y 0B 6 67PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'ELIMINAR.' CF04)
A BTNCM2 2Y 0B 8 67PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'RETORNAR.' CA03)
A BTNCM3 2Y 0B 10 67PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'S A L I R' CA12)
A 2 2'MODULO DE COBRANZAS A TERCEROS'
A DSPATR(HI)
A DSPATR(UL)
A 2 34'MANTENIMIENTO MAESTRO DE CLIENTES -
A COBRANZAS'
A WODCTE 7N 0B 7 12DSPATR(PC)
A 05 DSPATR(PR)
A DSPATR(HI)
A WEGCOB 3N 0B 8 12
A 16 DSPATR(PR)
A DESCOB 40A O 8 20DSPATR(HI)
A 10 2'Direccion'
A WIRECC 40A B 10 12DSPATR(RI)
A 16 DSPATR(PR)
A WONTACTO 40A B 11 12DSPATR(RI)
A 16 DSPATR(PR)
A 11 2'Contacto'
A 12 2'Puesto '
A WUESTO 20A B 12 12DSPATR(RI)
A 16 DSPATR(PR)
A 13 2'Telefono'
A WELEFO 15A B 13 12DSPATR(RI)
A 16 DSPATR(PR)
A WELULAR 15A B 13 37DSPATR(RI)
A 16 DSPATR(PR)
A 13 29'Celular'
A 13 53'Fax'
A WAX 15A B 13 57DSPATR(RI)
A 16 DSPATR(PR)
A DIASEM 8A O 1 53DSPATR(HI)
A 4 2' '
A DSPATR(RI)
A COLOR(BLU)
A 5 2' -
A '
A DSPATR(RI)
A COLOR(BLU)
A 4 63' '
A DSPATR(RI)
A COLOR(BLU)
A 15 2'Comision?'
A PAGCOM 1A B 15 12DSPATR(RI)
A 16 DSPATR(PR)
A 15 15'Tipo Comision'
A TIPCOM 3N 0B 15 29DSPATR(RI)
A 16 DSPATR(PR)
A FLD003 30A O 15 33DSPATR(HI)
A 15 64'Freq.'
A FRECUE 1A B 15 70DSPATR(RI)
A 16 DSPATR(PR)
A FLD005 8A O 15 72DSPATR(HI)
A 19 27'---- Datos Financieros ----'
A DSPATR(HI)
A 21 2'Monto Acumulado'
A FLD006 12Y 2O 21 18EDTWRD(' . ')
A DSPATR(UL)
A DSPATR(RI)
A 21 47'Monto Liquidado'
A FLD007 12Y 2O 21 63EDTWRD(' . ')
A DSPATR(UL)
A DSPATR(RI)
A 16 2'Administ.'
A TIPADM 1A B 16 12DSPATR(RI)
A 16 DSPATR(PR)
A FLD009 30A O 16 15DSPATR(HI)
A 17 2'Formula'
A FORCOB 4A B 17 12DSPATR(RI)
A 16 DSPATR(PR)
A FLD012 30A O 17 17DSPATR(HI)
A 17 48'(Aplicacion Formula de Cobro)'
A 22 2'Fecha Ult.Liqui'
A FEULLI 10A B 22 18DSPATR(RI)
A 16 DSPATR(PR)
A 1 33'Modo:'
A MODO 11A O 1 39DSPATR(HI)
A DSPATR(RI)
A 4 65' '
A DSPATR(RI)
A COLOR(BLU)
A 5 65' '
A DSPATR(RI)
A COLOR(BLU)
A 6 65' '
A DSPATR(RI)
A COLOR(BLU)
A 7 65' '
A DSPATR(RI)
A COLOR(BLU)
A 8 65' '
A DSPATR(RI)
A COLOR(BLU)
A 9 65' '
A DSPATR(RI)
A COLOR(BLU)
A 10 65' '
A DSPATR(RI)
A COLOR(BLU)
A 11 65' '
A DSPATR(RI)
A COLOR(BLU)
A 4 79' '
A DSPATR(RI)
A COLOR(BLU)
A 5 79' '
A DSPATR(RI)
A COLOR(BLU)
A 6 79' '
A DSPATR(RI)
A COLOR(BLU)
A 7 79' '
A DSPATR(RI)
A COLOR(BLU)
A 8 79' '
A DSPATR(RI)
A COLOR(BLU)
A 9 79' '
A DSPATR(RI)
A COLOR(BLU)
A 10 79' '
A DSPATR(RI)
A COLOR(BLU)
A*%%GP SCREEN1 01
A R P1SFL SFL
A*%%TS SD 20031125 101246 PEDROM REL-V5R1M0 5722-WDS
A NOMCLI 40A O 5 17
A OPC 1A B 5 3CHECK(ER)
A WESCOB 20A O 5 59
A CODCLI 7Y 0O 5 6EDTCDE(Z)
A R P1SFLCTL SFLCTL(P1SFL)
A*%%TS SD 20040204 135553 PEDROM REL-V5R1M0 5722-WDS
A SFLSIZ(0050)
A SFLPAG(0017)
A CF06(06 'Insertar')
A CF10(10 'Confirmar')
A OVERLAY
A SFLDSP
A SFLDSPCTL
A 34 SFLINZ
A 35 SFLCLR
A 1 2'* BANCO POPULAR S.A. *'
A DSPATR(HI)
A COLOR(BLU)
A DSPATR(UL)
A 1 62DATE
A EDTCDE(Y)
A DSPATR(HI)
A 2 2'MODULO DE COBRANZAS A TERCEROS'
A DSPATR(HI)
A DSPATR(UL)
A 1 72TIME
A DSPATR(HI)
A 3 2'Opciones X=Seleccionar -
A -
A '
A DSPATR(UL)
A DSPATR(HI)
A 4 2'Opc Cod.Cte. Nombre -
A Segmento Cob-
A ranza '
A DSPATR(RI)
A 2 36'* Mantenimiento a Clientes/Cobranz-
A as *'
A DSPATR(HI)
A 1 26'COBMNT01 V1.M0'
A COLOR(BLU)
A DIASEM 8A O 1 53DSPATR(HI)
A R PIE
A*%%TS SD 20031124 190016 PEDROM REL-V5R1M0 5722-WDS
A CF06(06 'Insertar')
A CF10(10 'Confirmar')
A OVERLAY
A 22 2' -
A -
A '
A DSPATR(HI)
A DSPATR(UL)
A BTNCMD1 2Y 0B 23 2PSHBTNFLD((*NUMROW 1))
A PSHBTNCHC(1 'SALIR' CA03)
A PSHBTNCHC(2 'INSERTAR' CF06)
A R WSFL
A*%%TS SD 20031112 120404 PEDROM REL-V5R1M0 5722-WDS
A SFL
A OP 1A I 4 2CHECK(ER)
A COMP(EQ '1')
A CODCLI 7S 0O 4 5
A NOMCLI 40A O 4 14
A R WSFLCT SFLCTL(WSFL)
A*%%TS SD 20031218 105535 PEDROM REL-V5R1M0 5722-WDS
A SFLDSP
A SFLDSPCTL
A 44 SFLINZ
A 45 SFLCLR
A SFLSIZ(0050)
A SFLPAG(0010)
A WINDOW(5 15 15 55)
A RMVWDW
A USRRSTDSP
A 2 2'Opciones:'
A DSPATR(HI)
A 2 12'1=Seleccionar, ENTER=Salir'
A COLOR(BLU)
A 3 2'Op Cod.Cte Nombre -
A '
A DSPATR(UL)
A DSPATR(RI)
A COLOR(WHT)
A 1 2'Seleccion de Registros de A/M de C-
A lientes'
A DSPATR(HI)
A DSPATR(UL)
A R P02
A*%%TS SD 20031218 110218 PEDROM REL-V5R1M0 5722-WDS
A ALARM
A OVERLAY
A WINDOW(7 28 10 25)
A RMVWDW
A USRRSTDSP
A 2 1'Desea realmente eliminar'
A 3 1'el Registro seleccionado?'
A RESP 1A I 5 7DSPATR(RI)
A 5 9'(S=Si N=No)'
A DSPATR(HI)
A 7 2'Blanco Ignora Eliminar'
A DSPATR(HI)
A BOTON 2Y 0B 9 9PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'ACEPTAR')
A R P03
A*%%TS SD 20031218 105823 PEDROM REL-V5R1M0 5722-WDS
A OVERLAY
A WINDOW(8 29 10 26)
A* WDWBORDER((*COLOR WHT) (*CHAR '...;-
A* ;;.;'))
A RMVWDW
A USRRSTDSP
A R PERR
A*%%TS SD 20031218 110218 PEDROM REL-V5R1M0 5722-WDS
A ALARM
A OVERLAY
A WINDOW(7 28 10 25)
A RMVWDW
A USRRSTDSP
A BOTON 2Y 0B 9 9PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'ACEPTAR')
A 2 11'Error'
A DSPATR(HI)
A LINER1 25A O 4 1
A LINER2 25A O 5 1
A LINER3 25A O 6 1
A 2 1'Error'
A DSPATR(HI)
A 2 21'Error'
A DSPATR(HI)
A R P04
A*%%TS SD 20031218 110218 PEDROM REL-V5R1M0 5722-WDS
A ALARM
A OVERLAY
A WINDOW(7 28 10 25)
A RMVWDW
A USRRSTDSP
A 2 1'El Registro confirmado no'
A 3 1'existe en el Archivo. '
A ADICIONAR 1A I 6 7DSPATR(RI)
A 6 9'(S=Si N=No)'
A DSPATR(HI)
A 7 2'Blanco Ignora Adicionar'
A DSPATR(HI)
A DSPATR(UL)
A BOTON 2Y 0B 9 9PSHBTNFLD((*NUMCOL 1))
A PSHBTNCHC(1 'ACEPTAR')
A 4 1'Desea'
A 4 7'Agregarlo?'

Especificaciones Fuente programa en RPGIV PRGMNT01
***************************************************
*Programa: PRGMNT01 *
*Funcion : Programa para Mantenimiento al archivo *
* : Maestro de Clientes de Cobranzas *
*Autor : Pedro M. Molina *
*Fecha : Nov-2003 *
*Lugar : San Pedro Sula, Honduras C.A. *
*Version : 1 *
***************************************************

Fdspfile cf e workstn IndDs(DispInd)
F INFDS(INFDS)
F SFILE(P1sfl:NRR)
F SFILE(Wsfl:NR1)
FCobMcli uf A e k Disk

* Estructura de Indicadores de Archivo de pantalla
D DISPIND DS
D Salir 3 3N
D Eliminar 4 4N
D ProtegeClave 5 5N
D Insertar 6 6N
D Confirmar 10 10N
D Cancelar 12 12N
D ProtegeTodo 16 16N
D Inicio 20 20N
D Previo 21 21N
D Siguiente 22 22N
D Ultimo 23 23N
D Seleccionar 24 24N
D InzSfl 34 34N
D ClearSfl 35 35N
D InzwSfl 44 44N
D ClearwSfl 45 45N

D INFDS DS
D Lin 370 370
D Col 371 371

D INFDS1 DS
D Blin 1 2B 0
D clin 2 2
D BCol 3 4B 0
D ccol 4 4

* Estructura de Campos de Pantallas
D WstnStr DS
D Wodcte 7 0
D Womcte 40
D Wipcob 3 0
D Wirecc 40
D Wontacto 40
D Wuesto 20
D Welefo 15
D Welular 15
D Wax 15

* Estructura de Campos de Archivo
D FileStr DS
D Codcli 7 0
D Nomcli 40
D Tipcob 3 0
D Direcc 40
D Contacto 40
D Puesto 20
D Telefo 15
D Celular 15
D Fax 15

D MsgData DS
D 25 Inz('Regto. existe en Archivo.')
D 25 Inz('Codigo no debe ser Zeros.')
D 25 Inz('Verifique el codigo.')

* Arreglo de Msg's
D MSGE 25 DIM(3) Overlay(Msgdata)

*
*------------------ Inicio de Proceso -----------------
*

C Clear WstnStr
C Clear FileStr
C Clear Infds1
*rutina para recuperar el dia de la semana
C* Call 'DATESUB2'
C* Parm Diasem 8

C Exsr @Filsfl

C Dow Not (Salir or Cancelar)
C Write Pie
C Exfmt P1SflCtl
C Eval Blin = 0
C Eval Bcol = 0
C Move Lin Clin
C Move Col Ccol
C Select
C When Insertar
C Exsr @Insert
C EndSl
* Verifica si se selecciono un Registro
C If Not (Salir or Cancelar or Insertar)
C If Blin >= 5
C Eval Blin = Blin - 4
C Endif
C Blin Chain(e) p1sfl
C If %Found
C codcli Chain cobmcli
C Exsr @Insert
C EndIf
C EndIf
*
C EndDo

C Eval *Inlr = *On

*-----------------------------------------------------*
* Rutina de llenado de SubFile *
*-----------------------------------------------------*
C @FilSfl BEGSR
C Clear NRR 3 0
C Eval ClearSfl=*on
C Write P1SflCtl
C Eval ClearSfl=*off
* Determina si existen registros en el archivo para inicializar Sfile
C *Loval Setll CobMcli
C If Not %Found
C Eval InzSfl=*on
C Write P1SflCtl
C Eval InzSfl=*off
C Endif
*
C *Loval Setll CobMcli
C DoW Not %Eof(CobMcli)
C Read(e) CobMcli
C If Not %Eof(CobMcli)
C Eval NRR = NRR + 1
C Write P1Sfl
C EndIf
C EndDo

C EndSr
*-----------------------------------------------------*
* Rutina de Inserci¢n de Nuevos Registros *
*-----------------------------------------------------*
C @Insert BEGSR

C If Insertar
C Eval Modo = 'Insercion'
C Clear FileStr
C Clear WstnStr
C Eval ProtegeClave = *off
C Else
C Eval WstnStr = FileStr
C Eval ProtegeClave = *on
C Eval Modo = 'Cambio'
C EndIf

C Dow Not (salir or cancelar)
C Exfmt P01
C Exsr @Botones
C Enddo
C Clear WstnStr
C Clear FileStr
C Clear Opc
C Exsr @FilSfl
C If Salir
C Eval Salir = *off
C Endif

C EndSr
*-----------------------------------------------------*
* Rutina de Inicio de Archivo *
*-----------------------------------------------------*
C @Begin BEGSR

C *loval Setll Cobmcli
C If %Found
C Eval Modo = 'Cambio'
C Read(n) Cobmcli
C Eval WstnStr = FileStr
C Endif

C EndSr
*-----------------------------------------------------*
* Rutina de Registro Anterior o Previo *
*-----------------------------------------------------*
C @Previous BEGSR

C Readp(e) Cobmcli
C If Not %Eof
C Eval Modo = 'Cambio'
C Eval WstnStr = FileStr
C Else
C Exsr @Begin
C Endif

C EndSr
*-----------------------------------------------------*
* Rutina de Registro Siguiente *
*-----------------------------------------------------*
C @Next BEGSR

C Read(e) Cobmcli
C If Not %Eof
C Eval Modo = 'Cambio'
C Eval WstnStr = FileStr
C Else
C Exsr @Last
C Endif

C EndSr
*-----------------------------------------------------*
* Rutina de Ultimo Registro *
*-----------------------------------------------------*
C @Last BEGSR

C *hival Setll Cobmcli
C Readp(e) Cobmcli
C If Not %Eof
C Eval Modo = 'Cambio'
C Eval WstnStr = FileStr
C Endif

C EndSr
*-----------------------------------------------------*
* Rutina de Seleccion de Registro *
*-----------------------------------------------------*
C @Find BEGSR

C Clear NR1 3 0
C Eval ClearwSfl=*on
C Write WSflCt
C Eval ClearwSfl=*off

C *Loval Setll CobMcli
C DoW Not %Eof(CobMcli)
C Read(e) CobMcli
C If Not %Eof(CobMcli)
C Eval NR1 = NR1 + 1
C Write WSfl
C EndIf
C EndDo

C Exfmt WSflCt
* Verifica si se selecciono una opcion
C Eval Blin = 0
C Eval Bcol = 0
C Move Lin Clin
C Move Col Ccol

C If Blin >= 9
C Eval Blin = Blin - 8
C Endif

C Blin Chain(e) Wsfl
C If %Found
C codcli Reade(n) cobmcli
C Eval WstnStr = FileStr
C Endif

C EndSr
*-----------------------------------------------------*
* Rutina de Validacion de Botones *
*-----------------------------------------------------*
C @Botones BEGSR

C Clear liner1
C Clear liner2
C Select

C When Confirmar
C wodcte Chain Cobmcli
C If Not %Found and modo='Cambio'
C* Write P03
C Exfmt P04
C If Adicionar='S'
C Eval Modo='Insercion'
C Endif
C Endif
C If %Found and modo='Insercion'
C Eval liner1=MSGE(1)
C Eval liner2=MSGE(3)
C* Write P03
C Exfmt PERR
C ElseIf wodcte = *Zeros
C Eval liner1=MSGE(2)
C Eval liner2=MSGE(3)
C* Write P03
C Exfmt PERR
C Else
C Eval FileStr = WstnStr
C If modo='Insercion'
C Write Rclic 50
C ElseIf modo='Cambio'
C Update Rclic
C Endif
C Eval Modo = 'Cambio'
C Endif

C When Eliminar
C Eval Modo = 'Eliminacion'
C Write P01
C* Write P03
C Exfmt P02
C If Resp='S'
C Delete Rclic
C Eval Salir = *on
C Else
C Eval Modo = 'Cambio'
C Endif


C When Inicio
C ExSr @Begin
C When Previo
C ExSr @Previous
C When Siguiente
C ExSr @Next
C When Ultimo
C ExSr @Last
C When Seleccionar
C ExSr @Find

C EndSl

* -----
C EndSr
* -----

¿Tienes algún truco que quieras compartir con todos los profesionales de Recursos iSeries AS400?.Envianoslo y si resulta seleccionado te enviaremos un vale de Amazon por valor de 50$

Comentarios de usuarios

Nombre:
Mail:
Comentario:
 

Subir a la parte superior de la web

Symtrax
Dossiers técnicos iSeries y AS400
- Dossier de seguridad
- Alta disponibilidad.
¿Buscas trabajo ?
Inscríbete en nuestra lista laboral y recibirás las ofertas de trabajo en tu buzón de correo electrónico.
Nuestros links preferidos
- Tendencias tecnologías de la información
Expertos en materías relacionadas con las tecnologías de la información, nos dan su punto de vista sobre las tendencias actuales y futuras
- Los últimos anuncios sobre hardware-software para iSeries AS400 realizados por IBM
- Freeware. Software gratuito para el iSeries AS400
- Utilidades para el iSeries AS400 realizadas por profesionales
- Documentos. Trucos e ideas para resolver tus problemas
- Manuales. Los manuales y links más interesantes del iSeries AS400

  Links patrocinados
  •  
  •  

[ Soy nuevo |   Profesionales |   AS qué |   Empresas |    Foros |   Recomiéndanos |    Productos ]
 
Recursos iSeries AS400 es una web de: Poliedric, s.c.p. CIF:G63005011 Urgell 143 1º1ª 08036 - Barcelona - Tel.+34.902.361.344