{
-----------------------------------------------------------------------------
MODULO   : CPPRMT001_ECF
OBJETIVO : Compra electronica e-CF 41 (Comprobante de Compras) desde
           cpprmt001 (Facturas de proveedores).
           - Boton "Compra Electronica": trae el proximo e-NCF 41 del rango
             (vetb00071/vetb00073, tipo_doc 'FT', codigo_dgii '41') y abre la
             ventana cpfmwd041 donde se digita el NETO, el % de ISR, el tipo
             de retencion ISR (606) y si lleva ITBIS. El resto se calcula solo:
                subtotal       = neto / (1 - %ISR)
                ISR retenido   = subtotal - neto
                ITBIS (18%)    = subtotal * 18%      (si lleva ITBIS)
                ITBIS retenido = 100% del ITBIS
                total          = subtotal + ITBIS
           - El e-NCF se RESERVA al grabar (dentro de la transaccion), asi no
             se pierden secuencias si cancelan.
           - La retencion de ISR de la distribucion contable debe estar en una
             cuenta marcada como retencion en el catalogo (cgtb00001.retencion).
           - Al grabar: guarda el rastreo en cptb00041 y envia el XML del 41.
FECHA    : Octubre 2026
-----------------------------------------------------------------------------
}
IMPORT util
GLOBALS "cpprgb000.4gl"

DEFINE wcp om.SaxDocumentHandler

-- estado de la compra electronica en curso
DEFINE e41 RECORD
    activo      BOOLEAN,
    ncf41       VARCHAR(13),
    nom41       VARCHAR(90),
    rnc41       VARCHAR(11),
    neto41      DECIMAL(12,2),
    porc41      DECIMAL(5,2),
    cisr41      SMALLINT,
    itbis41     CHAR(1),
    bs41        CHAR(1),
    sub41       DECIMAL(12,2),
    itb41       DECIMAL(12,2),
    isr41       DECIMAL(12,2),
    itbret41    DECIMAL(12,2),
    total41     DECIMAL(12,2)
END RECORD

#-----------------------------------------------------------------------------
FUNCTION e41_reset()
    INITIALIZE e41.* TO NULL
    LET e41.activo = FALSE
END FUNCTION

FUNCTION e41_activo() RETURNS BOOLEAN
    RETURN NVL(e41.activo, FALSE)
END FUNCTION

FUNCTION e41_ncf() RETURNS VARCHAR(13)
    RETURN e41.ncf41
END FUNCTION

FUNCTION e41_neto() RETURNS DECIMAL(12,2)
    RETURN e41.neto41
END FUNCTION

FUNCTION e41_itbis() RETURNS DECIMAL(12,2)
    RETURN e41.itb41
END FUNCTION

FUNCTION e41_isr() RETURNS DECIMAL(12,2)
    RETURN NVL(e41.isr41, 0)
END FUNCTION

#-----------------------------------------------------------------------------
# % de ISR permitidos: 0 = exento, 3 = servicios tecnicos,
# 15 = honorarios / profesionales / alquileres
#-----------------------------------------------------------------------------
FUNCTION porc_isr_valido41(pporc)
    DEFINE pporc DECIMAL(5,2)

    IF pporc IS NULL THEN
       RETURN FALSE
    END IF
    RETURN (pporc = 0 OR pporc = 3 OR pporc = 15)
END FUNCTION

#-----------------------------------------------------------------------------
# Calcula los montos del 41 a partir del neto (lo que recibe el proveedor).
# El ISR se saca por diferencia para que el neto cuadre exacto al centavo.
#-----------------------------------------------------------------------------
FUNCTION calcula41(pneto, pporc_isr, plleva_itbis)
    DEFINE pneto DECIMAL(12,2),
           pporc_isr DECIMAL(5,2),
           plleva_itbis CHAR(1),
           xsubtotal, xitbis, xisr, xitbis_ret, xtotal DECIMAL(12,2)

    LET pneto = NVL(pneto, 0)
    LET pporc_isr = NVL(pporc_isr, 0)

    LET xsubtotal = pneto / (1 - pporc_isr / 100)     -- se redondea a 2 decimales
    LET xisr = xsubtotal - pneto
    IF plleva_itbis = 'S' THEN
       LET xitbis = xsubtotal * 18 / 100
    ELSE
       LET xitbis = 0
    END IF
    LET xitbis_ret = xitbis                            -- se retiene el 100%
    LET xtotal = xsubtotal + xitbis

    RETURN xsubtotal, xitbis, xisr, xitbis_ret, xtotal
END FUNCTION

#-----------------------------------------------------------------------------
# Deja solo los digitos (cedula/RNC sin guiones ni espacios)
#-----------------------------------------------------------------------------
FUNCTION e41_solo_digitos(ptexto)
    DEFINE ptexto, xres STRING,
           i INT

    LET xres = ""
    FOR i = 1 TO ptexto.getLength()
        IF ptexto.getCharAt(i) MATCHES "[0-9]" THEN
           LET xres = xres.append(ptexto.getCharAt(i))
        END IF
    END FOR
    IF xres.getLength() = 0 THEN
       RETURN NULL
    END IF
    RETURN xres
END FUNCTION

