***************************************************
*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
* -----