RPG Moderno

// ============ FIXED FORMAT (antiguo) ============
     C     KEY           CHAIN     CLIENTES
     C                   IF        %FOUND
     C                   EVAL      NOMBRE = 'FERNANDO'
     C                   UPDATE    CLIREC
     C                   ENDIF

// ============ FREE FORMAT (moderno) ============
chain key clientes;
if %found(clientes);
  nombre = 'FERNANDO';
  update clirec;
endif;

**free
ctl-opt dftactgrp(*no) actgrp(*caller);
ctl-opt option(*srcstmt : *nodebugio);
ctl-opt datedit(*ymd) datfmt(*iso);
ctl-opt bnddir('MYBNDDIR');

// Variables standalone
dcl-s nombre       varchar(100);
dcl-s edad         int(10);
dcl-s saldo        packed(11:2);
dcl-s fechaHoy     date(*iso);
dcl-s horaActual   time;
dcl-s timestamp    timestamp;
dcl-s activo       ind;             // Indicador (boolean)
dcl-s mensaje      char(50) inz('Hola Mundo');

// Constantes
dcl-c MAX_REGISTROS 9999;
dcl-c IVA           0.21;
dcl-c EMPRESA       'Sinaptrix SRL';

// Prototipo: declara la interfaz de un programa o procedimiento externo
dcl-pr enviarEmail extpgm('SNDMAIL');
  destinatario  varchar(200) const;
  asunto        varchar(100) const;
  cuerpo        varchar(5000) const;
end-pr;

// Interfaz del programa actual (parámetros que recibe)
dcl-pi *n;
  prmCliente   packed(7:0);
  prmAccion    char(10);
end-pi;

if saldo > 10000;
  categoria = 'PREMIUM';
elseif saldo > 5000;
  categoria = 'GOLD';
elseif saldo > 0;
  categoria = 'STANDARD';
else;
  categoria = 'MOROSO';
endif;

// SELECT es el equivalente a SWITCH/CASE
select;
  when accion = 'ALTA';
    agregarCliente(datos);
  when accion = 'BAJA';
    eliminarCliente(id);
  when accion = 'MODIF';
    modificarCliente(id : datos);
  other;
    enviarError('Acción no válida: ' + accion);
endsl;

// FOR — bucle con contador (como for en C/Java)
for i = 1 to %elem(arreglo);
  total += arreglo(i);
endfor;

// FOR con incremento
for i = 10 downto 1 by 2;
  dsply %char(i);
endfor;

// DOW — Do While (evalúa al inicio)
dow not %eof(clientes);
  read clientes clienteDS;
  if not %eof(clientes);
    procesar(clienteDS);
  endif;
enddo;

// DOU — Do Until (evalúa al final, ejecuta al menos una vez)
dou respuesta = 'S' or respuesta = 'N';
  dsply 'Continuar? (S/N)' '' respuesta;
enddo;

// ITER y LEAVE
for i = 1 to 100;
  if esImpar(i);
    iter;            // salta a la siguiente iteración
  endif;
  if i > 50;
    leave;           // sale del bucle
  endif;
  procesar(i);
endfor;

// Declaración del prototipo (en la sección global)
dcl-pr calcularIVA packed(11:2);
  monto packed(11:2) const;
  tasa  packed(5:4) const options(*nopass);
end-pr;

// Implementación del subprocedimiento
dcl-proc calcularIVA;
  dcl-pi *n packed(11:2);
    monto packed(11:2) const;
    tasa  packed(5:4) const options(*nopass);
  end-pi;

  dcl-s tasaReal packed(5:4);

  // Si no se pasó la tasa, usar 21%
  if %parms >= 2;
    tasaReal = tasa;
  else;
    tasaReal = 0.2100;
  endif;

  return monto * tasaReal;
end-proc;

// Uso:
dcl-s impuesto packed(11:2);
impuesto = calcularIVA(50000);          // Usa tasa default 21%
impuesto = calcularIVA(50000 : 0.105);  // Usa tasa 10.5%

dcl-proc formatearNombre;
  dcl-pi *n;
    nombre    varchar(100);      // Sin CONST = pasa por referencia
    apellido  varchar(100) const;
    resultado varchar(200);
  end-pi;

  nombre = %trim(nombre);  // Modifica el original
  resultado = %trim(apellido) + ', ' + %trim(nombre);
end-proc;

dcl-s texto varchar(200);
dcl-s pos   int(10);

texto = '  Hola Mundo  ';

// Limpieza de espacios
texto = %trim(texto);          // 'Hola Mundo'
texto = %triml(texto);         // trim izquierdo
texto = %trimr(texto);         // trim derecho

// Búsqueda
pos = %scan('Mundo' : texto);  // 6 (posición encontrada)
pos = %scan('xyz' : texto);    // 0 (no encontrado)

// Substring
texto = %subst(texto : 1 : 4); // 'Hola'

// Reemplazo
texto = %scanrpl('Mundo' : 'IBM i' : 'Hola Mundo'); // 'Hola IBM i'

// Largo
dcl-s len int(10);
len = %len(%trim(texto));      // largo real del contenido