#-----------------------------------------------------------------------------
# Proximo e-NCF 41 SIN reservarlo (solo para mostrarlo).
# Retorna NULL si no hay rango o se agoto.
#-----------------------------------------------------------------------------
FUNCTION e41_proximo_ncf() RETURNS VARCHAR(13)
    DEFINE xinicial, xfinal, xult, xnuevo INT

    SELECT MIN(a.ncf_inicial), MAX(a.ncf_final) INTO xinicial, xfinal
      FROM vetb00071 a
     WHERE a.tipo_doc = 'FT' AND a.codigo_dgii = '41' AND a.disponible = 'S'
    IF xfinal IS NULL THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA",
            "No hay rango disponible para el e-NCF 41 (vetb00071 tipo_doc FT, codigo 41).\nLlame a finanzas.","stop")
       RETURN NULL
    END IF

    SELECT MAX(a.ncf) INTO xult FROM vetb00073 a
     WHERE a.tipo_doc = 'FT' AND a.codigo_dgii = '41'
    IF xult IS NULL OR xult < NVL(xinicial, 1) - 1 THEN
       LET xult = NVL(xinicial, 1) - 1
    END IF
    LET xnuevo = xult + 1
    IF xnuevo > xfinal THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA","Se agoto el rango del e-NCF 41. Llame a finanzas.","stop")
       RETURN NULL
    END IF
    RETURN "E41" || (xnuevo USING "&&&&&&&&&&")
END FUNCTION

#-----------------------------------------------------------------------------
# Reserva el e-NCF 41 (se llama DENTRO de la transaccion de grabado).
# Si vetb00073 no tiene la fila FT/41 la crea desde ncf_inicial.
# Retorna NULL si no hay rango o se agoto.
#-----------------------------------------------------------------------------
FUNCTION e41_reserva_ncf() RETURNS VARCHAR(13)
    DEFINE xinicial, xfinal, xnuevo INT

    SELECT MIN(a.ncf_inicial), MAX(a.ncf_final) INTO xinicial, xfinal
      FROM vetb00071 a
     WHERE a.tipo_doc = 'FT' AND a.codigo_dgii = '41' AND a.disponible = 'S'
    IF xfinal IS NULL THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA","No hay rango disponible para el e-NCF 41.","stop")
       RETURN NULL
    END IF

    UPDATE vetb00073 SET ncf = ncf + 1, us_crea = usuarios, fech_crea = getdate()
     WHERE tipo_doc = 'FT' AND codigo_dgii = '41'
    IF STATUS < 0 THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA","Error reservando el e-NCF 41: "||SQLCA.sqlcode,"stop")
       RETURN NULL
    END IF
    IF SQLCA.sqlerrd[3] = 0 THEN
       LET xnuevo = NVL(xinicial, 1)
       INSERT INTO vetb00073 (codigo_dgii, tipo_doc, ncf, sucid, us_crea, fech_crea)
            VALUES ('41', 'FT', xnuevo, 1, usuarios, getdate())
       IF STATUS < 0 THEN
          CALL fgl_winmessage("COMPRA ELECTRONICA","Error creando el contador del e-NCF 41: "||SQLCA.sqlcode,"stop")
          RETURN NULL
       END IF
    ELSE
       SELECT MAX(a.ncf) INTO xnuevo FROM vetb00073 a
        WHERE a.tipo_doc = 'FT' AND a.codigo_dgii = '41'
    END IF

    IF xnuevo > xfinal THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA","Se agoto el rango del e-NCF 41. Llame a finanzas.","stop")
       RETURN NULL
    END IF
    LET e41.ncf41 = "E41" || (xnuevo USING "&&&&&&&&&&")
    RETURN e41.ncf41
END FUNCTION

#-----------------------------------------------------------------------------
# TRUE si la cuenta esta marcada como retencion en el catalogo.
# Si tiene codigo de ISR y en la ventana no se escogio, se toma de la cuenta.
#-----------------------------------------------------------------------------
FUNCTION e41_cuenta_isr(pcuenta)
    DEFINE pcuenta CHAR(8),
           xret CHAR(2),
           xcod SMALLINT

    LET xret = NULL
    LET xcod = NULL
    SELECT a.retencion, a.codigo_isr INTO xret, xcod
      FROM cgtb00001 a
     WHERE a.cuenta_no = pcuenta
    IF xret IS NULL OR UPSHIFT(xret) <> "SI" THEN
       RETURN FALSE
    END IF
    IF e41.cisr41 IS NULL AND xcod IS NOT NULL THEN
       LET e41.cisr41 = xcod
    END IF
    RETURN TRUE
END FUNCTION

#-----------------------------------------------------------------------------
# Llena el combo de tipos de retencion ISR (cgtb00077) de la ventana del 41
#-----------------------------------------------------------------------------
FUNCTION e41_carga_cisr()
    DEFINE cb ui.ComboBox,
           xcod SMALLINT,
           xdes CHAR(50)

    LET cb = ui.ComboBox.forName("formonly.cisr41")
    IF cb IS NULL THEN
       RETURN
    END IF
    CALL cb.clear()
    DECLARE c_cisr41 CURSOR FOR
       SELECT a.codigo_isr, a.descripcion FROM cgtb00077 a ORDER BY a.codigo_isr
    FOREACH c_cisr41 INTO xcod, xdes
       CALL cb.addItem(xcod, (xcod USING "<&") || " - " || xdes CLIPPED)
    END FOREACH
