* ********************************************************* * * * * 2008.08.30 AFAN02P.PRG 14:30:27 * * * ********************************************************* * * * * Ing. Gustavo A. Pinilla C. * * * * Copyright (c) 2008 SIE7E*SRH * * Cel 310.421-2741 * * Cali, Valle 76001 * * Colombia * * * * Description: * * Este programa lo ha generado automáticamente GENSCRN. * * * ********************************************************* PARAMETERS _chg_fec,_chg_ven,_chg_num * ********************************************************* * * * * AFAN02P/Windows Código de configuración - SECCION 1 * * * ********************************************************* * #REGION 1 * version 01: DIC 2006 Nuevo reporte de FActuras Ocupar * B: Ordenamos los Items para el soporte. * C: Filtramos solo para tipo Fact '01' * D: Corregimos filtro y cambiamos base para IVA/todo * E: Validamos que Existan Q_items, quitamos inicial de wpag * 02: Incluimos impresion de NOTAS CRED, ND, 02,03, ETC * A: Incluimos calculo retfte,retiva,retica * B: Se agrega campo FACTURAS.DETALLE para conservar * el letrero-detalle-registro de la factura * C: Corregimos valores en blanco * D: Rectificamos facturacion FORMA-3 * E: Corregimos mensaje TIPO FACTURA --> TIPO DCTO * F: Organizamos Facturacion FORMA-4 (GRUPOS DE CCOSTOS) * G: Liberamos variables wlogo, wsal, wnit y Corregimos numeracion * de Otros fact de items. * H: Correccion pagina otros items, ; * I: Revalidamos append blank en facturas * J: Llevamos como parametro el nit y la Razon Social * K: Corregimos Forma 4, para grabar el numero de la fact en afanexo1 * L: Bloqueamos facturas y afanexo1 para la grabacion * M: Agregamos campo afanexo1.vlrbase para llevar la base * N: Modificamos reporte NO DETALLADO! MODELO99 * O: Agregamos consulta de Prefijos con '*' * P: Agregamos nombre del grupo c-ccosto TG00(GC) * Q: Agregamos parametro empresas.discrimina * para indicar el nombre de los extralegales * en la factura- MODELO01.FRX * r: 2011.09.28, Se ajusta para recalcular el IVA por aca. * S: 2013.01.03, Validmos iva para temp 2013/Admon _nomprg ="afan02p" C13 = CHR(13) SET PROC TO LOCKS DO INICIAL SET CENTURY ON RELEASE wlet_1,wtfac,wnum, wlogo, wsal, wnit,wlet, wselec, wlet00 PUBLIC wlet_1,wtfac,wnum, wlet, wselec, wlet00 wnum = 0 wlet_1= '' wlet0 = '' wlet1 = '' wlet = '' wpag = ' ' wlet00 = '' men_nit = "Codigo del Negocio"+C13+; "Con '*' Consulta Codigos de Negocio"+c13+; "Con '/' Consulta Facturacion Pndte."+c13+; "Con [F8] Facturacion x Grupos" men_nom = "Nombre Completo del Cliente" men_fec = "Digite la Fecha de Factura" men_ven = "Fecha de Vencimiento de Esta Factura" men_pre = "Prefijo de Factura" men_num = "Numero de la Factura a Imprimir" men_let = "Descripcion de Esta Factura" MEN_CUT = "Seleccione Centro Utilidad" men_pag = " -- Tipo de Documento --" STORE " " TO wnitr, wdir, wdir2, wciu,wtfac RELEASE wdescu PUBLIC wdescu STORE 0 TO wcred, wdeduc, wdescu, wextraleg, wtrans, ; wajsegs,wgastos, wriva,wrica,wrfte, wpor_ica, ; wpor_riva, wret_fte IF ABRIR('usuarios',0) wtipo_cia = tipo_cia wrazonsoc = ALLTRIM(razonsoc) wnitsocia = TRAN(VAL(nit),'999,999,999')+'-'+div ELSE wtipo_cia = 'T' ENDIF IF ABRIR('ncontrol',0) STORE base_ica TO wbase_ica ELSE STORE 0 TO wbase_ica ENDIF STORE 0 TO wotros,wriva, wrfte IF !FILE("fac_ctrl.dbf") _fac = FULLPATH('nmacum.dbf') _fac = STRTRAN(_fac,'NMACUM.DBF','fac_ctrl.dbf') CREATE TABLE (_fac) (dig C(3), pre C(1), num n(9), fec D, hor C(8)) INDEX ON dig + pre TAG llave1 INDEX ON pre + dig TAG llave2 ADDITIVE ENDIF IF ABRIR('tabgen12',1) IF !SEEK('CU') SELECT tiptab, SUBST(codtab,2,2) AS codtab, CHAR01, char02 ; FROM tabgen00 ; WHERE tiptab='CU' ; INTO CURSOR q1 IF RECC('q1')>0 SELECT q1 GO TOP DO WHILE !EOF() SCATTER MEMVAR SELECT tabgen12 APPEND BLANK GATHER MEMVAR SELECT q1 SKIP ENDDO ENDIF ENDIF SELECT tabgen12 IF !SEEK('TF') APPEND BLANK REPLACE tiptab WITH 'TF',codtab WITH '00',; destab WITH 'TIPOS DE FACTURAS/DCTOS' APPEND BLANK REPLACE tiptab WITH 'TF',codtab WITH '01',; destab WITH 'Factura Salarios Normal' APPEND BLANK REPLACE tiptab WITH 'TF',codtab WITH '02',; destab WITH 'Factura Prest. Sociales' APPEND BLANK REPLACE tiptab WITH 'TF',codtab WITH '03',; destab WITH 'Factura Incapacidades Entidades' APPEND BLANK REPLACE tiptab WITH 'TF',codtab WITH 'NC',; destab WITH 'Nota Credito' APPEND BLANK REPLACE tiptab WITH 'TF',codtab WITH 'NB',; destab WITH 'Nota Debito' ENDIF IF SEEK('TF') DO WHILE !EOF() AND tiptab = 'TF' IF codtab # '00' men_pag = men_pag + chr(13)+codtab + ': '+ALLTRIM(destab) ENDIF SKIP ENDDO ENDIF ENDIF men_pag = LEFT(men_pag,250) #REGION 0 REGIONAL m.currarea, m.talkstat, m.compstat IF SET("TALK") = "ON" SET TALK OFF m.talkstat = "ON" ELSE m.talkstat = "OFF" ENDIF m.compstat = SET("COMPATIBLE") SET COMPATIBLE FOXPLUS m.rborder = SET("READBORDER") SET READBORDER ON m.currarea = SELECT() * ********************************************************* * * * * Windows Definiciones de ventana * * * ********************************************************* * IF NOT WEXIST("w_afan02") ; OR UPPER(WTITLE("W_AFAN02")) == "W_AFAN02.PJX" ; OR UPPER(WTITLE("W_AFAN02")) == "W_AFAN02.SCX" ; OR UPPER(WTITLE("W_AFAN02")) == "W_AFAN02.MNX" ; OR UPPER(WTITLE("W_AFAN02")) == "W_AFAN02.PRG" ; OR UPPER(WTITLE("W_AFAN02")) == "W_AFAN02.FRX" ; OR UPPER(WTITLE("W_AFAN02")) == "W_AFAN02.QPR" DEFINE WINDOW w_afan02 ; AT 0.000, 0.000 ; SIZE 33.846,80.167 ; TITLE "Sie7e" ; FONT "MS Sans Serif", 8 ; STYLE "B" ; FLOAT ; NOCLOSE ; MINIMIZE ; SYSTEM ; COLOR RGB(,,,192,192,192) MOVE WINDOW w_afan02 CENTER ENDIF * ********************************************************* * * * * AFAN02P/Windows Distribución de pantalla * * * ********************************************************* * #REGION 1 IF WVISIBLE("w_afan02") ACTIVATE WINDOW w_afan02 SAME ELSE ACTIVATE WINDOW w_afan02 NOSHOW ENDIF @ 8.000,44.000 SAY "CU:" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 0.000,0.000 TO 3.769,80.167 ; PATTERN 1 ; PEN 1, 8 ; COLOR RGB(,,,0,0,128) @ 0.077,67.833 SAY "AFAN02P_.02s" ; FONT "Arial", 8 ; STYLE "T" ; COLOR RGB(255,255,255,,,,) @ 1.000,25.000 SAY "Impresión de Facturas" ; FONT "MS Sans Serif", 12 ; STYLE "BT" ; COLOR RGB(255,255,0,,,,) @ 4.692,3.500 SAY "Negocio:" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 8.000,5.333 SAY "Fecha:" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 8.000,25.333 SAY "Venc:" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 8.000,59.667 SAY "No." ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 8.000,64.667 SAY "-" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 28.462,12.000 TO 32.231,68.167 ; PEN 1, 8 ; COLOR RGB(128,128,128,,,,) @ 32.154,12.000 TO 32.154,68.167 ; PEN 1, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) @ 28.462,68.000 TO 32.231,68.000 ; PEN 1, 8 ; COLOR RGB(255,255,255,255,255,255) @ 17.231,4.000 SAY "Letrero Anexo Factura:" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 17.231,43.000 SAY "Valor Admon I.V.A" ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 4.692,12.667 GET wnit ; SIZE 1.000,10.000 ; DEFAULT " " ; FONT "Courier New", 8 ; PICTURE "@K!" ; WHEN w_nit() ; VALID v_nit() ; MESSAGE _mens(men_nit) ; COLOR ,RGB(,,,255,255,255) @ 4.692,25.667 GET wraz ; SIZE 1.000,41.429 ; DEFAULT " " ; FONT "Courier New", 8 ; PICTURE "@K!" ; WHEN .F. ; COLOR ,RGB(,,,255,255,255) @ 6.385,12.667 GET wnom ; SIZE 1.000,52.571 ; DEFAULT " " ; FONT "Courier New", 8 ; PICTURE "@K!" ; VALID _enable() ; COLOR ,RGB(,,,255,255,255) @ 8.000,12.667 GET wfec ; SIZE 1.000,9.714 ; DEFAULT { / / } ; FONT "Courier New", 8 ; PICTURE "@K 9999.99.99" ; WHEN _chg_fec ; VALID v_fec() ; MESSAGE _mens(men_fec) ; COLOR ,RGB(,,,255,255,255) @ 8.000,31.500 GET wven ; SIZE 1.000,9.714 ; DEFAULT { / / } ; FONT "Courier New", 8 ; PICTURE "@K 9999.99.99" ; WHEN _chg_ven ; VALID _enable() ; MESSAGE _mens(men_ven) ; COLOR ,RGB(,,,255,255,255) @ 8.000,48.167 GET wcut ; SIZE 1.000,2.000 ; DEFAULT " " ; FONT "Courier New", 8 ; PICTURE "@K !!" ; VALID v_cut() ; MESSAGE _mens(men_cut) ; COLOR ,RGB(,,,255,255,255) @ 8.000,56.167 GET wpag ; SIZE 1.000,2.000 ; DEFAULT " " ; FONT "Courier New", 8 ; PICTURE "@K !!" ; VALID v_pag() ; MESSAGE _mens(men_pag) ; COLOR ,RGB(,,,255,255,255) @ 8.000,63.167 GET wpre ; SIZE 1.000,0.857 ; DEFAULT " " ; FONT "Courier New", 8 ; PICTURE "@K !" ; VALID v_pre() ; MESSAGE _mens(men_pre) ; COLOR ,RGB(,,,255,255,255) @ 8.000,65.833 GET wnum ; SIZE 1.000,7.000 ; DEFAULT 0 ; FONT "Courier New", 8 ; PICTURE "@KL 9999999" ; WHEN _chg_num ; VALID v_num() ; MESSAGE _mens(men_num) ; COLOR ,RGB(,,,255,255,255) @ 9.923,3.667 EDIT wlet ; SIZE 6.000,62.714,0.000 ; DEFAULT " " ; FONT "Courier New", 8 ; SCROLL ; COLOR ,RGB(,,,255,255,255) @ 18.385,3.667 EDIT wlet1 ; SIZE 7.000,62.571,0.000 ; DEFAULT " " ; FONT "Courier New", 8 ; SCROLL ; COLOR ,RGB(,,,255,255,255) @ 26.462,26.000 GET wlogo ; PICTURE "@*C Imprimir Logo de la Compañia" ; SIZE 1.308,32.167 ; DEFAULT 1 ; FONT "MS Sans Serif", 8 ; STYLE "BT" @ 29.385,15.333 GET wsal ; PICTURE "@*HN \\\1 ON KEY LABEL ENTER KEYBOARD "{CTRL+W}" PLAIN BROWSE NORMAL TITLE 'CONTROL DE NUMERACION X DCTO' ON KEY LABEL ENTER RETURN ENDIF STORE 0 TO wcred, wdeduc, wdescu, wextraleg, wtrans, wajsegs, wselec, wotros STORE 0 TO wriva, wrfte _llave = '0000000'+wnit =_CLOSE('q_items','q_datos') * set step on * / REVISAMOS NUMERO DE REGISTRO PARA VOLVER A * / MARCAR CON EL NUMERO DE LA FACTURA IF ABRIR('afanexo1',2) AND SEEK(_llave) DO WHILE numfact+empresa="0000000"+empresa REPLACE numreg WITH RECNO() SKIP ENDDO ENDIF IF ABRIR("empresas",1) AND SEEK(wnit) AND ABRIR('afanexo3',1) AND ; COPYDBFTMP("afanexo1",2,_llave,[numfact+empresa=_llave FOR estado $ "A "],'q_items') _nom_frx = IIF(EMPTY(empresas.prg_fact) OR !FILE(ALLTRIM(empresas.prg_fact)+".FRX"),; 'FACT_1A',ALLTRIM(empresas.prg_fact)) * notas, y otros modelos de Facturas IF wpag $ "02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,NC,ND" ; AND FILE([MODELO]+wpag+[.FRX]) _nom_frx = [MODELO]+wpag+[.FRX] ENDIF wlet0 = f_det_item(0) wlet9 = f_det_ite1(0) DO CASE CASE wtfac $ "12 " DO tipfac1 CASE wtfac = "3" DO tipfac3 CASE wtfac = "4" DO tipfac4 OTHER DO tipfac1 ENDCASE SELECT q_datos * _salida = IIF(wsal=1,"PREVIEW","TO PRINT PROMPT") SET CONSOLE OFF REPORT FORM (_nom_frx) NOCONSOLE &_salida SET CONSOLE ON ** Incluimos SOPORTE DE FACTURA IF (FILE('modelo99.frx') AND FILE('modelo99.frt')) AND ; (FILE('modelo98.frx') AND FILE('modelo98.frt')) SELECT q_datos GO TOP _salida = IIF(wsal=1,"PREVIEW","TO PRINT PROMPT") IF mensaje("Formato Detallado?") REPORT FORM modelo98 NOCONSOLE &_salida ELSE IF FILE('modelo97.frx') SELECT empresa, coditem, periodo, cencost, ; SUM(valor) AS valor, ; SUM(vrapo) AS vrapo, ; SUM(vrpso) AS vrpso, ; SUM(vradm) AS vradm, ; SUM(vriva) AS vriva, ; SUM(IIF(vriva#0,valor+vrpso+vrapo+vradm,000000000)) AS base_iva7, ; SUM(salarios) AS salarios, ; SUM(transporte) AS transporte, ; SUM(extralegal) AS extralegal, ; SUM(incapacidad) AS incapacidad,; SUM(psociales) AS psociales, ; SUM(gastos) AS gastos, ; SUM(aj_segsoci) AS aj_segsoci, ; SUM(seleccion) AS seleccion, ; SUM(base_inc) AS base_inc, ; SUM(vrica) AS vrica, ; SUM(vrriv) AS vrriv, ; SUM(vrret) AS vrret ; FROM q_datos ; INTO CURSOR q_datosr ; GROUP BY empresa,coditem SET RELATION TO coditem INTO afanexo3 REPORT FORM modelo97 NOCONSOLE &_salida ENDIF ENDIF ENDIF * / MARCAMOS LOS REGISTROS CON EL NUMERO DE FACTURA IF wsal = 2 AND ABRIR('afanexo1',2) AND ABRIR('afanexo3',1) SELECT afanexo1 SET RELATION TO coditem INTO afanexo3 SELECT q_items GO TOP DO WHILE !EOF() SELECT afanexo1 GO q_items.numreg IF numfact = '0000000' AND empresa = wnit AND ; (EMPTY(wpag) OR afanexo3.pagfac=wpag) kfnum = f_numfact() REPLACE numfact WITH NTOC(kfnum,7) REPLACE prefijo WITH wpre REPLACE estado WITH 'A' ENDIF SELECT q_items SKIP ENDDO SELECT q_datos GO TOP DO WHILE !EOF() knum = NTOC(wnum+RECNO()-1,7) && Numero de factura IF ABRIR("facturas",1) AND FLOCK() DO p_add_fact ELSE _men = 'NO SE PUDO REGISTRAR ESTE DOCUMENTO'+_C13+; wpre+'-'+wnum+' desea Reintentar ?' IF MENSAJE(_men) I = 0 SELECT facturas DO WHILE !SEEK(wpre+wnum,'facturas') AND i < 200 DO p_add_fact i = i + 1 = INKEY(2) ENDDO ENDIF ENDIF SELECT q_datos SKIP ENDDO UNLOCK ALL ENDIF ENDIF * Eliminamos el contrl de la factura DO del_ctrl RETURN ****** PROCEDURE p_add_fact IF !SEEK(wpre+knum,'facturas') SELECT facturas APPEND BLANK DO WHILE !EMPTY(prefij) AND !EMPTY(numero) AND ; !EMPTY(negoci) APPEND BLANK ENDDO REPLACE prefij WITH wpre REPLACE numero WITH knum REPLACE negoci WITH wnit REPLACE estado WITH "a" ELSE kmen = " Numero de Factura asignado a otro Cliente"+c13+; " Desea Continuar ?" IF negoci # wnit AND !mensaje(kmen) kmen = "* * * Los items han sido marcados, * * *"+c13+; " reactivelos para volver a Facturar." =mensaje(kmen) RETURN ENDIF ENDIF REPLACE fechaE WITH wfec, ; fechai WITH DATE(), ; fechav WITH WVEN, ; vlrpag WITH q_datos.valor,; vlrapo WITH q_datos.vrapo, ; vlrpso WITH q_datos.vrpso, ; vlriva WITH q_datos.vriva, ; vlradm WITH q_datos.vradm, ; retica WITH q_datos.vrica, ; retfte WITH q_datos.vrret, ; retiva WITH q_datos.vrriv DO CASE CASE wtfac $ "3,4" REPLACE dscto1 WITH F_descu(q_datos.cencost) CASE wtfac $ "1,2" REPLACE dscto1 WITH F_descu("-XX-") ENDCASE REPLACE estado with "A", ; coddig WITH _wuser IF TYPE('detalle')$'C,M' REPLACE detalle WITH wlet && +IIF(TYPE('q_datos.grupo1')='C',CHR(13)+q_datos.grupo1,'') ENDIF UNLOCK STORE [] TO wced,mced DO GRABPROC2 WITH [ADD-FACT:]+wpre+knum,"A" RETURN ****** PROCEDURE tipfac1 wpor_ica = TRAE_DATO("empresas",1,wnit,'por_ica') wbaseica = TRAE_DATO("empresas",1,wnit,'baseica') wpor_riva = TRAE_DATO("empresas",1,wnit,'por_riva') wpor_rfte = TRAE_DATO("empresas",1,wnit,'retfte') _cero = 00000000000.00 SELECT a.empresa, a.coditem, c.periodo, ; SUM(valor) AS valor, SUM(vrapo) AS vrapo, ; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm, ; SUM(vriva) AS vriva, SPACE(8) AS cencost, ; SUM(IIF(vriva#0,valor+vrapo+vrpso+vradm,_cero)) AS base_iva1, ; SUM(IIF(vriva#0,vradm,_cero)) AS base_iva2, ; SUM(IIF(vriva#0,valor+vrapo+vrpso,_cero)) AS base_iva3, ; _CERO as por_iva, ; SUM(IIF(wbaseica=1,valor+vrapo+vrpso+vradm,vradm)) AS base_ica, ; SUM(IIF(LEFT(coditem,1)='S',valor,_cero)) AS salarios, ; SUM(IIF(LEFT(coditem,1)='I',valor,_cero)) AS incapacidad, ; SUM(IIF(LEFT(coditem,1)='T',valor,_cero)) AS transporte, ; SUM(IIF(LEFT(coditem,1)='E',valor,_cero)) AS extralegal, ; SUM(IIF(LEFT(coditem,1)='P',valor,_cero)) AS psociales, ; SUM(IIF(LEFT(coditem,1)='G',valor,_cero)) AS gastos, ; SUM(IIF(LEFT(coditem,1)='A',valor,_cero)) AS aj_segsoci, ; SUM(IIF(LEFT(coditem,1)='Z',valor,_cero)) AS seleccion, ; SUM(vlrbase) AS base_inc ; FROM q_items a, afanexo3 b, afanexo0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = b.coditm ; AND b.otrosc = 0 ; AND a.numanex = c.numanex ; AND (EMPTY(wpag) OR b.pagfac=wpag) ; GROUP BY a.empresa ; INTO CURSOR q_datos1 READWRITE * 2011.09.28 * Aqui metemos el recalculo del IVA. IF !USED("qt_nego") USE empresas ORDER 1 IN 0 ALIAS qt_nego AGAIN ENDIF SELECT q_datos1 SET RELATION TO empresa INTO qt_nego REPLACE por_iva WITH qt_nego.poriva ALL GO TOP DO WHILE !EOF() * 2013.01.03 Validamos base del IVA * --------------------------------- IF WFEC>={^2013-01-01} AND wtipo_cia='T' *Procedimiento registrado en maestro wprocfact = TD7("empresas",1,wnit,'FACINT') DO CASE CASE wprocfact = 'A' && A-Sobre todo lo facturado base_iva = base_iva1 CASE wprocfact = 'B' && B-Directo sobre Admon base_iva = base_iva2 CASE wprocfact = 'C' base_iva = MAX(base_iva3*10/100,base_iva2) CASE wprocfact = 'D' base_iva = MAX(base_iva1*10/100,base_iva2) OTHER base_iva=base_iva2 ENDCASE ELSE base_iva=base_iva1 ENDIF * --------------------------------- wn_new_iva = ROUND(base_iva*por_iva,0) ws_iva = "Ajustar Valor IVA?"+CHR(13)+; "IVA GRAB:"+ALLTRIM(TRANSFORM(VRIVA,"999,999,999,999.99"))+CHR(13)+; "IVA CALC:"+ALLTRIM(TRANSFORM(wn_new_iva,"999,999,999,999.99")) IF vriva # wn_new_iva AND MENSAJE(ws_iva) DO GRABPROC WITH "IVA:"+STR(vriva,9)+"/"+str(wn_new_wiva,9) REPLACE vriva WITH wn_new_iva ENDIF SKIP ENDDO * Revisamos la base del ica, retfte riva SELECT empresa, coditem, periodo, cencost, ; valor, vrapo, vrpso, vradm, vriva ,; salarios, transporte, extralegal, incapacidad,; psociales, gastos, aj_segsoci, seleccion, base_inc, ; IIF(base_ica>=wbase_ica,ROUND(base_ica*wpor_ica/100,0),0) AS vrica, ; IIF(wpor_riva>0,ROUND(vriva*wpor_riva/100,0),0) AS vrriv, ; IIF(wpor_rfte>0,ROUND((valor+vrapo+vrpso+vradm)*wpor_rfte/100,0),0) AS vrret ; FROM q_datos1 ; INTO CURSOR q_datos SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND afanexo3.otrosc = 1 ; GROUP BY empresa ; INTO CURSOR q_descu SUM valor TO wdescu SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND afanexo3.otrosc = 0 ; AND LEFT(coditem,1) = "T" ; GROUP BY empresa ; INTO CURSOR q_trans SUM valor TO wtrans SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND afanexo3.otrosc = 0 ; AND LEFT(coditem,1) = "E" ; GROUP BY empresa ; INTO CURSOR q_extral SUM valor TO wextraleg SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND afanexo3.otrosc = 0 ; AND LEFT(coditem,1) = "A" ; GROUP BY empresa ; INTO CURSOR q_extral SUM valor TO wajsegs SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND afanexo3.otrosc = 0 ; AND coditem = "G01" ; GROUP BY empresa ; INTO CURSOR q_extral SUM valor TO wgastos SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND LEFT(coditem,1) = "Z" ; GROUP BY empresa ; INTO CURSOR q_extral SUM valor TO wselec SELECT empresa, coditem ,SPACE(8) AS cencost,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items, afanexo3 ; WHERE q_items.estado $ "A " ; AND numfact = "0000000" ; AND q_items.coditem = afanexo3.coditm ; AND (EMPTY(wpag) OR afanexo3.pagfac=wpag) ; AND afanexo3.otrosc = 0 ; AND LEFT(coditem,1) = "O" ; GROUP BY empresa ; INTO CURSOR q_extral SUM valor TO wotros RETURN ****** PROCEDURE tipfac3 wpor_ica = TRAE_DATO("empresas",1,wnit,'por_ica') wbaseica = TRAE_DATO("empresas",1,wnit,'baseica') wpor_riva = TRAE_DATO("empresas",1,wnit,'por_riva') wpor_rfte = TRAE_DATO("empresas",1,wnit,'retfte') _cero = 000000000000.00 SELECT * ; FROM afanexo0 ; WHERE numanex IN (SELECT DIST numanex ; FROM q_items) ; INTO CURSOR q_anx0 SELECT a.empresa, c.cencost, a.coditem, c.periodo, ; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva , _cero AS por_iva, ; SUM(IIF(vriva#0,valor+vrapo+vrpso+vradm,_cero)) AS base_iva, ; SUM(IIF(wbaseica=1,valor+vrapo+vrpso+vradm,vradm)) AS base_ica, ; SUM(IIF(LEFT(coditem,1)='S',valor,_cero)) AS salarios, ; SUM(IIF(LEFT(coditem,1)='I',valor,_cero)) AS incapacidad, ; SUM(IIF(LEFT(coditem,1)='T',valor,_cero)) AS transporte, ; SUM(IIF(LEFT(coditem,1)='E',valor,_cero)) AS extralegal, ; SUM(IIF(LEFT(coditem,1)='P',valor,_cero)) AS psociales, ; SUM(IIF(LEFT(coditem,1)='G',valor,_cero)) AS gastos, ; SUM(IIF(LEFT(coditem,1)='A',valor,_cero)) AS aj_segsoci, ; SUM(IIF(LEFT(coditem,1)='Z',valor,_cero)) AS seleccion, ; SUM(vlrbase) AS base_inc ; FROM q_items a, afanexo3 b, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = b.coditm ; AND b.otrosc = 0 ; AND a.numanex = c.numanex ; AND (EMPTY(wpag) OR b.pagfac=wpag) ; GROUP BY a.empresa, c.cencost ; INTO CURSOR q_datos1 READWRITE * 2011.09.28 * Aqui metemos el recalculo del IVA. IF !USED("qt_nego") USE empresas ORDER 1 IN 0 ALIAS qt_nego AGAIN ENDIF SELECT q_datos1 SET RELATION TO empresa INTO qt_nego REPLACE por_iva WITH qt_nego.poriva ALL GO TOP DO WHILE !EOF() wn_new_iva = ROUND(base_iva*por_iva,0) IF vriva # wn_new_iva AND MENSAJE("Ajustar Valor IVA?") DO GRABPROC WITH "IVA:"+STR(vriva,9)+"/"+str(wn_new_wiva,9) REPLACE vriva WITH wn_new_iva ENDIF SKIP ENDDO ************************************** * Revisamos la base del ica, retfte riva SELECT empresa, cencost, coditem, periodo, ; valor, vrapo, vrpso, vradm, vriva ,; salarios, transporte, extralegal, incapacidad,; psociales, gastos, aj_segsoci, seleccion, base_inc,; IIF(base_ica>=wbase_ica,ROUND(base_ica*wpor_ica/100,0),0) AS vrica, ; IIF(wpor_riva>0,ROUND(vriva*wpor_riva/100,0),0) AS vrriv, ; IIF(wpor_rfte>0,ROUND((valor+vrapo+vrpso+vradm)*wpor_rfte/100,0),0) AS vrret ; FROM q_datos1 ; INTO CURSOR q_datos SELECT a.empresa, c.cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND a.numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 1 ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.cencost ; INTO CURSOR q_descu SUM valor TO wdescu SELECT a.empresa, c.cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND a.numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "T" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.cencost ; INTO CURSOR q_trans SUM valor TO wtrans SELECT a.empresa, c.cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "E" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.cencost ; INTO CURSOR q_extral SUM valor TO wextraleg SELECT a.empresa, c.cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND a.numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "A" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.cencost ; INTO CURSOR q_ajsegs SUM valor TO wajsegs SELECT a.empresa, c.cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND a.coditem = "G01" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.cencost ; INTO CURSOR q_gastos SUM valor TO wgastos RETURN ****** PROCEDURE tipfac4 wpor_ica = TRAE_DATO("empresas",1,wnit,'por_ica') wbaseica = TRAE_DATO("empresas",1,wnit,'baseica') wpor_riva = TRAE_DATO("empresas",1,wnit,'por_riva') wpor_rfte = TRAE_DATO("empresas",1,wnit,'retfte') _cero = 000000000000.00 SELECT a0.*, TRAE_DATO('cencosto',1,a0.empresa+a0.cencost,'gruccosto') AS grupo ; FROM afanexo0 a0 ; WHERE a0.numanex IN (SELECT DIST numanex ; FROM q_items) ; INTO CURSOR q_anx0 SELECT a.empresa, c.grupo AS cencost, a.coditem, c.periodo, ; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ,; SUM(IIF(wbaseica=1,valor+vrapo+vrpso+vradm,vradm)) AS base_ica, ; SUM(IIF(LEFT(coditem,1)='S',valor,_cero)) AS salarios, ; SUM(IIF(LEFT(coditem,1)='I',valor,_cero)) AS incapacidad, ; SUM(IIF(LEFT(coditem,1)='T',valor,_cero)) AS transporte, ; SUM(IIF(LEFT(coditem,1)='E',valor,_cero)) AS extralegal, ; SUM(IIF(LEFT(coditem,1)='P',valor,_cero)) AS psociales, ; SUM(IIF(LEFT(coditem,1)='G',valor,_cero)) AS gastos, ; SUM(IIF(LEFT(coditem,1)='A',valor,_cero)) AS aj_segsoci, ; SUM(IIF(LEFT(coditem,1)='Z',valor,_cero)) AS seleccion, ; SUM(vlrbase) AS base_inc ; FROM q_items a, afanexo3 b, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = b.coditm ; AND b.otrosc = 0 ; AND a.numanex = c.numanex ; AND (EMPTY(wpag) OR b.pagfac=wpag) ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_datos1 * Revisamos la base del ica, retfte riva SELECT empresa, cencost, coditem, periodo, ; valor, vrapo, vrpso, vradm, vriva ,; salarios, transporte, extralegal, incapacidad,; psociales, gastos, aj_segsoci, seleccion, base_inc,; IIF(base_ica>=wbase_ica,ROUND(base_ica*wpor_ica/100,0),0) AS vrica, ; IIF(wpor_riva>0,ROUND(vriva*wpor_riva/100,0),0) AS vrriv, ; IIF(wpor_rfte>0,ROUND((valor+vrapo+vrpso+vradm)*wpor_rfte/100,0),0) AS vrret ; FROM q_datos1 ; INTO CURSOR q_datos SELECT a.empresa, c.grupo AS cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND a.numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 1 ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_descu SUM valor TO wdescu SELECT a.empresa, c.grupo AS cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND a.numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "T" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_trans SUM valor TO wtrans SELECT a.empresa, c.grupo AS cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "E" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_extral SUM valor TO wextraleg SELECT a.empresa, c.grupo AS cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND a.numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "A" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_ajsegs SUM valor TO wajsegs SELECT a.empresa, c.grupo AS cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND LEFT(a.coditem,1) = "Z" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_extral SUM valor TO wselec SELECT a.empresa, c.grupo AS cencost, a.coditem ,; SUM(valor) AS valor, SUM(vrapo) AS vrapo,; SUM(vrpso) AS vrpso, SUM(vradm) AS vradm,; SUM(vriva) AS vriva ; FROM q_items a, afanexo3, q_anx0 c ; WHERE a.estado $ "A " ; AND numfact = "0000000" ; AND a.coditem = afanexo3.coditm ; AND afanexo3.otrosc = 0 ; AND a.coditem = "G01" ; AND a.numanex = c.numanex ; GROUP BY a.empresa, c.grupo ; INTO CURSOR q_gastos SUM valor TO wgastos RETURN ****** FUNCTION f_descu PARAMETER _cco _area= SELECT() SELECT q_descu IF _cco = '-XX-' OR wtfac$"1,2, " SUM -valor TO kdescu ELSE SUM -valor TO kdescu FOR cencost = _cco ENDIF wdescu = kdescu SELECT (_area) RETURN kdescu ****** FUNCTION f_numfact *wlet = wlet00 DO CASE CASE wtfac $ [1,2,9, ] _num = wnum CASE wtfac = [3] _are = SELECT() _cco = TRAE_DATO('afanexo0',1,afanexo1.numanex,'cencost') SELECT q_datos LOCATE FOR cencost = _cco _num = wnum+RECN()-1 SELECT (_are) CASE wtfac = [4] _are = SELECT() _cco = TRAE_DATO('afanexo0',1,afanexo1.numanex,'cencost') _gru = TRAE_DATO('cencosto',1,wnit+_cco,'gruccosto') * _grn = TRAE_DATO('tabgen00',1,'GC'+_gru,'destab') SELECT q_datos LOCATE FOR cencost = _gru _num = wnum+RECN()-1 SELECT (_are) ENDCASE RETURN _num ****** FUNCTION w_nit SET FUNCTION 8 TO 'X-GRUPOS-X' RETURN .T. ****** FUNCTION v_nit SET FUNCTION 8 TO IF "/" $ wnit SELECT a.empresa, a.numanex, b.periodo, ; PADL(TRAE_DATO("afanexo3",1,a.coditem,'desitm'),30,' ')+a.coditem AS Item, ; valor, vrapo AS aportes, ; vrpso AS p_SOC, vradm AS admon, vriva AS iva, ; TRAE_RAZ(a.empresa) AS negocio ; FROM afanexo1 a, afanexo0 b ; WHERE numfact = "0000000" ; AND EMPTY(a.estado) ; AND a.numanex = b.numanex ; INTO CURSOR q_pdte ; ORDER BY a.empresa ON KEY LABEL ENTER KEYBOARD "{CTRL+W}" PLAIN BROWSE NOMO NORMAL FREEZE empresa ON KEY LABEL ENTER IF LASTKEY()#27 wnit = empresa ENDIF ENDIF IF wnit = 'X-GRUPOS-X' && Facturacion x Grupos de Negocios =_mens('Seleccionando Negocios Compartidos ....') IF ABRIR('afanexo1',2) AND SEEK("0000000"+wnit) AND ; ABRIR('afanexo0',1) AND SEEK(afanexo1.numanex,'afanexo0') knit = afanexo0.empresa SELECT afanexo1 DO WHILE SEEK('0000000'+wnit) REPLACE empresa WITH knit ENDDO wnit = knit kraz = TRAE_RAZ(wnit) ENDIF ELSE kraz = TRAE_RAZ(wnit,.T.) ENDIF IF kraz # "." AND !EMPTY(kraz) wraz = kraz SET FUNCTION 10 TO wnit wnom = TRAE_DATO("empresas",1,wnit,"raz_real") wnitr= TRAE_DATO("empresas",1,wnit,"nit_real") wcred= TRAE_DATO("empresas",1,wnit,"dias_cred") wdir = TRAE_DATO("empresas",1,wnit,"direc") wciu = TRAE_DATO("empresas",1,wnit,"ciudad") wdir2 =TRAE_DATO("empresas",1,wnit,"direntre") wtfac =TRAE_DATO("empresas",1,wnit,"indcosto") wfaci= TRAE_DATO("empresas",1,wnit,"facint") wret_fte = TRAE_DATO("empresas",1,wnit,"retfte") wpor_ica = TRAE_DATO("empresas",1,wnit,"por_ica") wpor_riva= TRAE_DATO("empresas",1,wnit,"por_riva") IF wfaci = "S" wlet = TRAE_DATO("empresas",1,wnit,"detalle1") wlet = wlet+C13+TRAE_DATO("empresas",1,wnit,"detalle2") wlet = wlet+C13+TRAE_DATO("empresas",1,wnit,"detalle3") wlet = wlet+C13+TRAE_DATO("empresas",1,wnit,"detalle4") ELSE = _CLOSE('afanexo3','q_items') _llave = '0000000'+wnit IF ABRIR('afanexo3',1) AND ; COPYDBFTMP("afanexo1",2,_llave,[numfact+empresa=_llave FOR estado$"A "],'q_items') wlet0 = f_det_item(19) wlet1 = f_det_ite1(19) DO CASE CASE wtipo_cia = 'T' * wlet = "Servicio Temporal correspondiente al periodo: " wlet = " " IF wselec # 0 wlet = wlet + CHR(13) + "Servicio de Seleccion de Personal" ENDIF IF wotros # 0 wlet = wlet + CHR(13) + "Servicios Empresariales" ENDIF IF wotros = 0 AND wselec = 0 wlet = wlet + CHR(13) + "Servicio Temporal Correspondiente al periodo:" ENDIF CASE wtipo_cia = 'C' wlet = "Labor autogestionaria correspondiente al periodo: " OTHER wlet = 'Servicio correspondiente al periodo: ' ENDCASE ENDIF SELECT periodo ; FROM afanexo0 ; WHERE empresa = wnit ; AND numanex IN (SELECT numanex ; FROM afanexo1 ; WHERE numfact = "0000000" ; AND estado $ 'A ' ; AND empresa = wnit) ; INTO CURSOR q_per GO TOP wlet = wlet + ALLTRIM(q_per.periodo) wlet00=wlet ENDIF ENDIF RETURN _enable() ****** FUNCTION v_pre IF wpre='*' IF ABRIR('tabgen11',1) DO DEF_WIND WITH "11",'Consulta de Prefijos de Facturacion' ON KEY LABEL ENTER KEYBOARD "{CTRL+W}" PLAIN BROWSE WINDOW consult11 KEY 'FN' FREEZE codtab; FIELD codtab:H="Prefijo", destab:H="Detalle" ON KEY LABEL ENTER IF LASTKEY()# 27 wpre = codtab ELSE wpre = ' ' ENDIF ENDIF ELSE IF !EMPTY(wpre) AND ABRIR('tabgen11',1) AND ; !SEEK('FN'+wpre) =_mens('Prefijo NO REGISTRADO !') RETURN .F. ENDIF ENDIF IF EMPTY(wnum) AND ABRIR("facturas",1) AND SEEK(wpre,'facturas') wnum = VAL(numero)+1 DO add_ctrl ENDIF RETURN _enable() ****** PROCEDURE add_ctrl IF ABRIR("fac_ctrl",1) IF !SEEK(_wuser+wpre) APPEND BLANK REPLACE dig WITH _wuser REPLACE pre WITH wpre ENDIF REPLACE num WITH wnum REPLACE fec WITH DATE() REPLACE hor WITH TIME() ENDIF RETURN ****** PROCEDURE del_ctrl IF ABRIR("fac_ctrl",2) AND SEEK(wpre) DO WHILE pre = wpre AND !EOF() IF num = wnum AND dig = _wuser REPLACE num WITH 0 ENDIF SKIP ENDDO ENDIF RETURN ****** FUNCTION v_pag IF ABRIR('tabgen12',1) IF '*' $ wpag SELECT tabgen12 DO DEF_WIND WITH '8','Tipos de Documentos' ON KEY LABEL ENTER KEYBOARD "{CTRL+W}" PLAIN BROWSE KEY 'TF' FIELD codtab,destab ; FREEZE codtab WINDOW consult8 ON KEY LABEL ENTER IF LASTKEY()#27 wpag = codtab ELSE wpag = ' ' ENDIF SHOW GET wpag ENDIF IF !SEEK('TF'+wpag) =_mens('Tipo de Dcto NO creado!',.T.,1) RETURN .F. ENDIF ENDIF wlet0 = f_det_item(19) wlet1 = f_det_ite1(19) _reporte = "MODELO"+wpag+'.FRX' IF !FILE(_reporte) _men = [Archivo: ]+_reporte+[ NO existe] +CHR(13)+[ Desea CONTINUAR?] RETURN mensaje(_men) ENDIF RETURN _enable() ****** FUNCTION v_num DO add_ctrl RETURN _enable() ****** FUNCTION v_fec wven = wfec + wcred SHOW GET wven RETURN .T. ****** FUNCTION _enable IF !EMPTY(wfec) AND EMPTY(wven) wven = wfec + wcred ENDIF IF !EMPTY(wraz) AND !EMPTY(wnom) AND !EMPTY(wfec) AND ; !EMPTY(wpre) AND !EMPTY(wnum) AND wven>=wfec AND ; !EMPTY(wpag) SHOW GET wsal,1 ENABLE SHOW GET wsal,2 ENABLE ON KEY LABEL PGDN DO obj_sal ELSE SHOW GET wsal,1 DISABLE SHOW GET wsal,2 DISABLE ON KEY LABEL PGDN ENDIF IF EMPTY(wfec) wfec = DATE() ENDIF SHOW GETS WINDOW w_afan02 RETURN .T. ****** PROCEDURE close_data =_CLOSE("facturas","afanexo1","afanexo0") =_CLOSE("empresas","afanexo3","usuarios") =_CLOSE("tabgen02","tabgen00","fac_ctrl") =_CLOSE("q_items","q_datos","q_per","q_descu","q_pdte") =_CLOSE("ncontrol","q_datos1","q1_ctrl","q_trans","q_extral") RETURN ****** FUNCTION f_let PARAMETER _wtipfac,_cco IF _wtipfac $ "14 " _let = wlet ELSE _let = ALLTRIM(wlet)+CHR(13)+; 'CenCosto: '+TRAE_DATO('cencosto',1,wnit+_cco,'nomccosto') ENDIF RETURN _let ****** FUNCTION f_num PARAMETER _wtipfac IF _wtipfac $ "14 " _num = wnum ELSE _num = wnum wnum = wnum + 1 ENDIF RETURN _num ****** FUNCTION v_cut RETURN !EMPTY(wcut) ****** FUNCTION f_det_item PARAMETER _tamano IF USED('q_items') AND RECC('q_items')>0 SELECT q_items SET RELATION TO coditem INTO afanexo3 INDEX ON afanexo3.ordeni+CODITEM TAG llave1 ; FOR afanexo3.otrosc=0 AND ; (afanexo3.pagfac=wpag OR EMPTY(wpag)) STORE 0 TO wselec, wotros GO TOP IF EOF() =MENSAJE("NO HAY ITEMS PENDIENTES PARA ESTE NEGOCIO") _let = SPACE(200) RETURN _let ENDIF _fto = '999,999,999' _FT1 = '99,999,999' _des = IIF(_tamano>0,_tamano,LEN(afanexo3.desitm)) _let = coditem+' '+LEFT(afanexo3.desitm,_des)+' '+TRAN(valor,_fto) _let = _let + TRAN(vrapo,_fto)+TRAN(vrpso,_fto)+' ' _let = _let + TRAN(vradm,_ft1)+' '+TRAN(vriva,_ft1)+CHR(13) wselec = wselec +IIF(LEFT(coditem,1)='Z', valor,0) wotros = wotros +IIF(LEFT(coditem,1)='O', valor,0) k1_vlr = valor k1_apo = vrapo k1_pso = vrpso k1_adm = vradm k1_iva = vriva k1_sum = .F. SKIP DO WHILE !EOF() k1_sum = .T. _des = IIF(_tamano>0,_tamano,LEN(afanexo3.desitm)) _let = _let + coditem+' '+LEFT(afanexo3.desitm,_des)+' '+TRAN(valor,_fto) _let = _let + TRAN(vrapo,_fto)+TRAN(vrpso,_fto)+' ' _let = _let + TRAN(vradm,_ft1)+' '+TRAN(vriva,_ft1)+CHR(13) wselec = wselec +IIF(LEFT(coditem,1)='Z', valor,0) wotros = wotros +IIF(LEFT(coditem,1)='O', valor,0) k1_vlr = k1_vlr+valor k1_apo = k1_apo+vrapo k1_pso = k1_pso+vrpso k1_adm = k1_adm+vradm k1_iva = k1_iva+vriva SKIP ENDDO SET ORDER TO * Agregamos linea de Sumatoria IF k1_sum _let = _let + SPACE(4)+PADL("Sumas:",_des," ")+' '+TRAN(k1_vlr,_fto) _let = _let + TRAN(k1_apo,_fto)+TRAN(k1_pso,_fto)+' ' _let = _let + TRAN(k1_adm,_ft1)+' '+TRAN(k1_iva,_ft1) ENDIF ELSE _let = SPACE(200) ENDIF RETURN _let ****** FUNCTION f_det_ite1 PARAMETER _tamano IF USED('q_items') AND RECC('q_items')>0 SELECT q_items SET RELATION TO coditem INTO afanexo3 INDEX ON afanexo3.ordeni+CODITEM TAG llave1 ; FOR afanexo3.otrosc=0 AND ; (afanexo3.pagfac=wpag OR EMPTY(wpag)) STORE 0 TO wselec, wotros GO TOP IF EOF() RETURN SPACE(200) ENDIF _fto = '999,999,999' _FT1 = '99,999,999' _des = IIF(_tamano>0,_tamano,LEN(afanexo3.desitm)) _let = coditem+' '+LEFT(afanexo3.desitm,_des)+' '+TRAN(valor+vrapo+vrpso,_fto) _let = _let + TRAN(vradm,_ft1)+' '+TRAN(vriva,_ft1) wselec = wselec +IIF(LEFT(coditem,1)='Z', valor,0) wotros = wotros +IIF(LEFT(coditem,1)='O', valor,0) k1_vlr = valor+vrapo+vrpso k1_adm = vradm k1_iva = vriva k1_sum = .F. SKIP DO WHILE !EOF() k1_sum = .T. _des = IIF(_tamano>0,_tamano,LEN(afanexo3.desitm)) _let = _let +CHR(13)+coditem+' '+LEFT(afanexo3.desitm,_des)+; ' '+TRAN(valor+vrapo+vrpso,_fto) _let = _let + TRAN(vradm,_ft1)+' '+TRAN(vriva,_ft1) wselec = wselec +IIF(LEFT(coditem,1)='Z', valor,0) wotros = wotros +IIF(LEFT(coditem,1)='O', valor,0) k1_vlr = k1_vlr+valor+vrapo+vrpso k1_adm = k1_adm+vradm k1_iva = k1_iva+vriva SKIP ENDDO SET ORDER TO * Agregamos linea de Sumatoria IF k1_sum _let = _let + CHR(13)+SPACE(4)+PADL("Sumas:",_des," ")+' '+TRAN(k1_vlr,_fto) _let = _let + TRAN(k1_adm,_ft1)+' '+TRAN(k1_iva,_ft1) ENDIF ELSE _let = SPACE(200) ENDIF RETURN _let ****** FUNCTION F_locks IF wsal = 1 && Consulta SELECT facturas UNLOCK SELECT afanexo1 UNLOCK RETURN .T. ELSE SELECT facturas j = 1 DO WHILE j<=200 AND !FLOCK() =INKEY(1) j = j + 1 ENDDO IF FLOCK() SELECT afanexo1 j = 1 DO WHILE j<=200 AND !FLOCK() j = j + 1 IF j= 50 =mensaje('Otro usuario esta tomando el archivo de Facturas') ELSE =INKEY(0.5) ENDIF ENDDO IF FLOCK() DO del_ctrl SELECT facturas SET ORDER TO 1 IF SEEK(wpre) wnum = VAL(numero)+1 SHOW GET wnum DO add_ctrl RETURN .T. ENDIF ENDIF ENDIF ENDIF RETURN .F. ****** * ********************************************************* * * * * _2GB0V3EPM wsal VALID * * * * Function Origin: * * * * From Platform: Windows * * From Screen: AFAN02P, Record Number: 28 * * Variable: wsal * * Called By: VALID Clause * * Object Type: Push Button * * Snippet Number: 1 * * * ********************************************************* * FUNCTION _2gb0v3epm && wsal VALID #REGION 1 DO CASE CASE wsal = 1 OR wsal = 2 SHOW GET wsal,wsal DISABLE wnit = PADR(ALLTRIM(wnit),10,' ') DO _imprime IF wsal=1 SHOW GET wsal,1 ENABLE ENDIF CASE wsal = 3 CLEAR READ ENDCASE RETURN