// Concatenación (operador +)
texto = 'Hola' + ' ' + 'Mundo';

dcl-s numTexto varchar(20);
dcl-s numVal   packed(11:2);
dcl-s fechaISO date(*iso);

// Número a texto
numTexto = %char(12345.67);     // '12345.67'
numTexto = %editc(numVal : '1');// Formato editado con comas
numTexto = %editc(numVal : 'J');// Con signo negativo

// Texto a número
numVal = %dec('12345.67' : 11 : 2);  // 12345.67
numVal = %int('42');                   // 42

// Fechas
fechaISO = %date();                    // Fecha actual
numTexto = %char(fechaISO : *iso);     // '2024-01-15'
fechaISO = %date('2024-06-15' : *iso); // Desde string

// Timestamp
dcl-s ts timestamp;
ts = %timestamp();             // Timestamp actual

// DS qualified (recomendado: acceso con ds.campo)
dcl-ds cliente qualified;
  id       packed(7:0);
  nombre   varchar(100);
  email    varchar(200);
  saldo    packed(11:2);
  activo   ind;
end-ds;

// Uso con notación punto
cliente.id = 1001;
cliente.nombre = 'Fernando Secchi';
cliente.saldo = 50000.00;
cliente.activo = *on;

// DS con DIM (array de estructuras)
dcl-ds listaItems qualified dim(100);
  codigo     char(10);
  cantidad   packed(7:0);
  precio     packed(11:2);
end-ds;

// Acceso a elementos del array
listaItems(1).codigo = 'PROD001';
listaItems(1).cantidad = 5;
listaItems(1).precio = 1250.00;

// Definir una DS como template (no ocupa memoria)
dcl-ds clienteT qualified template;
  id       packed(7:0);
  nombre   varchar(100);
  email    varchar(200);
  saldo    packed(11:2);
end-ds;

// Crear variables basadas en el template
dcl-s clienteNuevo likeds(clienteT);
dcl-s clienteViejo likeds(clienteT);
dcl-ds listaClientes likeds(clienteT) dim(500);

// Copiar toda la estructura
clienteViejo = clienteNuevo;

// Limpiar estructura
reset clienteNuevo;

// DS externa basada en el formato de un archivo
dcl-ds clienteRec extname('CLIENTES') qualified;
end-ds;

// DS con posiciones (para parsear buffers)
dcl-ds header qualified;
  tipo     char(2)   pos(1);
  fecha    char(8)   pos(3);
  secuenc  packed(5:0) pos(11);
  empresa  char(30)  pos(16);
end-ds;

// ANTES: indicadores numéricos
// C     KEY      CHAIN(N)  CLIENTES              50
// C  N50         ...

// AHORA: BIFs descriptivas
chain key clientes;
if %found(clientes);
  // registro encontrado, procesar
endif;

// Para archivos de pantalla (DSPF) aún se usan indicadores
// pero se pueden mapear a nombres descriptivos:
dcl-ds indicadores qualified;
  salir      ind pos(3);    // F3 = Salir
  cancelar   ind pos(12);   // F12 = Cancelar
  confirmar  ind pos(6);    // F6 = Confirmar
  refrescar  ind pos(5);    // F5 = Refrescar
end-ds;

// Archivo de entrada (lectura)
dcl-f clientes disk usage(*input) keyed;

// Archivo de actualización (lectura + escritura)
dcl-f facturas disk usage(*update : *delete : *output) keyed;

// Archivo de pantalla (display file)
dcl-f pantalla workstn;

// Archivo de impresión (printer file)
dcl-f reporte printer;

// Archivo con nombre largo referenciando PF
dcl-f cliMaestro disk extfile('MILIB/CLIENTES')
                      usage(*input) keyed;

// CHAIN — Lectura directa por clave (como SELECT WHERE key = ?)
dcl-s idBuscado packed(7:0) inz(1001);
chain idBuscado clientes;
if %found(clientes);
  dsply ('Encontrado: ' + %trim(nombre));
else;
  dsply 'No encontrado';
endif;

// READ — Lectura secuencial
read clientes;
dow not %eof(clientes);
  // procesar registro actual
  total += saldo;
  read clientes;
enddo;

// SETLL + READE — Lectura por rango de clave parcial
dcl-s codProv char(3) inz('BUE');
setll codProv facturas;
reade codProv facturas;
dow not %eof(facturas);
  procesarFactura();
  reade codProv facturas;
enddo;

// SETGT — Posicionar después de una clave
setgt idBuscado clientes;
readp clientes;  // Lee el registro anterior

// WRITE — Agregar un registro
nombre = 'Nuevo Cliente';
email = 'nuevo@email.com';
saldo = 0;
write clirec;

// UPDATE — Actualizar registro actual (después de CHAIN o READ)
chain idBuscado clientes;
if %found(clientes);
  saldo += 5000;
  update clirec;
endif;

// DELETE — Eliminar registro
chain idBuscado clientes;
if %found(clientes);
  delete clirec;
endif;

// DELETE directo por clave (sin CHAIN previo)
delete idBuscado clientes;