END FUNCTION

#-----------------------------------------------------------------------------
FUNCTION e41_recalcula()
    CALL calcula41(e41.neto41, e41.porc41, e41.itbis41)
         RETURNING e41.sub41, e41.itb41, e41.isr41, e41.itbret41, e41.total41
    DISPLAY e41.sub41, e41.itb41, e41.isr41, e41.itbret41, e41.total41
         TO sub41, itb41, isr41, itbret41, total41
END FUNCTION

#-----------------------------------------------------------------------------
# Boton "Compra Electronica": valida el suplidor, muestra el proximo e-NCF
# y captura neto / % ISR / tipo ISR / ITBIS. Retorna TRUE si se acepto.
#-----------------------------------------------------------------------------
FUNCTION e41_captura(pcod_sp, pcod_sp_sec)
    DEFINE pcod_sp, pcod_sp_sec SMALLINT,
           xnom VARCHAR(90),
           xrnc STRING,
           xproximo VARCHAR(13),
           xcodigo SMALLINT

    -- tipo fiscal 41 en la lista de tipos NCF
    LET xcodigo = NULL
    SELECT a.codigo_fiscal INTO xcodigo FROM cgtb00074 a WHERE a.codigo_fiscal = 41
    IF xcodigo IS NULL THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA",
            "No existe el tipo NCF 41 en cgtb00074. Agreguelo antes de emitir.","stop")
       RETURN FALSE
    END IF

    -- el proveedor va en el bloque Comprador: cedula (11) o RNC (9) obligatorio
    SELECT a.nom_sp, a.rnc INTO xnom, xrnc FROM cotb00001 a
     WHERE a.cod_sp = pcod_sp AND a.cod_sp_sec = pcod_sp_sec
    LET xrnc = e41_solo_digitos(xrnc)
    IF xrnc IS NULL OR (xrnc.getLength() <> 9 AND xrnc.getLength() <> 11) THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA",
            "El suplidor "||pcod_sp||"-"||pcod_sp_sec||" no tiene cedula (11) o RNC (9) valido en el maestro de suplidores.\nCorrijalo antes de emitir el 41.","stop")
       RETURN FALSE
    END IF

    LET xproximo = e41_proximo_ncf()
    IF xproximo IS NULL THEN
       RETURN FALSE
    END IF

    -- valores por defecto (si ya se habia capturado, se conservan)
    IF NOT NVL(e41.activo, FALSE) THEN
       INITIALIZE e41.* TO NULL
       LET e41.porc41 = 3
       LET e41.cisr41 = 3
       LET e41.itbis41 = 'S'
       LET e41.bs41 = '2'
    END IF
    LET e41.ncf41 = xproximo
    LET e41.nom41 = xnom CLIPPED
    LET e41.rnc41 = xrnc

    OPEN WINDOW w_e41 WITH FORM "cpfmwd041"
         ATTRIBUTES(STYLE="dialog", TEXT="Compra electronica (e-CF 41)")
    CALL e41_carga_cisr()
    LET int_flag = FALSE

    INPUT BY NAME e41.neto41, e41.porc41, e41.cisr41, e41.itbis41, e41.bs41
          WITHOUT DEFAULTS ATTRIBUTES(UNBUFFERED)
       BEFORE INPUT
          DISPLAY e41.ncf41, e41.nom41, e41.rnc41 TO ncf41, nom41, rnc41
          CALL e41_recalcula()

       ON CHANGE porc41
          -- tipo de retencion sugerido segun el %
          CASE e41.porc41
             WHEN 3  LET e41.cisr41 = 3      -- otras rentas (servicios tecnicos)
             WHEN 15 LET e41.cisr41 = 2      -- honorarios (alquiler = 1, escoger a mano)
             WHEN 0  LET e41.cisr41 = NULL
          END CASE
          CALL e41_recalcula()

       ON CHANGE itbis41
          CALL e41_recalcula()

       AFTER FIELD neto41
          CALL e41_recalcula()

       AFTER INPUT
          IF NOT int_flag THEN
             IF e41.neto41 IS NULL OR e41.neto41 <= 0 THEN
                CALL fgl_winmessage("COMPRA ELECTRONICA","Digite el neto a pagar.","exclamation")
                NEXT FIELD neto41
             END IF
             IF NOT porc_isr_valido41(e41.porc41) THEN
                CALL fgl_winmessage("COMPRA ELECTRONICA","El % de ISR debe ser 0, 3 o 15.","exclamation")
                NEXT FIELD porc41
             END IF
             IF e41.porc41 > 0 AND e41.cisr41 IS NULL THEN
                CALL fgl_winmessage("COMPRA ELECTRONICA","Escoja el tipo de retencion ISR (formato 606).","exclamation")
                NEXT FIELD cisr41
             END IF
             CALL e41_recalcula()
          END IF
    END INPUT

    CLOSE WINDOW w_e41
    IF int_flag THEN
       LET int_flag = FALSE
       RETURN FALSE
    END IF
    LET e41.activo = TRUE
    RETURN TRUE
END FUNCTION

#-----------------------------------------------------------------------------
# Guarda el 41 en cptb00041 (dentro de la transaccion de grabado)
#-----------------------------------------------------------------------------
FUNCTION e41_guarda(pcod_sp, pcod_sp_sec, pnum_doc, pfecha)
    DEFINE pcod_sp, pcod_sp_sec SMALLINT,
           pnum_doc CHAR(13),
           pfecha DATE

    INSERT INTO cptb00041 (cod_sp, cod_sp_sec, num_doc, ncf, fecha, rnc, neto, porc_isr,
                           codigo_isr, lleva_itbis, bien_servicio, subtotal, itbis,
                           isr_retenido, itbis_retenido, total, us_crea, fech_crea)
         VALUES (pcod_sp, pcod_sp_sec, pnum_doc, e41.ncf41, pfecha, e41.rnc41, e41.neto41,
                 e41.porc41, e41.cisr41, e41.itbis41, e41.bs41, e41.sub41, e41.itb41,
                 e41.isr41, e41.itbret41, e41.total41, usuarios, getdate())
    IF STATUS < 0 THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA","Error guardando el e-CF 41 (cptb00041): "||SQLCA.sqlcode,"stop")
       RETURN FALSE
    END IF
    RETURN TRUE
END FUNCTION

#-----------------------------------------------------------------------------
# Arma y envia el XML del 41 a la DGII (despues del COMMIT) y guarda la
# respuesta en cptb00041. Muestra el estado al usuario.
#-----------------------------------------------------------------------------
FUNCTION e41_envia(pcod_sp, pcod_sp_sec, pnum_doc, pfecha_orig, pfecha_proc, pdetalle)
    DEFINE pcod_sp, pcod_sp_sec SMALLINT,
           pnum_doc CHAR(13),
           pfecha_orig, pfecha_proc DATE,
           pdetalle CHAR(30)

    DEFINE documento_encabezado RECORD
        tipoEcf, eNcf, indicadorMontoGravado, tipoPago, fechaLimitePago, FormadePAgo, montoPago, FechaVencimientoSecuencia,
        rncEmisor, razonSocialEmisor, direccionEmisor, Municipio, Provincia, telefonoEmisor,
        correoEmisor, webSite, codigoVendedor, numeroFacturaInterna, numeroPedidoInterno,
        fechaEmision, rncComprador, razonSocialComprador, montoGravadoTotal, montoGravadoI1,
        montoGravadoI2, montoGravadoI3, montoExento, itbis1, itbis2, itbis3, totalItbis, totalItbis1,
        totalItbis2, totalItbis3, montoTotal, tipoIngreso, terminoPago, TipoCuentaPago, NumeroCuentaPago, IdentificadorExtranjero,
        contactoComprador, CorreoComprador, DireccionComprador, MunicipioComprador, ProvinciaComprador, FechaEntrega, FechaOrdenCompra,
        NumeroOrdenCompra, CodigoInternoComprador,
        nombreFile, IndicadorNotaCredito, NCFmodificado, codigoModificacion, fechaNCFmodificado     STRING
    END RECORD,
        documento_Detalle DYNAMIC ARRAY OF RECORD
            indicadorFacturacion, nombreItem, indicadorBienoServicio, cantidadItem, precioUnitarioItem,
            montoItem STRING,
            DescripcionItem VARCHAR(1000),
            NumeroLinea INT
        END RECORD,
        ret41 DYNAMIC ARRAY OF RECORD
            itbisRetenido DECIMAL(12,2),
            isrRetenido   DECIMAL(12,2)
        END RECORD

    DEFINE xrnc, xnombre, xdireccion VARCHAR(150),
           xprov, xmuni VARCHAR(20),
           xvence DATE,
           xamb STRING,
           phash, respuesta, xrespuesta, codigo, xhash STRING,
           fechafirma DATETIME YEAR TO SECOND,
           mensaje_trunc VARCHAR(2000),
           idx INT

    DEFINE Pok RECORD
        trackId, ERROR, mensaje STRING
    END RECORD
    DEFINE p RECORD
        trackid STRING,
        codigo, estado, rnc, encf, secuenciaUtilizada, fechaRecepcion STRING,
        mensajes DYNAMIC ARRAY OF RECORD
            valor, codigo STRING
        END RECORD
    END RECORD

    -- emisor
    SELECT a.rnc, a.nombre, a.direccion, a.id_dgii, a.id_municipio_dgii
      INTO xrnc, xnombre, xdireccion, xprov, xmuni
      FROM companias a
    SELECT MAX(a.fecha_vencimiento) INTO xvence FROM vetb00071 a
     WHERE a.tipo_doc = 'FT' AND a.codigo_dgii = '41'

    LET documento_encabezado.tipoEcf = "41"
    LET documento_encabezado.eNcf = e41.ncf41
    LET documento_encabezado.nombreFile = xrnc CLIPPED, e41.ncf41 CLIPPED, ".xml"
    LET documento_encabezado.FechaVencimientoSecuencia = xvence USING "dd-mm-yyyy"
    LET documento_encabezado.rncEmisor = xrnc CLIPPED
    LET documento_encabezado.razonSocialEmisor = xnombre CLIPPED
    LET documento_encabezado.direccionEmisor = xdireccion CLIPPED
    LET documento_encabezado.Provincia = xprov CLIPPED
    LET documento_encabezado.Municipio = xmuni CLIPPED
    LET documento_encabezado.fechaEmision = pfecha_orig USING "dd-mm-yyyy"
    -- va a cuentas por pagar: credito, vence en la fecha de proceso
    LET documento_encabezado.tipoPago = '2'
    LET documento_encabezado.fechaLimitePago = NVL(pfecha_proc, pfecha_orig) USING "dd-mm-yyyy"
    LET documento_encabezado.FormadePAgo = '4'
    -- Comprador = el proveedor
    LET documento_encabezado.rncComprador = e41.rnc41
    LET documento_encabezado.razonSocialComprador = e41.nom41
    -- precios SIN ITBIS
    LET documento_encabezado.indicadorMontoGravado = '0'
    IF NVL(e41.itb41, 0) > 0 THEN
       LET documento_encabezado.montoGravadoTotal = e41.sub41 USING "<<<<<<<<<<<<<&.&&"
       LET documento_encabezado.montoGravadoI1 = e41.sub41 USING "<<<<<<<<<<<<<&.&&"
       LET documento_encabezado.itbis1 = '18'
       LET documento_encabezado.totalItbis = e41.itb41 USING "<<<<<<<<<<<<<&.&&"
       LET documento_encabezado.totalItbis1 = e41.itb41 USING "<<<<<<<<<<<<<&.&&"
    ELSE
       LET documento_encabezado.montoExento = e41.sub41 USING "<<<<<<<<<<<<<&.&&"
    END IF
    LET documento_encabezado.montoTotal = e41.total41 USING "<<<<<<<<<<<<<&.&&"
    LET documento_encabezado.montoPago = documento_encabezado.montoTotal

    -- una linea con el concepto de la factura
    IF NVL(e41.itb41, 0) > 0 THEN
       LET documento_Detalle[1].indicadorFacturacion = 1
    ELSE
       LET documento_Detalle[1].indicadorFacturacion = 4
    END IF
    LET documento_Detalle[1].nombreItem = NVL(pdetalle CLIPPED, "COMPRA A PROVEEDOR INFORMAL")
    LET documento_Detalle[1].indicadorBienoServicio = NVL(e41.bs41, '2')
    LET documento_Detalle[1].cantidadItem = "1.00"
    LET documento_Detalle[1].precioUnitarioItem = e41.sub41 USING "<<<<<<<<<<<<<&.&&"
    LET documento_Detalle[1].montoItem = e41.sub41 USING "<<<<<<<<<<<<<&.&&"
    LET ret41[1].itbisRetenido = NVL(e41.itbret41, 0)
    LET ret41[1].isrRetenido = NVL(e41.isr41, 0)

    CALL generafile41(documento_encabezado.*, documento_Detalle, ret41, 1, 1, 'adicionar')
         RETURNING phash, respuesta, fechafirma, codigo

    LET mensaje_trunc = respuesta
    UPDATE cptb00041 SET hash = phash, ultima_respuesta = respuesta, fechafirmadigital = fechafirma
     WHERE cod_sp = pcod_sp AND cod_sp_sec = pcod_sp_sec AND num_doc = pnum_doc

    -- respuesta del envio
    IF codigo = '200' THEN
       TRY
          CALL util.JSON.parse(respuesta, Pok)
       CATCH
          LET Pok.trackId = NULL
          LET Pok.mensaje = 'ERROR EN PARSE'
       END TRY
    ELSE
       LET Pok.trackId = NULL
       LET Pok.mensaje = respuesta
    END IF

    -- estado en la DGII
    LET p.estado = NULL
    LET p.trackid = NULL
    CALL p.mensajes.clear()
    IF codigo = '200' THEN
       LET xamb = ambiente()
       CALL procesoEncf(' ', xamb.trim(), ' ', 0, 0, 'consultatrackid', respuesta)
            RETURNING xhash, xrespuesta, codigo
       TRY
          CALL util.JSON.parse(xrespuesta, p)
       CATCH
          LET p.estado = 'SIN CONEXION'
          LET p.mensajes[1].valor = 'NO SE PUDO CONSULTAR EL ESTADO EN LA DGII'
       END TRY
    END IF
    IF p.estado = ' ' OR p.estado IS NULL THEN
       LET p.estado = 'ERROR'
    END IF
    IF p.trackid IS NULL THEN
       LET p.trackid = Pok.trackId
    END IF
    LET mensaje_trunc = NVL(Pok.mensaje, mensaje_trunc)
    IF p.mensajes.getLength() > 0 THEN
       LET mensaje_trunc = NULL
       FOR idx = 1 TO p.mensajes.getLength()
          IF p.mensajes[idx].valor IS NOT NULL THEN
             IF mensaje_trunc IS NULL THEN
                LET mensaje_trunc = p.mensajes[idx].valor
             ELSE
                LET mensaje_trunc = mensaje_trunc CLIPPED, " | ", p.mensajes[idx].valor
             END IF
          END IF
       END FOR
    END IF
    UPDATE cptb00041 SET trackid = p.trackid, estado_dgii = p.estado, mensaje = mensaje_trunc
     WHERE cod_sp = pcod_sp AND cod_sp_sec = pcod_sp_sec AND num_doc = pnum_doc

    IF UPSHIFT(p.estado) MATCHES "*RECHAZ*" THEN
       CALL fgl_winmessage("COMPRA ELECTRONICA RECHAZADA POR LA DGII",
            "e-NCF "||e41.ncf41 CLIPPED||"\n\nMotivo: "||NVL(mensaje_trunc,"(sin mensaje)"),"stop")
    ELSE
       CALL fgl_winmessage("COMPRA ELECTRONICA",
            "e-NCF "||e41.ncf41 CLIPPED||"\nEstado DGII: "||p.estado||"\n"||NVL(mensaje_trunc,""),"info")
    END IF