monitor;
  // Código que podría fallar
  chain clienteId clientes;
  if %found(clientes);
    saldo = saldo / divisor;   // podría ser división por cero
    update clirec;
  endif;

on-error 00102;
  // Error de string (MCH1202 - conversión inválida)
  enviarMensaje('Error de conversión de datos');

on-error 00101;
  // División por cero
  enviarMensaje('Error: división por cero');

on-error *file;
  // Cualquier error de archivo (locked, not found, etc.)
  enviarMensaje('Error accediendo al archivo');

on-error *all;
  // Cualquier otro error no capturado arriba
  enviarMensaje('Error inesperado: ' + %char(%status));

endmon;

**free
// ---------------------------------------------------------------
// GESTCLI: Programa de gestión de clientes (CRUD)
// ---------------------------------------------------------------
ctl-opt dftactgrp(*no) actgrp(*caller);
ctl-opt option(*srcstmt : *nodebugio);

// ---------------------------------------------------------------
// Archivos
// ---------------------------------------------------------------
dcl-f clientes disk usage(*input : *update : *delete : *output)
                    keyed;

// ---------------------------------------------------------------
// Interfaz del programa
// ---------------------------------------------------------------
dcl-pi *n;
  prmAccion   char(10);       // ALTA, BAJA, MODIF, CONS
  prmId       packed(7:0);
  prmNombre   varchar(100);
  prmEmail    varchar(200);
  prmResultado char(1);       // S=ok, N=error
end-pi;

// ---------------------------------------------------------------
// Lógica principal
// ---------------------------------------------------------------
prmResultado = 'N';

select;
  when prmAccion = 'ALTA';
    prmResultado = altaCliente(prmId : prmNombre : prmEmail);

  when prmAccion = 'BAJA';
    prmResultado = bajaCliente(prmId);

  when prmAccion = 'MODIF';
    prmResultado = modifCliente(prmId : prmNombre : prmEmail);

  when prmAccion = 'CONS';
    prmResultado = consCliente(prmId : prmNombre : prmEmail);

  other;
    prmResultado = 'N';
endsl;

*inlr = *on;
return;

// ---------------------------------------------------------------
// Subprocedimiento: Alta de cliente
// ---------------------------------------------------------------
dcl-proc altaCliente;
  dcl-pi *n char(1);
    id      packed(7:0) const;
    nombre  varchar(100) const;
    email   varchar(200) const;
  end-pi;

  monitor;
    cliId  = id;
    cliNom = nombre;
    cliMail = email;
    cliSaldo = 0;
    cliActivo = 'A';
    write clirec;
    return 'S';
  on-error *all;
    return 'N';
  endmon;
end-proc;

// ---------------------------------------------------------------
// Subprocedimiento: Baja de cliente
// ---------------------------------------------------------------
dcl-proc bajaCliente;
  dcl-pi *n char(1);
    id packed(7:0) const;
  end-pi;

  chain id clientes;
  if %found(clientes);
    delete clirec;
    return 'S';
  endif;
  return 'N';
end-proc;

// ---------------------------------------------------------------
// Subprocedimiento: Modificación
// ---------------------------------------------------------------
dcl-proc modifCliente;
  dcl-pi *n char(1);
    id      packed(7:0) const;
    nombre  varchar(100) const;
    email   varchar(200) const;
  end-pi;

  chain id clientes;
  if %found(clientes);
    cliNom = nombre;
    cliMail = email;
    update clirec;
    return 'S';
  endif;
  return 'N';
end-proc;

// ---------------------------------------------------------------
// Subprocedimiento: Consulta
// ---------------------------------------------------------------
dcl-proc consCliente;
  dcl-pi *n char(1);
    id      packed(7:0) const;
    nombre  varchar(100);
    email   varchar(200);
  end-pi;

  chain id clientes;
  if %found(clientes);
    nombre = cliNom;
    email = cliMail;
    return 'S';
  endif;
  return 'N';
end-proc;

// Opción 1: CRTBNDRPG — Compilar y enlazar en un paso
// Crea un programa *PGM directamente
CRTBNDRPG PGM(MILIB/GESTCLI)
          SRCFILE(MILIB/QRPGLESRC)
          SRCMBR(GESTCLI)
          DBGVIEW(*SOURCE)
          OPTION(*SRCSTMT *NODEBUGIO)
          TGTRLS(*CURRENT)

// Opción 2: CRTRPGMOD + CRTPGM — Compilar en dos pasos
// Primero crear el módulo *MODULE
CRTRPGMOD MODULE(MILIB/GESTCLI)
          SRCFILE(MILIB/QRPGLESRC)
          SRCMBR(GESTCLI)
          DBGVIEW(*SOURCE)

// Luego enlazar en un programa *PGM
CRTPGM PGM(MILIB/GESTCLI)
       MODULE(MILIB/GESTCLI)
       ACTGRP(*CALLER)

// Opción 3: Desde IFS con CRTBNDRPG
CRTBNDRPG PGM(MILIB/GESTCLI)
          SRCSTMF('/home/dev/src/gestcli.rpgle')
          DBGVIEW(*SOURCE)