END FUNCTION

#-----------------------------------------------------------------------------
# e-CF 41 COMPRAS: la empresa le compra a una persona sin RNC / sin NCF.
# Diferencias con el 43:
#   - Lleva bloque Comprador = datos del PROVEEDOR (cedula y nombre),
#     se pasan en documento_encabezado.rncComprador / razonSocialComprador.
#   - Puede llevar ITBIS (IndicadorFacturacion 1/2/3 por linea, 4 = exento).
#   - Lleva retenciones por linea y totales (ITBIS retenido e ISR retenido).
# ret41 va alineado por indice con documento_Detalle (linea k <-> ret41[k]).
# Los totales gravado/exento/ITBIS se toman de documento_encabezado tal como
# cpprmt006 ya los llena para generafile. MontoTotal = antes de retenciones.
# Confirmar orden/obligatoriedad de tags contra el XSD e-CF 41 en TesteCF.
#-----------------------------------------------------------------------------
FUNCTION generafile41(documento_encabezado, documento_Detalle, ret41, xsucid, xbodega, xoperacion)

    DEFINE documento_encabezado RECORD
        tipoEcf, eNcf, indicadorMontoGravado, tipoPago, fechaLimitePago, FormadePAgo, montoPago, FechaVencimientoSecuencia,
        rncEmisor, razonSocialEmisor, direccionEmisor, Municipio, Provincia, telefonoEmisor,
        correoEmisor, webSite, codigoVendedor, numeroFacturaInterna, numeroPedidoInterno,
        fechaEmision, rncComprador, razonSocialComprador, montoGravadoTotal, montoGravadoI1,
        montoGravadoI2, montoGravadoI3, montoExento, itbis1, itbis2, itbis3, totalItbis, totalItbis1,
        totalItbis2, totalItbis3, montoTotal, tipoIngreso, terminoPago, TipoCuentaPago, NumeroCuentaPago, IdentificadorExtranjero,
        contactoComprador, CorreoComprador, DireccionComprador, MunicipioComprador, ProvinciaComprador, FechaEntrega, FechaOrdenCompra,
        NumeroOrdenCompra, CodigoInternoComprador,
        nombreFile, IndicadorNotaCredito, NCFmodificado, codigoModificacion, fechaNCFmodificado     STRING
    END RECORD,
        documento_Detalle DYNAMIC ARRAY OF RECORD
            indicadorFacturacion, nombreItem, indicadorBienoServicio, cantidadItem, precioUnitarioItem,
            montoItem STRING,
            DescripcionItem VARCHAR(1000),
            NumeroLinea INT
        END RECORD,
        ret41 DYNAMIC ARRAY OF RECORD
            itbisRetenido DECIMAL(12,2),
            isrRetenido   DECIMAL(12,2)
        END RECORD,
        xoperacion VARCHAR(30),
        xsucid, xbodega INT

    DEFINE archivo, respuesta, codigo, phash, chFirma STRING,
           a om.SaxAttributes,
           fechaFirma DATETIME YEAR TO SECOND,
           k, linea INTEGER,
           itbisRet, isrRet, totItbisRet, totIsrRet DECIMAL(14,2),
           xamb STRING

    -- En el 41 el proveedor (cedula y nombre) es obligatorio
    IF documento_encabezado.rncComprador IS NULL
        OR documento_encabezado.razonSocialComprador IS NULL THEN
        RETURN NULL, "El 41 requiere cedula y nombre del proveedor", NULL, "0"
    END IF

    LET archivo = fgl_getenv("RUTA_XML_ORIGINALES"), documento_encabezado.nombreFile
    TRY
        LET wcp = om.XmlWriter.createFileWriter(archivo)
    CATCH
        RETURN NULL, "No se pudo crear el XML del 41 (RUTA_XML_ORIGINALES)", NULL, "0"
    END TRY
    IF wcp IS NULL THEN
        RETURN NULL, "No se pudo crear el XML del 41 (RUTA_XML_ORIGINALES)", NULL, "0"
    END IF

    LET a = om.SaxAttributes.create()
    CALL wcp.startDocument()
    CALL a.addAttribute("xmlns:xs", "http://www.w3.org/2001/XMLSchema")
    CALL wcp.startElement("ECF", a)
    CALL a.clear()

    #-------------------- Encabezado --------------------
    CALL wcp.startElement("Encabezado", NULL)
    CALL tagcp("Version", "1.0")

    -- IdDoc (el 41 NO lleva TipoIngresos)
    CALL wcp.startElement("IdDoc", NULL)
    CALL tagcp("TipoeCF", "41")
    CALL tagcp("eNCF", documento_encabezado.eNcf CLIPPED)
    IF documento_encabezado.FechaVencimientoSecuencia IS NOT NULL THEN
        CALL tagcp("FechaVencimientoSecuencia", documento_encabezado.FechaVencimientoSecuencia)
    END IF
    IF montocp(documento_encabezado.montoGravadoTotal) > 0 THEN
        CALL tagcp("IndicadorMontoGravado", NVL(documento_encabezado.indicadorMontoGravado, "0"))
    END IF
    CALL tagcp("TipoPago", NVL(documento_encabezado.tipoPago, "1"))
    IF documento_encabezado.tipoPago = "2" AND documento_encabezado.fechaLimitePago IS NOT NULL THEN
        CALL tagcp("FechaLimitePago", documento_encabezado.fechaLimitePago)
    END IF
    CALL wcp.startElement("TablaFormasPago", NULL)
    CALL wcp.startElement("FormaDePago", NULL)
    CALL tagcp("FormaPago", NVL(documento_encabezado.FormadePAgo, "1"))
    CALL tagcp("MontoPago", documento_encabezado.montoTotal)
    CALL wcp.endElement("FormaDePago")
    CALL wcp.endElement("TablaFormasPago")
    CALL wcp.endElement("IdDoc")

    -- Emisor (igual que el 43)
    CALL wcp.startElement("Emisor", NULL)
    CALL tagcp("RNCEmisor", documento_encabezado.rncEmisor)
    CALL tagcp("RazonSocialEmisor", cortacp(documento_encabezado.razonSocialEmisor, 150))
    CALL tagcp("NombreComercial", cortacp(documento_encabezado.razonSocialEmisor, 150))
    CALL tagcp("DireccionEmisor", cortacp(documento_encabezado.direccionEmisor, 100))
    IF codigo6cp(documento_encabezado.Municipio) IS NOT NULL THEN
        CALL tagcp("Municipio", codigo6cp(documento_encabezado.Municipio))
    END IF
    IF codigo6cp(documento_encabezado.Provincia) IS NOT NULL THEN
        CALL tagcp("Provincia", codigo6cp(documento_encabezado.Provincia))
    END IF
    IF documento_encabezado.correoEmisor IS NOT NULL THEN
        CALL tagcp("CorreoEmisor", documento_encabezado.correoEmisor)
    END IF
    IF documento_encabezado.numeroFacturaInterna IS NOT NULL THEN
        CALL tagcp("NumeroFacturaInterna", documento_encabezado.numeroFacturaInterna)
    END IF
    CALL tagcp("FechaEmision", documento_encabezado.fechaEmision)
    CALL wcp.endElement("Emisor")

    -- Comprador = el PROVEEDOR al que se le compra
    CALL wcp.startElement("Comprador", NULL)
    CALL tagcp("RNCComprador", documento_encabezado.rncComprador CLIPPED)
    CALL tagcp("RazonSocialComprador", cortacp(documento_encabezado.razonSocialComprador, 150))
    CALL wcp.endElement("Comprador")

    -- Totales de retencion (se suman de las lineas que se van a enviar)
    LET totItbisRet = 0
    LET totIsrRet = 0
    FOR k = 1 TO documento_Detalle.getLength()
        IF documento_Detalle[k].nombreItem IS NULL
            AND documento_Detalle[k].DescripcionItem IS NULL THEN
            CONTINUE FOR
        END IF
        IF k <= ret41.getLength() THEN
            LET totItbisRet = totItbisRet + NVL(ret41[k].itbisRetenido, 0)
            LET totIsrRet = totIsrRet + NVL(ret41[k].isrRetenido, 0)
        END IF
    END FOR

    -- Totales (solo se escriben los montos que aplican)
    CALL wcp.startElement("Totales", NULL)
    CALL tagcpmonto("MontoGravadoTotal", documento_encabezado.montoGravadoTotal)
    CALL tagcpmonto("MontoGravadoI1", documento_encabezado.montoGravadoI1)
    CALL tagcpmonto("MontoGravadoI2", documento_encabezado.montoGravadoI2)
    CALL tagcpmonto("MontoGravadoI3", documento_encabezado.montoGravadoI3)
    CALL tagcpmonto("MontoExento", documento_encabezado.montoExento)
    IF montocp(documento_encabezado.montoGravadoI1) > 0 THEN
        CALL tagcp("ITBIS1", NVL(documento_encabezado.itbis1, "18"))
    END IF
    IF montocp(documento_encabezado.montoGravadoI2) > 0 THEN
        CALL tagcp("ITBIS2", NVL(documento_encabezado.itbis2, "16"))
    END IF
    IF montocp(documento_encabezado.montoGravadoI3) > 0 THEN
        CALL tagcp("ITBIS3", "0")
    END IF
    IF montocp(documento_encabezado.montoGravadoTotal) > 0 THEN
        CALL tagcp("TotalITBIS", NVL(documento_encabezado.totalItbis, "0.00"))
        CALL tagcpmonto("TotalITBIS1", documento_encabezado.totalItbis1)
        CALL tagcpmonto("TotalITBIS2", documento_encabezado.totalItbis2)
        IF montocp(documento_encabezado.montoGravadoI3) > 0 THEN
            CALL tagcp("TotalITBIS3", "0.00")
        END IF
    END IF
    CALL tagcp("MontoTotal", documento_encabezado.montoTotal)
    CALL tagcp("TotalITBISRetenido", totItbisRet USING "<<<<<<<<<<<<&.&&")
    CALL tagcp("TotalISRRetencion", totIsrRet USING "<<<<<<<<<<<<&.&&")
    CALL wcp.endElement("Totales")

    CALL wcp.endElement("Encabezado")

    #-------------------- DetallesItems --------------------
    CALL wcp.startElement("DetallesItems", NULL)
    LET linea = 0
    FOR k = 1 TO documento_Detalle.getLength()
        IF documento_Detalle[k].nombreItem IS NULL
            AND documento_Detalle[k].DescripcionItem IS NULL THEN
            CONTINUE FOR
        END IF
        LET linea = linea + 1
        LET itbisRet = 0
        LET isrRet = 0
        IF k <= ret41.getLength() THEN
            LET itbisRet = NVL(ret41[k].itbisRetenido, 0)
            LET isrRet = NVL(ret41[k].isrRetenido, 0)
        END IF
        CALL wcp.startElement("Item", NULL)
        CALL tagcp("NumeroLinea", linea USING "<<<<")
        CALL tagcp("IndicadorFacturacion", NVL(documento_Detalle[k].indicadorFacturacion, "4"))
        -- Retencion: en el 41 la empresa actua como agente de retencion
        CALL wcp.startElement("Retencion", NULL)
        CALL tagcp("IndicadorAgenteRetencionoPercepcion", "1")
        CALL tagcp("MontoITBISRetenido", itbisRet USING "<<<<<<<<<<<<&.&&")
        CALL tagcp("MontoISRRetenido", isrRet USING "<<<<<<<<<<<<&.&&")
        CALL wcp.endElement("Retencion")
        CALL tagcp("NombreItem",
            NVL(documento_Detalle[k].nombreItem, documento_Detalle[k].DescripcionItem))
        CALL tagcp("IndicadorBienoServicio", NVL(documento_Detalle[k].indicadorBienoServicio, "2"))
        CALL tagcp("CantidadItem", NVL(documento_Detalle[k].cantidadItem, "1"))
        CALL tagcp("PrecioUnitarioItem", documento_Detalle[k].precioUnitarioItem)
        CALL tagcp("MontoItem", documento_Detalle[k].montoItem)
        CALL wcp.endElement("Item")
    END FOR
    CALL wcp.endElement("DetallesItems")

    #-------------------- Firma --------------------
    LET fechaFirma = CURRENT
    LET chFirma = util.Datetime.format(fechaFirma, "%d-%m-%Y %H:%M:%S")
    CALL tagcp("FechaHoraFirma", chFirma)

    CALL wcp.endElement("ECF")
    CALL wcp.endDocument()

    #-------------------- Firmar y enviar (igual que el 43) --------------------
    -- ambiente DGII de la empresa (companias.ambienteDgii, funcion ambiente())
    LET xamb = ambiente()
    LET xamb = xamb.trim()
    IF xamb IS NULL OR (xamb <> "test" AND xamb <> "certificacion" AND xamb <> "produccion") THEN
        RETURN NULL, "companias.ambienteDgii debe ser test, certificacion o produccion. No se envio a la DGII.", fechaFirma, "0"
    END IF
    CALL procesoEncf(archivo, xamb, "normal", xsucid, xbodega, xoperacion, ' ')
        RETURNING phash, respuesta, codigo

    RETURN phash, respuesta, fechaFirma, codigo
END FUNCTION

#-----------------------------------------------------------------------------
# Convierte un monto STRING a decimal (NULL o vacio = 0)
FUNCTION montocp(valor STRING) RETURNS DECIMAL(14,2)
    DEFINE n DECIMAL(14,2)
    LET n = NULL
    TRY
        LET n = valor
    CATCH
        LET n = NULL
    END TRY
    RETURN NVL(n, 0)
END FUNCTION

#-----------------------------------------------------------------------------
# Recorta un texto al largo maximo que permite el XSD
FUNCTION cortacp(valor STRING, largo INTEGER) RETURNS STRING
    LET valor = valor.trim()
    IF valor.getLength() > largo THEN
        LET valor = valor.subString(1, largo)
    END IF
    RETURN valor.trim()
END FUNCTION

#-----------------------------------------------------------------------------
# Provincia / Municipio DGII: codigo de 6 digitos con ceros a la izquierda
# (10100 -> 010100). NULL o 0 = no se envia.
FUNCTION codigo6cp(valor STRING) RETURNS STRING
    DEFINE n INTEGER
    LET n = NULL
    TRY
        LET n = valor
    CATCH
        LET n = NULL
    END TRY
    IF n IS NULL OR n = 0 THEN
        RETURN NULL
    END IF
    RETURN n USING "&&&&&&"
END FUNCTION

#-----------------------------------------------------------------------------
# Escribe el tag solo si el monto es mayor que cero
FUNCTION tagcpmonto(nombre STRING, valor STRING)
    IF montocp(valor) > 0 THEN
        CALL tagcp(nombre, valor)
    END IF
END FUNCTION

#-----------------------------------------------------------------------------
FUNCTION tagcp(nombre STRING, valor STRING)
    CALL wcp.startElement(nombre, NULL)
    CALL wcp.characters(valor)
    CALL wcp.endElement(nombre)
END FUNCTION