#include "common.ch"
#include "inkey.ch"

static Static1
static Static2:= "LPT1", Static3:= "ON", Static4:= 10, Static5:= 50, ;
   Static6, Static7
static Static8
static Static9:= 0
static Static10, Static11
static Static12:= ""
static Static13:= 0
static Static14, Static15, Static16, Static17, Static18, Static19
static Static20:= {}
static Static21, Static22:= .F., Static23, Static24, Static25, ;
   Static26, Static27, Static28, Static29, Static30
static Static31

********************************
procedure NUC

   local Local1
   Local1:= {}
   parameters import
   AAdd(Local1, {2, 2, " Cadastro      "})
   AAdd(Local1, {2, 19, " Manutencao    "})
   AAdd(Local1, {2, 36, " Relatorios    "})
   AAdd(Local1, {2, 53, " Utilitarios   "})
   private opc_sinal:= Local1
   clear screen
   set epoch to 1950
   set key K_CTRL_F9 to keylock
   set key K_CTRL_F10 to joga_255
   set key 255 to prot_tela
   keysec(255, 300, -1, .T.)
   set key K_F1 to help1
   set key K_INS to insovr
   private xpathdbf:= Trim(diskname() + "                         ")
   xpathdbf:= xpathdbf + Trim(":                         ")
   xpathdbf:= xpathdbf + Trim("\                         ")
   xpathdbf:= xpathdbf + Trim("X                         ")
   xpathdbf:= xpathdbf + Trim("C                         ")
   xpathdbf:= xpathdbf + Trim("X                         ")
   xpathdbf:= xpathdbf + Trim("\                         ")
   set scoreboard off
   set date british
   set deleted on
   setcursor(0)
   set wrap on
   setblink(.F.)
   clear screen
   vererro()
   config:= array(20)
   configlan(@config)
   cor:= array(20)
   readcor(@cor)
   i_m_p_r_ee:= "LPT1"
   n_a_v_e_g_:= .F.
   gra:= Space(1)
   _resultado:= 0
   cusu:= Space(20)
   _xempresa:= " "
   vdireitos:= {}
   _xemp1:= " "
   _xemp2:= " "
   _xemp3:= " "
   config[3]:= "NUC"
   config[2]:= nnetwhoami()
   setcursor(1)
   load_util()
   private rodam:= {"NUC11", "NUC21", "NUC211", "NUC42", "NUC43", ;
      "NUC12", "NUC221", "NUC31", "NUC311", "NUC312", "NUC315", ;
      "NUC151", "NUC251", "NUC2511", "NUC252", "NUC2517", "NUC32", ;
      "NUC311", "NUC312", "NUC34", "NUC22", "NUC13", "NUC23", ;
      "NUC14", "NUC24", "NUC241", "NUC33", "NUC35", "NUC351", ;
      "NUC352", "NUC353", "NUC153", "NUC154", "NUC36", "NUC41", ;
      "NUC254", "NUC253", "NUC2541", "NUC2542", "NUC2531", "NUC37", ;
      "NUC2532", "NUC361", "NUC362", "NUC363", "NUC371", "NUC372", ;
      "NUC373", "NUC331", "NUC132", "NUC316", "NUC317", "NUC332", ;
      "NUC44", "NUC161", "NUC162", "NUC163", "NUC164", "NUC165", ;
      "NUC167", "NUC26", "NUC261", "NUC262", "NUC263", "NUC264", ;
      "NUC265", "NUC155", "NUC17", "NUC171", "NUC172", "NUC2554", ;
      "NUC27", "NUC271", "NUC2711", "NUC2712", "NUC2721", "NUC2722", ;
      "NUC38", "NUC381", "NUC382", "NUC3811", "NUC39", "NUC391", ;
      "NUC139", "NUC239", "NUC45", "NUC46"}
   moeda_corr:= "001"
   data_virad:= CToD("01/07/94")
   valor_vira:= 2750
   nivel1:= 1
   nivel2:= 1
   teste:= .T.
   set message to 23 center
   private menu1:= {}, menu2:= {}, menu3:= {}, menu4:= {}, mens1:= ;
      {}, mens2:= {}, mens3:= {}, mens4:= {}
   AAdd(menu1, " Clientes             ")
   AAdd(menu1, " Fornecedores         ")
   AAdd(menu1, " Tabelas              ")
   AAdd(menu1, " Contatos             ")
   AAdd(menu1, " Financeiro           ")
   AAdd(menu1, " Producao             ")
   AAdd(menu1, " Comercial            ")
   AAdd(mens1, "Cadastra Clientes    ")
   AAdd(mens1, "Cadastra Fornecedores")
   AAdd(mens1, "Cadastra Tabelas do Sistema")
   AAdd(mens1, "Cadastra Contatos")
   AAdd(mens1, "Cadastra Dados Financeiros")
   AAdd(mens1, "Cadastra Dados de Producao")
   AAdd(mens1, "Cadastra Dados Comerciais")
   AAdd(menu2, " Clientes             ")
   AAdd(menu2, " Fornecedores         ")
   AAdd(menu2, " Tabelas              ")
   AAdd(menu2, " Contatos             ")
   AAdd(menu2, " Financeiro           ")
   AAdd(menu2, " Producao             ")
   AAdd(menu2, " Comercial            ")
   AAdd(mens2, "Consulta, exclui e altera cadastro de Clientes")
   AAdd(mens2, "Consulta, exclui e altera cadastro de Fornecedores")
   AAdd(mens2, "Consulta, exclui e altera Tabelas")
   AAdd(mens2, "Consulta, exclui e altera Contatos")
   AAdd(mens2, "Consulta, exclui e altera Dados Financeiros")
   AAdd(mens2, "Consulta, exclui e altera Dados de Producao")
   AAdd(mens2, "Consulta, exclui e altera Dados Comerciais")
   AAdd(menu3, " Clientes             ")
   AAdd(menu3, " Fornecedores         ")
   AAdd(menu3, " Tabelas              ")
   AAdd(menu3, " Contatos             ")
   AAdd(menu3, " Financeiro           ")
   AAdd(menu3, " Producao             ")
   AAdd(menu3, " Comercial            ")
   AAdd(mens3, "Relatorios de Clientes")
   AAdd(mens3, "Relatorios de Fornecedores")
   AAdd(mens3, "Relatorios das Tabelas em geral")
   AAdd(mens3, "Relatorios de Contatos")
   AAdd(mens3, "Relatorios Financeiros")
   AAdd(mens3, "Relatorios de Producao")
   AAdd(mens3, "Relatorios Comerciais")
   AAdd(menu4, " Backup dos Arquivos ")
   AAdd(menu4, " Restaura Arquivos   ")
   AAdd(menu4, " Plano de Cores      ")
   AAdd(menu4, " Restaura Cor Padrao ")
   AAdd(menu4, " Configura Impressora")
   AAdd(menu4, " Configura Senha     ")
   AAdd(mens4, ;
      "Executa Backup dos Arquivos do sistema em disquetes")
   AAdd(mens4, ;
      "Executa Restauracao dos Arquivos em caso de perda de dados")
   AAdd(mens4, "Altera a configuracao do plano de cores do sistema")
   AAdd(mens4, ;
      "Restaura as cores originais do programa (Padrao inicial)")
   AAdd(mens4, "Configura tipo de Impressora")
   AAdd(mens4, "Configura Senha de acessos ao Sistema")
   private xtela_entr, i_m_p_r_ee
   public usr_memo, gra, _resultado
   public xvid_imp:= 73, _tabelas
   gra:= Space(1)
   usr_memo:= Space(10)
   i_m_p_r_ee:= "LPT1"
   _xsistema:= " Controle de Fogos  "
   _tabelas:= Nil
   private xdata_cont, xmoeda_con, xvalor_con, xind_reaj, xdata_fim, ;
      xper_reaj, n_a_v_e_g_:= .F., loop_help:= 0, niv_oper:= "3"
   handle:= fopen("EMPRESA.CFG", 0)
   _xempresa:= Trim(freadstr(handle, 30))
   fclose(handle)
   do case
   case _xempresa = "MARFRAN"
      _xemp1:= "MARFRAN"
      _xemp2:= "ENG/COM"
      _xemp3:= "MARFRAN-Eng. e Comercio Ltda"
   case _xempresa = "QUALIMAN"
      _xemp1:= "QUALIMAN"
      _xemp2:= "QUAL/MAN"
      _xemp3:= "Qualidade em Manutencao Ltda"
   case _xempresa = "GERENCIA"
      _xemp1:= "GERENCIA"
      _xemp2:= "AD. BENS"
      _xemp3:= "Administradora de Bens Ltda"
   case _xempresa = "CLR CONSULTORES"
      _xemp1:= "C.L.R."
      _xemp2:= "CONSULT."
      _xemp3:= " "
   case _xempresa = "FOGOS NUCLEAR"
      _xemp1:= "FOGOS"
      _xemp2:= "NUCLEAR"
      _xemp3:= " "
   case _xempresa = "FOGOS SAO JORGE"
      _xemp1:= "FOGOS"
      _xemp2:= "SAO JORGE"
      _xemp3:= " "
   case _xempresa = "FOGOS ESTRELA"
      _xemp1:= "FOGOS"
      _xemp2:= "ESTRELA"
      _xemp3:= " "
   case _xempresa = "A.B.C.J. PEGA"
      _xemp1:= "A.B.C.J"
      _xemp2:= "PEGA"
      _xemp3:= " "
   case _xempresa = "SOCIEDADE AUX"
      _xemp1:= "SOCIEDADE"
      _xemp2:= "AUXILIADORA"
      _xemp3:= " "
   case _xempresa = "MISTER MAGOO"
      _xemp1:= "MISTER"
      _xemp2:= "MAGOO"
      _xemp3:= " "
   otherwise
      _xempresa:= "POINTER INFO."
      _xemp1:= "POINTER"
      _xemp2:= "INFORMAT"
      _xemp3:= " "
   endcase
   set color to (cor[11])
   @  0,  0 clear to  0, 79
   @  0,  0 say padc(_xempresa, 18) + "" + _xsistema + "" + " " + ;
      DToC(Date()) + " " + "" + Space(11) + "" + Space(11) + ""
   set color to (cor[12])
   window(3, 0, 22, 79, "Ŀ ")
   if (_xempresa $ "SOCIEDADE AUX/CLR CONSULTORES")
      if (_xempresa = "SOCIEDADE")
         alfa6("SOCIEDADE", 7, 9, 0)
         alfa6("AUXILIADORA", 13, 2, 0)
      else
         alfa2("C L R", 10, Int((80 - Len(_xemp1) * 9) / 2), 0)
      endif
   else
      alfa2(_xemp1, 6, Int((80 - Len(_xemp1) * 9) / 2), 0)
      alfa2(_xemp1, 6, Int((80 - Len(_xemp1) * 9) / 2), 0)
      if (_xemp2 = "SAO JORGE")
         alfa2(SubStr(_xemp2, 1, 3), 14, 3, 0)
         alfa2(SubStr(_xemp2, 5, 5), 14, 34, 0)
      else
         alfa2(_xemp2, 14, Int((80 - Len(_xemp2) * 9) / 2), 0)
      endif
   endif
   xtela_entr:= SaveScreen(4, 1, 21, 78)
   sinal("M E N U", "PRINCIPAL")
   xcx2:= .T.
   insovr(.T.)
   indexar(.F., "TODOS")
   chec_psw(import, "NUC", 12, 51)
   cfg_print()
   mover_sub_:= .F.
   showtime(2, 71, .F., SubStr(SubStr(cor[14], At(",", cor[14]) + ;
      1), 1, At(",", SubStr(cor[14], At(",", cor[14]) + 1)) - 1))
   do while (.T.)
      if (nextkey() == 0)
         RestScreen(4, 1, 21, 78, xtela_entr)
         xtempo_men:= Seconds()
      endif
      sinal("M E N U", "PRINCIPAL")
      set color to 
      @ 23,  0 say Space(80)
      ms250("Use as setas para escolher sua opo e <ENTER> ou <ESC> para sair", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      set color to (cor[14])
      @  2,  0 clear to  2, 79
      nivel1:= menu_prt(Local1, nivel1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 0)
      if (nivel1 != 0)
         do case
         case nivel1 = 1
            xcol:= 2
         case nivel1 = 2
            xcol:= 19
         case nivel1 = 3
            xcol:= 36
         case nivel1 = 4
            xcol:= 53
         endcase
         if (acesso("NUC" + Str(nivel1, 1) + "0000"))
            sub_menu(xcol)
         endif
      else
         if (DoW(Date()) == 6)
            if (!file(DToS(Date()) + ".mem"))
               closedata("ALL")
               indexar(.T., "TODOS", Nil, "COMPACTAR")
               closedata("ALL")
               erase (DToS(Date() - 7) + ".mem")
               erase (DToS(Date() - 14) + ".mem")
               erase (DToS(Date() - 21) + ".mem")
               save all like NIVEL1 to (DToS(Date()) + ".mem")
            endif
         endif
         set color to 
         clear screen
         readkill(.T.)
         getlist:= {}
         @  0,  0 say padc("Pointer Informatica Ltda", 80) color ;
            "BG/B"
         ? 
         ? 
         showtime()
         setcursor(1)
         @  2, 71 say "        "
         return
      endif
   enddo

********************************
static function ESCOLHE(Arg1)

   local Local1
   ind:= inicio
   if (Arg1 = 4 .OR. Arg1 = 19)
      keyboard Chr(LastKey()) + Chr(13)
      return inicio
   elseif (Arg1 = 5 .OR. Arg1 = 24)
      inicio:= iif(Arg1 = 5, iif(inicio = 1, tam, --inicio), ;
         iif(inicio = tam, 1, ++inicio))
      return 0
   else
      return iif((Local1:= ascan(op_1, Upper(Chr(Arg1)))) != 0, ;
         op_2[Local1], -1)
   endif

********************************
static procedure IMP_LINHA(Arg1, Arg2, Arg3)

   set color to (Arg2)
   @ vet_opc[Arg1][1], vet_opc[Arg1][2] say SubStr(vet_opc[Arg1][3], ;
      1, At("", vet_opc[Arg1][3]) - 1)
   set color to (Arg3)
   @ vet_opc[Arg1][1], Col() say SubStr(vet_opc[Arg1][3], At("", ;
      vet_opc[Arg1][3]) + 1, 1)
   set color to (Arg2)
   @ vet_opc[Arg1][1], Col() say SubStr(vet_opc[Arg1][3], At("", ;
      vet_opc[Arg1][3]) + 2)
   return

********************************
procedure UTIL


********************************
procedure DATAS


********************************
procedure SUB_MENU

   local Local1
   Local1:= {}
   Static1:= iif(Static1 = Nil, 1, Static1)
   parameters coluna
   private linha
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   qual_menu:= "MENU" + Str(nivel1, 1)
   qual_mens:= "MENS" + Str(nivel1, 1)
   mover_sub_:= .F.
   for linha:= 1 to Len(&qual_menu)
      AAdd(Local1, {linha + 4, coluna + 1, &(qual_menu)[linha], ;
         padc(&(qual_mens)[linha], 80)})
   next
   save screen to cesar
   do while (.T.)
      sinal("SUB-MENU", Upper(Trim(SubStr(opc_sinal[nivel1][3], 3, ;
         11))))
      set color to (cor[16])
      if (nivel1 < 4)
         window(4, xcol, Len(&qual_menu) + 5, xcol + 23, ;
            "Ŀ ", .T.)
      else
         window(4, xcol, Len(&qual_menu) + 5, xcol + 22, ;
            "Ŀ ", .T.)
      endif
      Static1:= mnu_prt(Local1, Static1, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      if (Static1 != 0)
         if (LastKey() = K_LEFT .OR. LastKey() = K_RIGHT)
            set color to (cor[12])
            @ 23,  0 say Space(80)
            exit
         endif
         setcursor(1)
         xprog:= "NUC" + Str(nivel1, 1) + iif(Static1 < 10, ;
            Str(Static1, 1), SubStr(Str(Static1, 2), 2, 1))
         if (ascan(rodam, xprog) == 0)
            desenv()
         elseif (acesso(xprog))
            &(xprog)()
         endif
      else
         set color to (cor[12])
         @ 23,  0 say Space(80)
         exit
      endif
      clear typeahead
      restore screen from cesar
   enddo
   @  4, xcol clear to Len(&qual_menu) + 6, xcol + 25
   set color to (cor[12])
   @  4, 79 to 15, 79
   set color to 
   return

********************************
function AUMENTA(Arg1)

   local Local1:= Len(Arg1), Local2:= 0, Local3:= ""
   for Local2:= 1 to Local1
      Local3:= Local3 + Chr(Asc(SubStr(Arg1, Local2, 1)) + 20)
   next
   return Local3

********************************
procedure NUC01


********************************
procedure DESENV

   local Local1
   save screen to Local1
   tone(850, 1)
   set color to (cor[1])
   window(6, 19, 18, 59, "ͻȺ ")
   setcursor(0)
   @  8, 21 say "              Atencao !              "
   @ 10, 21 say "     A opcao selecionada, nao se     "
   @ 11, 21 say "        encontra disponivel.         "
   @ 12, 21 say "                                     "
   @ 13, 21 say "      Opcao em desenvolvimento !     "
   @ 14, 21 say "                                     "
   @ 16, 21 say " Pressione qualquer tecla p/ sair... "
   set color to 
   InKey(0)
   restore screen from Local1
   return

********************************
procedure LOAD_UTIL

   SetKey(K_ALT_F9, {|| i_m_p_r_e_()})
   SetKey(K_ALT_F8, {|| c_o_t_e_c_()})
   SetKey(K_ALT_F7, {|| m_e_m_o_r_()})
   SetKey(K_ALT_F6, {|| d_e_b_u_g_()})
   SetKey(K_ALT_F5, {|| c_o_c_h_r_()})
   SetKey(K_ALT_F4, {|| s_t_a_t_u_()})
   SetKey(K_ALT_F3, {|| c_a_l_e_n_()})
   SetKey(K_ALT_F2, {|| c_a_l_c_()})
   SetKey(K_ALT_F1, {|| c_o_n_f_i_()})
   return

********************************
procedure M_S_D_O_S_

   local Local1
   save screen to Local1
   clear screen
   ? ;
      [.....Digite "EXIT" para voltar ao Programa que estava sendo executado.]
   run command
   restore screen from tela
   return

********************************
procedure SINAL_DIG

   sinal_:= iif(LastKey() = K_ALT_F8, "AF8", Upper(Chr(LastKey())))
   keyboard Chr(13)
   return

********************************
function MNU_PRT(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7)

   private inicio, vet_opc, op, tam, op_1, op_2, ind, setcor, setcur
   tam:= Len(Arg1)
   inicio:= iif(Arg2 > tam, tam, iif(Arg2 = 0, 1, Arg2))
   vet_opc:= aclone(Arg1)
   op_1:= {}
   op_2:= {}
   Arg3:= iif(Arg3 = Nil, SetColor(), Arg3)
   Arg4:= iif(Arg4 = Nil, Arg3, Arg4)
   Arg5:= iif(Arg5 = Nil, Arg4, Arg5)
   Arg6:= iif(Arg6 = Nil, Arg3, Arg6)
   Arg7:= iif(Arg7 = Nil, 80, Arg7)
   setcor:= SetColor()
   setcur:= setcursor(0)
   for ind:= 1 to tam
      AAdd(op_1, Upper(SubStr(LTrim(vet_opc[ind][3]), 1, 1)))
      AAdd(op_2, ind)
      AAdd(op_1, Upper(SubStr(LTrim(vet_opc[ind][3]), At("", ;
         vet_opc[ind][3]), 1)))
      AAdd(op_2, ind)
      imp_linha(ind, Arg3, Arg4)
   next
   ind:= inicio
   imp_linha(inicio, Arg5, Arg6)
   if (Arg7 != 0 .AND. Arg7 != Nil)
      when250(vet_opc[inicio][4], Set(_SET_MESSAGE), (80 - Arg7) / ;
         2, Arg3, Arg4, Arg7)
   endif
   do while (.T.)
      op:= InKey(0)
      if (op == 255)
         prot_tela()
         loop
      endif
      if (op == -28)
         keylock()
         loop
      endif
      if (op == 27)
         setcursor(setcur)
         set color to (setcor)
         return 0
      endif
      if (op == 13)
         setcursor(setcur)
         set color to (setcor)
         return inicio
      endif
      op:= escolhe(op)
      if (op == -1)
         loop
      endif
      if (LastKey() = K_RIGHT .OR. LastKey() = K_LEFT)
         return op
      endif
      imp_linha(ind, Arg3, Arg4)
      if (op > 0)
         imp_linha(op, Arg5, Arg6)
         if (Arg7 != 0 .AND. Arg7 != Nil)
            when250(vet_opc[op][4], Set(_SET_MESSAGE), (80 - Arg7) / ;
               2, Arg3, Arg4, Arg7)
         endif
         setcursor(setcur)
         set color to (setcor)
         return op
      endif
      imp_linha(inicio, Arg5, Arg6)
      if (Arg7 != 0 .AND. Arg7 != Nil)
         when250(vet_opc[inicio][4], Set(_SET_MESSAGE), (80 - Arg7) ;
            / 2, Arg3, Arg4, Arg7)
      endif
   enddo
   return ""

********************************
procedure C_A_L_C_

   SetKey(K_ALT_F2, Nil)
   ccaallcc()
   SetKey(K_ALT_F2, {|| c_a_l_c_()})
   InKey()
   return

********************************
procedure I_M_P_R_E_

   private op_imp, tela_imp, tecla_imp, arq_disco, tela_imp1
   save screen to tela_imp
   op_imp:= 1
   do while (op_imp != 0)
      set color to w+/g+
      @  6, 40 clear to 16, 55
      @  6, 40 to 16, 55 double
      @ 10, 41 to 10, 54
      @  7, 43 say "Configurar"
      @  8, 43 say "  saida   "
      @  9, 43 say " paralela "
      @ 17, 28 clear to 19, 67
      @ 17, 28 to 19, 67 double
      @ 18, 32 say "Configuracao atual : "
      set color to GR+/G+
      @ 18, 53 say Static2
      set color to w/n,n*/w
      @ 12, 43 prompt "   LPT1   "
      @ 14, 43 prompt "ARQ. DISCO"
      menu to op_imp
      if (op_imp = 1)
         Static2:= "LPT1"
      elseif (op_imp = 2)
         @ 17, 28 clear to 19, 67
         @ 17, 28 to 19, 67 double
         @ 18, 32 say "  Nome do arquivo :"
         arq_disco:= Trim(ler_teclas(12, 18, 52))
         if (Len(arq_disco) > 0)
            if (file(arq_disco))
               save screen to tela_imp1
               ? ""
               set color to 
               @ 20, 28 clear to 22, 67
               @ 20, 28 to 22, 67 double
               @ 21, 30 say "Arquivo ja exite, regrava (S/N) ? "
               tecla_imp:= InKey(0)
               if (Upper(Chr(tecla_imp)) = "S")
                  Static2:= arq_disco
               endif
               restore screen from tela_imp1
            else
               Static2:= arq_disco
            endif
         endif
      endif
   enddo
   i_m_p_r_ee:= Static2
   set printer to (Static2)
   restore screen from tela_imp
   set color to 
   return

********************************
procedure C_O_T_E_C_

   private tecla_func, tela, text_func, tecla_digi
   save screen to tela
   do while (.T.)
      set color to w+/g+
      @ 10, 16 clear to 14, 63
      @ 10, 16 to 14, 63 double
      @ 11, 18 say "Tecla a ser configurada......>>"
      @ 13, 18 say "Configurar com..>>"
      set color to w/n,n*/w
      tecla_digi:= Trim(ler_teclas(2, 11, 50))
      if (Len(tecla_digi) == 0)
         exit
      endif
      tecla_func:= Val(tecla_digi)
      if (tecla_func < 3 .OR. tecla_func > 30)
         loop
      endif
      text_func:= Trim(ler_teclas(25, 13, 37))
      set function tecla_func to text_func
      exit
   enddo
   restore screen from tela
   set color to 
   return

********************************
procedure M_E_M_O_R_

   private cor_atual, tela
   cor_atual:= SetColor()
   save screen to tela
   set color to n/w,w/w,n,w
   @ 10, 16 clear to 13, 63
   @ 10, 16 to 13, 63 double
   @ 11, 18 say "Memoria Livre............>>            Bytes"
   @ 12, 18 say "Espaco Livre em Disco....>>            Bytes"
   @ 11, 46 say memory(0) * 1024 picture "@E 99,999,999"
   @ 12, 46 say diskspace(0) picture "@E 99,999,999"
   setcursor(0)
   InKey(0)
   setcursor(1)
   set color to "&cor_atual"
   restore screen from tela
   return

********************************
procedure TRANS_CL

   xcod_cl:= cod_cl
   xnome_cl:= nome_cl
   xend_cl:= end_cl
   xbairro_cl:= bairro_cl
   xcid_cl:= cid_cl
   xest_cl:= est_cl
   xpais_cl:= pais_cl
   xcep_cl:= cep_cl
   xcpf_cl:= cpf_cl
   xcgc_cl:= cgc_cl
   xinsc_estc:= insc_estc
   xfax:= fax
   xtelex:= telex
   xfone:= fone
   xcod_vend:= cod_vend
   xcod_cond:= cod_cond
   xramal_fon:= ramal_fone
   xramal_fax:= ramal_fax
   xdt_cad:= dt_cad
   xval_cred:= val_cred
   xfantasia:= fantasia
   return

********************************
procedure FUNC0026


********************************
procedure D_E_B_U_G_

   private codigo, cor_atual, tela
   cor_atual:= SetColor()
   save screen to tela
   set color to 
   @ 23,  0 clear
   set color to n/n,n/n,n,w
   setcursor(0)
   accept to codigo
   setcursor(1)
   codigo:= Upper(codigo)
   if (codigo = "DEPURAR")
      altd(1)
   else
      altd(0)
   endif
   set color to (cor_atual)
   restore screen from tela
   return

********************************
procedure C_O_C_H_R_

   local Local1, Local2, Local3, Local4, Local5, Local6
   save screen to tela
   do while (.T.)
      set color to w+/g+
      @ 10, 16 clear to 16, 63
      @ 10, 16 to 16, 63 double
      @ 11, 18 say "Tecla a ser configurada......>>"
      @ 13, 18 say "Configurar com..>>"
      @ 15, 18 say "Digite os valores ASCII separados por barras"
      set color to w/n,n*/w
      tecla_digi:= Trim(ler_teclas(2, 11, 50))
      if (Len(tecla_digi) == 0)
         exit
      endif
      tecla_func:= Val(tecla_digi)
      if (tecla_func < 3 .OR. tecla_func > 30)
         loop
      endif
      text_func:= Trim(ler_teclas(25, 13, 37))
      text_func:= iif(SubStr(text_func, Len(text_func), 1) = "/", ;
         text_func, text_func + "/")
      val_ascii:= Space(0)
      do while (.T.)
         if (Len(val_ascii) == 0)
            val_ascii:= val_ascii + "chr(" + ;
               strzero(Val(SubStr(text_func, 1, At("/", text_func) - ;
               1)), 3) + ")"
         else
            val_ascii:= val_ascii + "+chr(" + ;
               strzero(Val(SubStr(text_func, 1, At("/", text_func) - ;
               1)), 3) + ")"
         endif
         tam_text1:= Len(text_func)
         tam_text2:= At("/", text_func)
         text_func:= SubStr(text_func, tam_text2 + 1, tam_text1 - ;
            tam_text2)
         if (Space(0) = text_func)
            exit
         endif
      enddo
      set function tecla_func to &Local4
      exit
   enddo
   restore screen from tela
   set color to 
   return

********************************
function ULT_DIA_ME(Arg1)

   return iif(Month(Arg1) != Month(Arg1 + 1), .T., .F.)

********************************
procedure INI_IMPOS

   xco_impos:= Space(12)
   xde_impos:= Space(30)
   xali_impos:= 0
   return

********************************
procedure S_T_A_T_U_

   private cor_atual, tela
   cor_atual:= SetColor()
   save screen to tela
   set color to bg/G+
   @ 10, 13 clear to 14, 58
   @ 10, 13 to 14, 58 double
   @ 12, 14 to 12, 57
   @ 11, 19 say "Status de SET DELETED .....>>"
   @ 13, 15 say "Barra de espacao comuta ON/OFF   <ESC> Sai"
   set color to N/G+
   @ 13, 39 say "ON"
   @ 13, 42 say "OFF"
   @ 13, 49 say "ESC"
   @ 11, 49 say Static3 + "  "
   do while (InKey(0) != K_ESC)
      if (LastKey() == K_SPACE)
         if (Static3 = "ON")
            Static3:= "OFF"
         else
            Static3:= "ON"
         endif
         @ 11, 49 say Static3 + "  "
      endif
   enddo
   set deleted (Static3)
   set color to (cor_atual)
   restore screen from tela
   return

********************************
function VAL_MA(Arg1)

   local Local1:= CToD("01/" + Arg1), Local2:= Val(SubStr(Arg1, 1, ;
      2)), Local3:= SaveScreen(23, 0, 24, 79), Local4
   if (Local2 < 1 .OR. Local2 > 12)
      return .F.
   endif
   if (Year(Local1) != Year(Date()))
      tone(800, 5)
      @ 23,  0 clear
      Local4:= ;
         ms250([O ano digitado e diferente do ano corrente do sistema. Esta "OK" (S/N) ?], ;
         24, 0, cor[6], cor[7], {78, 83}, Nil, 80, "C")
      RestScreen(23, 0, 24, 79, Local3)
      return Local4 = 83
   else
      return .T.
   endif

********************************
function INSERIR(Arg1, Arg2, Arg3)

   local Local1
   insere->(dbSeek(Arg1))
   do while (!insere->(RLock()))
   enddo
   if (Arg3 = "+")
      Local1:= iif(insere->codigo = 0, 1, insere->codigo + 1)
      replace insere->codigo with Local1
   elseif (Arg2 = insere->codigo)
      Local1:= iif(insere->codigo = 0, 0, insere->codigo - 1)
      replace insere->codigo with Local1
   endif
   commit
   insere->(dbUnlock())
   return Local1

********************************
procedure FUNC0000


********************************
procedure C_O_N_F_I_

   private cor_atual
   save screen
   cor_atual:= SetColor()
   set color to (cor[7])
   @  6, 16 clear to 19, 63
   @  6, 16 to 19, 63 double
   @  8, 17 to  8, 62 double
   set color to (cor[6])
   @  7, 18 say "     CONFIGURACAO DO TECLADO DE FUNCOES"
   @  9, 18 say "ALT + F1  -> Mostra Configuracao Defaul"
   @ 10, 18 say "ALT + F2  -> Carrega Calculadora"
   @ 11, 18 say "ALT + F3  -> Carrega Calendario"
   @ 12, 18 say "ALT + F4  -> Comuta SET DELETED On/Off"
   @ 13, 18 say "ALT + F5  -> Configura Valores ASCII (CHR)"
   @ 14, 18 say "ALT + F6  -> Acessa o Depurador em RUNTIME"
   @ 15, 18 say "ALT + F7  -> Mostra Memoria Livre"
   @ 16, 18 say "ALT + F8  -> Configura Tecaldo de Funcao"
   @ 17, 18 say "ALT + F9  -> Configura Saida p/ Impressora"
   @ 18, 18 say "ALT + F10 -> Mostra em Tela o ultimo relat."
   setcursor(0)
   InKey(0)
   setcursor(1)
   set color to (cor_atual)
   restore screen
   return

********************************
function D_TO_MA(Arg1)

   xdata:= DToS(Arg1)
   if (__SetCentury())
      return SubStr(xdata, 5, 2) + "/" + SubStr(xdata, 1, 4)
   else
      return SubStr(xdata, 5, 2) + "/" + SubStr(xdata, 3, 2)
   endif

********************************
procedure LIMPA_TAB

   set color to (cor[1])
   @  7, len_vet + 4 clear to  9, len_vet + 33
   set color to 
   return

********************************
procedure C_A_L_E_N_

   private tela, data, cursor, cor_, tecla, m_e_s, a_n_o, corm, corn
   tela:= SaveScreen(Static4, Static5, Static4 + 9, Static5 + 24)
   data:= Date()
   cursor:= setcursor()
   cor_:= SetColor()
   corm:= "w+/gr"
   corn:= "w/gr"
   set date british
   set century on
   setcursor(0)
   SetKey(K_ALT_F3, Nil)
   do while (LastKey() != K_ESC)
      RestScreen(Static4, Static5, Static4 + 9, Static5 + 24, tela)
      monta_cal(data, Static4, Static5)
      m_e_s:= Month(data)
      a_n_o:= Year(data)
      tecla:= InKey(0)
      do case
      case tecla = 5
         iif(--m_e_s < 1, (m_e_s:= 12, a_n_o:= iif(--a_n_o < 1, ;
            ++a_n_o, a_n_o)), m_e_s)
      case tecla = 24
         iif(++m_e_s > 12, (m_e_s:= 1, a_n_o:= iif(++a_n_o > 2999, ;
            --a_n_o, a_n_o)), m_e_s)
      case tecla = 19
         iif(--a_n_o < 1, ++a_n_o, a_n_o)
      case tecla = 4
         iif(++a_n_o > 2999, --a_n_o, a_n_o)
      endcase
      data:= CToD("01/" + Str(m_e_s, 2) + "/" + Str(a_n_o, 4))
   enddo
   set century off
   setcursor(cursor)
   set color to (cor_)
   RestScreen(Static4, Static5, Static4 + 9, Static5 + 24, tela)
   set key K_ALT_F3 to c_a_l_e_n_
   return

********************************
function MA_TO_S(Arg1)

   if (Len(Arg1) == 7)
      return SubStr(Arg1, 4, 4) + "/" + SubStr(Arg1, 1, 2)
   endif
   if (Set(_SET_DATEFORMAT) $ "dd/mm/yy dd-mm-yy dd.mm.yy")
      return SubStr(DToS(CToD("01/" + Arg1)), 1, 6)
   elseif (Set(_SET_DATEFORMAT) $ "mm/dd/yy#mm-dd-yy")
      return DToS(CToD(SubStr(Arg1, 1, 3) + "01" + SubStr(Arg1, 3, ;
         3)))
   else
      return DToS(CToD(SubStr(Arg1, 4, 2) + "/" + SubStr(Arg1, 1, 2) ;
         + "/01"))
   endif
   return Nil

********************************
function L_CPF_CGC

   set color to (cor[1])
   @ 12, 20 say Space(40)
   set color to 
   return .T.

********************************
static procedure MONTA_CAL(Arg1, Arg2, Arg3)

   local Local1, Local2, Local3, Local4
   Local1:= Arg2 + 3
   set color to (corm)
   @ Arg2, Arg3 clear to Arg2 + 7, Arg3 + 24
   @ Arg2 + 1, Arg3 + 1 say padc(mes_ext(Month(Arg1), 1) + "/" + ;
      Str(Year(Arg1), 4), 23)
   @ Arg2 + 2, Arg3 + 1 say " Do 2a 3a 4a 5a 6a Sa "
   Local3:= Month(Arg1)
   set color to (corn)
   Arg1:= CToD("01/" + Str(Local3, 2) + "/" + Str(Year(Arg1), 4))
   Local2:= Arg3 + (DoW(Arg1) * 3 - 1)
   do while (Local3 = Month(Arg1))
      if (Arg1 = Date())
         set color to gr*/w
         @ Local1, Local2 say Day(Arg1) picture "99"
         set color to (corn)
      else
         @ Local1, Local2 say Day(Arg1) picture "99"
      endif
      Local2:= Local2 + 3
      Arg1++
      if (DoW(Arg1) = 1 .AND. Local3 = Month(Arg1))
         Local2:= Arg3 + 2
         Local1++
         @ Local1, Arg3 say "                         "
      endif
   enddo
   set color to (corm)
   setcursor(cursor)
   @ Arg2, Arg3 to Row() + 1, Arg3 + 24 double
   return

********************************
function ADD_MA(Arg1, Arg2)

   local Local1, Local2, Local3, Local4
   Local4:= Len(Arg1)
   Local3:= Set(_SET_EPOCH)
   Local1:= Val(SubStr(Arg1, 1, 2)) + Arg2
   Local2:= Val(SubStr(Arg1, 4))
   if (Local4 == 5)
      Local2:= iif(Local2 < Local3 - 1900, Local2 + 2000, Local2 + ;
         1900)
   endif
   if (Abs(Local1) > 12)
      Local2:= Local2 + Int(Local1 / 12)
      Local1:= Local1 - Int(Local1 / 12) * 12
   endif
   if (Local1 < 0)
      Local1:= Local1 + 12
      Local2--
   endif
   if (Local1 = 0)
      Local1:= 12
      Local2--
   endif
   if (Local4 == 5)
      Local2:= iif(Local2 >= 2000, Local2 - 2000, Local2 - 1900)
   endif
   Local2:= iif(Local2 >= 10000, Local2 - 10000, Local2)
   if (Local4 == 5)
      return strzero(Local1, 2) + "/" + strzero(Local2, 2)
   else
      return strzero(Local1, 2) + "/" + strzero(Local2, 4)
   endif

********************************
procedure TRANS_VEI

   xcod_vei:= cod_vei
   xplaca_vei:= placa_vei
   xmarca_vei:= marca_vei
   xmodelo_ve:= modelo_vei
   xanof_vei:= anof_vei
   xcapc_vei:= capc_vei
   xcapp_vei:= capp_vei
   return

********************************
function __GETORIGI

   return iif(Len(qself()) == 13, qself()[13], Nil)

********************************
procedure CCAALLCC

   local Local1:= SaveScreen(0, 0, 24, 79), Local2:= .F., Local3:= ;
      .T., Local4:= setcursor(1), Local5:= {}, Local6
   Static6:= iif(ISNIL(Static6), 0, Static6)
   Static7:= iif(ISNIL(Static7), 2, Static7)
   private sinal_:= " ", num_disp, fgpaste, cor_calc:= SetColor(), ;
      lisu_:= 1, cosu_:= 40, sinal_ant:= " ", drvcorget:= ;
      SubStr(cor[4], 1, At(",", cor[4]) - 1), drvcormsg:= ;
      SubStr(cor[4], 1, At(",", cor[4]) - 1), fgint:= .T.
   if (Type("drvcalc") = "C")
      lisu_:= Val(Left(drvcalc, 2))
      cosu_:= Val(SubStr(drvcalc, 3))
   endif
   fgpaste:= !Empty(readvar()) .AND. Left(readvar(), 3) != "OP_"
   SetKey(K_F6, Nil)
   SetKey(35, {|| sinal_dig()})
   SetKey(70, {|| sinal_dig()})
   SetKey(102, {|| sinal_dig()})
   SetKey(37, {|| sinal_dig()})
   SetKey(42, {|| sinal_dig()})
   SetKey(43, {|| sinal_dig()})
   SetKey(45, {|| sinal_dig()})
   SetKey(47, {|| sinal_dig()})
   SetKey(61, {|| sinal_dig()})
   SetKey(94, {|| sinal_dig()})
   SetKey(99, {|| sinal_dig()})
   SetKey(67, {|| sinal_dig()})
   if (fgpaste)
      SetKey(82, {|| sinal_dig()})
      SetKey(114, {|| sinal_dig()})
   endif
   SetKey(K_ALT_F8, {|| sinal_dig()})
   do while (.T.)
      if (Local3)
         set color to (drvcormsg)
         @ lisu_, cosu_ clear to lisu_ + 8, cosu_ + 24
         @ lisu_, cosu_ to lisu_ + 8, cosu_ + 24 double
         @ lisu_ + 1, cosu_ + 2 say "ͻ"
         @ lisu_ + 2, cosu_ + 2 say "                   "
         @ lisu_ + 3, cosu_ + 2 say "                   "
         @ lisu_ + 4, cosu_ + 2 say "ͼ"
         @ lisu_ + 5, cosu_ + 2 say " 7 8 9 C     +  -  * "
         @ lisu_ + 6, cosu_ + 2 say " 4 5 6 .     /  %  ^ "
         @ lisu_ + 7, cosu_ + 2 say " 1 2 3 0        #  F "
         set color to (drvcorget)
         @ lisu_ + 8, cosu_ + 2 say iif(fgpaste, ;
            "R, resultado no campo", "")
         set color to (drvcorget + "," + drvcorget + ",,," + ;
            drvcorget)
         Local3:= .F.
      endif
      Local6:= Replicate("9", 18 - Static7) + iif(Static7 > 0, "." + ;
         Replicate("9", Static7), "")
      num_disp:= 0.0
      @ lisu_ + 2, cosu_ + 3 say "="
      SetPos(lisu_ + 2, cosu_ + iif(Static7 = 0, 5, 4))
      AAdd(Local5, __Get({|_1| iif(ISNIL(_1), Static6, Static6:= ;
         _1)}, "nu_calc", Local6, Nil, Nil):display())
      readkill(.T.)
      Local5:= {}
      @ lisu_ + 3, cosu_ + 3 say sinal_ant
      SetPos(lisu_ + 3, cosu_ + iif(Static7 = 0, 5, 4))
      AAdd(Local5, __Get(Nil, "num_disp", Local6, Nil, Nil):display())
      ReadModal(Local5)
      Local5:= {}
      do case
      case LastKey() = K_ESC .OR. sinal_ = "R"
         if (fgpaste .AND. sinal_ = "R")
            keyboard " " + alltrim(Transform(Static6, Local6))
         else
            clear typeahead
            keyboard "0"
            InKey()
            clear typeahead
         endif
         exit
      case sinal_ = "F"
         do while (InKey(0) < 48 .OR. LastKey() > 57)
         enddo
         Static7:= LastKey() - 48
         sinal_:= " "
      case sinal_ = "C"
         Static6:= 0
         sinal_:= " "
      case sinal_ = "#"
         if (!Empty(num_disp))
            if (sinal_ant = "-")
               Static6:= Static6 - Sqrt(num_disp)
            else
               Static6:= Static6 + Sqrt(num_disp)
            endif
         else
            Static6:= Sqrt(Static6)
         endif
         sinal_:= " "
      case sinal_ant = "-"
         Static6:= Static6 - num_disp
      case sinal_ant = "*"
         Static6:= Static6 * num_disp
      case sinal_ant = "/"
         Static6:= Static6 / num_disp
      case sinal_ant = "^"
         Static6:= Static6 ^ num_disp
      case sinal_ant = "%"
         Static6:= Static6 / 100 * num_disp
      otherwise
         Static6:= Static6 + num_disp
      endcase
      sinal_:= iif(sinal_ = "=", " ", sinal_)
      sinal_ant:= sinal_
      sinal_:= " "
   enddo
   set color to (cor_calc)
   setcursor(Local4)
   SetKey(35, Nil)
   SetKey(36, Nil)
   SetKey(37, Nil)
   SetKey(42, Nil)
   SetKey(43, Nil)
   SetKey(45, Nil)
   SetKey(47, Nil)
   SetKey(67, Nil)
   SetKey(94, Nil)
   SetKey(99, Nil)
   SetKey(82, Nil)
   SetKey(114, Nil)
   RestScreen(0, 0, 24, 79, Local1)
   return

********************************
function DIF_MA(Arg1, Arg2)

   local Local1, Local2, Local3, Local4
   Local3:= Val(SubStr(Arg2, 4))
   Local4:= Val(SubStr(Arg1, 4))
   Local3:= iif(Local3 < 50, Local3 + 2000, Local3 + 1900)
   Local4:= iif(Local4 < 50, Local4 + 2000, Local4 + 1900)
   Local1:= Val(SubStr(Arg2, 1, 2)) - Val(SubStr(Arg1, 1, 2))
   Local2:= Local3 - Local4
   if (Local1 == 0)
      Local1:= Local2 * 12
   elseif (Local1 < 0)
      Local2--
      Local1:= Local2 * 12 + (Local1 + 12)
   else
      Local1:= Local2 * 12 + Local1
   endif
   return Local1

********************************
procedure LIMPA_CL

   set color to (cor[1])
   @  5, 36 say Space(40)
   @  7, 20 clear to  9, 76
   @ 10, 20 clear to 10, 25
   @ 10, 36 clear to 10, 37
   @ 11, 20 clear to 11, 41
   @ 10, 57 clear to 11, 76
   @ 12, 20 say Space(40)
   @ 13, 20 say Space(18)
   @ 14, 20 clear to 15, 34
   @ 14, 57 clear to 15, 76
   @ 16, 20 clear to 19, 76
   set color to 
   return

********************************
procedure GRAVA_FO

   replace forneced->cod_fo with xcod_fo
   replace forneced->nome_fo with xnome_fo
   replace forneced->end_fo with xend_fo
   replace forneced->bairro_fo with xbairro_fo
   replace forneced->cid_fo with xcid_fo
   replace forneced->est_fo with xest_fo
   replace forneced->cep_fo with xcep_fo
   replace forneced->pr_fo with xpr_pagto
   replace forneced->cgc_fo with xcgc_fo
   replace forneced->insc_estf with xinsc_estf
   replace forneced->fax with xfax
   replace forneced->telex with xtelex
   replace forneced->fone with xfone
   return

********************************
procedure INI_ITEM

   xco_mp:= Space(4)
   xqt_pe_mp:= xqt_re_mp:= xval_mp:= xper_icms:= xper_ipi:= 0
   return

********************************
procedure NUC11

   local Local1, Local2, Local3
   Local2:= {}
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite Nome do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Endereco do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Bairro do Cliente ou tecle <ESC> p/ sair", ;
      "Digite a Cidade do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Estado do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o CEP do cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CPF do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CGC do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero da Insc. Estadual do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFAX do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Contato do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFONE do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Codigo da Condicao do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do telefone ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do fax ou tecle <ESC> p/ sair", ;
      "Digite a Data de Aprovacao do Cadastro ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Credito Aprovado ou tecle <ESC> p/ sair", ;
      "Digite o Nome Fantasia ou tecle <ESC> p/ sair", ;
      "Digite a Sigla do pais ou tecle <ESC> para sair"}
   private xcod_cl, xnome_cl, xend_cl, xbairro_cl, xcid_cl, xest_cl, ;
      xcep_cl, xcpf_cl, xcgc_cl, xinsc_estc, xfax, xtelex, xfone, ;
      xcod_vend, xhistorico, xramal_fon, xramal_fax, xcod_cond, ;
      xdt_cad, xval_cred, m_clientes, xfantasia, xpais_cl
   AAdd(Local2, {7, 21, " Pessoa Juridica ", ;
      padc("Cadastra Pessoa Juridica", 80)})
   AAdd(Local2, {8, 21, " Pessoa Fisica   ", ;
      padc("Cadastra Pessoa Fisica", 80)})
   sinal("SUB-MENU", "CLIENTES")
   m_clientes:= 1
   do while (.T.)
      set color to (cor[14])
      Local3:= window(6, 20, 9, 38, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local2, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      if (m_clientes = 0)
         restscr(Local3)
         return
      else
         nuc111()
         restscr(Local3)
      endif
   enddo

********************************
procedure INI_CL

   xnome_cl:= Space(40)
   xend_cl:= Space(45)
   xbairro_cl:= Space(25)
   xcid_cl:= Space(35)
   xest_cl:= Space(2)
   xpais_cl:= Space(2)
   xcep_cl:= Space(8)
   xcpf_cl:= Space(11)
   xcgc_cl:= Space(14)
   xinsc_estc:= Space(18)
   xfax:= Space(13)
   xtelex:= Space(15)
   xfone:= Space(13)
   xcod_vend:= Space(3)
   xcod_cond:= Space(3)
   xhistorico:= Space(10)
   xramal_fon:= Space(9)
   xramal_fax:= Space(9)
   xdt_cad:= CToD("")
   xval_cred:= 0
   xfantasia:= Space(40)
   return

********************************
function UPDATED

   return Static22

********************************
procedure NUC111

   save screen to xtela1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "CLIENTES")
   set color to (cor[1])
   window(4, 1, 20, 77, "ͻȺ ", .T.)
   t_clientes()
   ini_cl()
   select CLIENTES
   set order to 1
   goto bottom
   do while (.T.)
      clientes->(dbSetOrder(1))
      clientes->(dbGoBottom())
      xcod_cl:= strzero(Val(clientes->cod_cl) + 1, 5)
      set color to (cor[3])
      @  5, 20 get XCod_CL picture "@k 99999" valid ;
         localiza(stz(@xcod_cl), "CLIENTES", 1, "I") when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      do while (.T.)
         get_cl("INCLUSAO")
         read
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0 say Space(80)
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               ycod_cl:= xcod_cl
               xrecno:= clientes->(RecNo())
               clientes->(dbGoBottom())
               xcod_cl:= strzero(Val(clientes->cod_cl) + 1, 5)
               goto xrecno
               grava_cl()
               dbcommit()
               unlock
               if (ycod_cl != xcod_cl)
                  ms250("O codigo para este cliente foi alterado para " ;
                     + xcod_cl + ". Tecle [ESC] para continuar.", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               endif
            else
               erro_lock()
            endif
         endif
         exit
      enddo
      ini_cl()
      limpa_cl()
   enddo
   return

********************************
procedure GRAVA_TAB

   &(vet_alias[xxxnome] + "->CODIGO"):= xcodigo
   &(vet_alias[xxxnome] + "->DESCRICAO"):= xdescricao
   &(vet_alias[xxxnome] + "->COMPLEMENTO"):= xcomplemen
   return

********************************
procedure NUC_WAG


********************************
procedure T_CLIENTES(Arg1)

   @  5,  3 say "Codigo Cliente.:       Cliente.:"
   @  6,  2 to  6, 76
   @  7,  3 say "Endereco.......:"
   @  8,  3 say "Bairro.........:"
   @  9,  3 say "Cidade.........:"
   @ 10,  3 say ;
      "Estado.........:           Pais:             Dt Cad.:"
   @ 11,  3 say ;
      "Cep............:                             Credito:"
   @ 12,  3 say iif(m_clientes = 1, "CGC............:", ;
      "CPF............:")
   @ 13,  3 say "Inscr. Estadual:"
   @ 14,  3 say ;
      "Numero Telefone:                             Ramal..:"
   @ 15,  3 say ;
      "Numero do Fax..:                             Ramal..:"
   @ 16,  3 say "Contato Cliente:"
   @ 17,  3 say "Condic. Cliente:"
   @ 18,  3 say "Codigo Vendedor:"
   @ 19,  3 say "Nome Fantasia..:"
   set color to 
   return

********************************
procedure TEL_TAB

   set color to (cor[1])
   window(4, 1, 10, len_vet + 35, "ͻȺ ", .T.)
   @  5,  3 say vet_cod[iif(m_tabelas = 11, 8, m_tabelas)]
   @  6,  2 to  6, len_vet + 34
   @  7,  3 say vet_des[iif(m_tabelas = 11, 8, m_tabelas)]
   @  9,  3 say "Complemento" + Replicate(".", len_vet - 12) + ":"
   set color to 
   return

********************************
procedure GRA_IMPOS

   replace impostos->co_impos with xco_impos
   replace impostos->de_impos with xde_impos
   replace impostos->ali_impos with xali_impos
   return

********************************
procedure GET_CL(Arg1)

   Arg1:= iif(Arg1 = Nil, "NADA", Arg1)
   set color to (cor[3])
   @  5, 36 get XNOME_CL valid !Empty(xnome_cl) when ;
      mens_when(mens1[2])
   @  7, 20 get XEND_CL when mens_when(mens1[3])
   @  8, 20 get XBAIRRO_CL when mens_when(mens1[4])
   @  9, 20 get XCID_CL when mens_when(mens1[5])
   @ 10, 36 get Xpais_CL picture "@! AA" when mens_when(mens1[21])
   @ 10, 20 get XEST_CL picture "@! AA" valid LastKey() = K_UP .OR. ;
      !Empty(xest_cl) .AND. iif(xpais_cl = "BR", localiza(xest_cl, ;
      "TAB_UF", 1, "M"), .T.) when mens_when(mens1[6])
   @ 11, 20 get XCEP_CL picture "@R 99.999-999" when ;
      mens_when(mens1[7])
   if (m_clientes == 1)
      @ 12, 20 get XCGC_CL picture "@R 99.999.999/9999-99" valid ;
         sb() .OR. iif(Empty(xcgc_cl), .T., checa_cgc(xcgc_cl) .AND. ;
         iif(Arg1 = "MANUTENCAO", nuc1111(), iif(Arg1 = "INCLUSAO", ;
         localiza(xcgc_cl, "CLIENTES", 5, "I"), .T.))) when ;
         mens_when(mens1[9]) .AND. l_cpf_cgc()
   else
      Scroll(12, 26, 12, 29)
      @ 12, 20 get XCPF_CL picture "@R 999.999.999-99" valid ;
         LastKey() = K_UP .OR. iif(Empty(xcpf_cl), .T., ;
         cpf(Trim(xcpf_cl))) when mens_when(mens1[8]) .AND. ;
         l_cpf_cgc()
   endif
   @ 13, 20 get XINSC_ESTC when mens_when(mens1[10])
   @ 14, 20 get XFONE when mens_when(mens1[13])
   @ 14, 57 get XRAMAL_FONE picture "@!" when mens_when(mens1[16])
   @ 15, 20 get XFAX when mens_when(mens1[11])
   @ 15, 57 get XRAMAL_FAX picture "@!" when mens_when(mens1[17])
   @ 16, 20 get XTELEX when mens_when(mens1[12])
   @ 17, 20 get XCOD_COND picture "999" valid sb() .OR. ;
      localiza(strzero(xcod_cond, 3), "TAB_CCL", 1, "M", ;
      "DESCRICAO", 17, 24) when mens_when(mens1[15]) .AND. ;
      iif(ValType(xcod_cond) = "C", (xcod_cond:= Val(cod_cond)) = ;
      xcod_cond, .T.)
   @ 18, 20 get XCOD_VEND picture "999" valid sb() .OR. ;
      localiza(strzero(xcod_vend, 3), "TAB_VEN", 1, "M", "NOME_VEN", ;
      18, 24) when mens_when(mens1[14]) .AND. iif(ValType(xcod_vend) ;
      = "C", (xcod_vend:= Val(cod_vend)) = xcod_vend, .T.)
   @ 10, 57 get XDT_CAD picture "@D" when mens_when(mens1[18])
   @ 11, 57 get XVAL_CRED picture "@E 999,999,999.99" when ;
      mens_when(mens1[19])
   @ 19, 20 get XFANTASIA picture "@!" when mens_when(mens1[20])
   return

********************************
procedure LIMPA_FO

   set color to (cor[1])
   @  5, 36 say Space(40)
   @  7, 20 say Space(45)
   @  9, 20 clear to 17, 45
   @ 11, 57 say Space(2)
   @ 11, 67 say Space(10)
   @ 13, 56 clear to 17, 76
   set color to 
   return

********************************
procedure FUNC0031


********************************
procedure GRAVA_CL

   replace clientes->cod_cl with xcod_cl
   replace clientes->nome_cl with xnome_cl
   replace clientes->end_cl with xend_cl
   replace clientes->bairro_cl with xbairro_cl
   replace clientes->cid_cl with xcid_cl
   replace clientes->est_cl with xest_cl
   replace clientes->pais_cl with xpais_cl
   replace clientes->cep_cl with xcep_cl
   replace clientes->cpf_cl with xcpf_cl
   replace clientes->cgc_cl with xcgc_cl
   replace clientes->insc_estc with xinsc_estc
   replace clientes->fax with xfax
   replace clientes->telex with xtelex
   replace clientes->fone with xfone
   replace clientes->cod_vend with iif(ValType(xcod_vend) = "C", ;
      xcod_vend, strzero(xcod_vend, 3))
   replace clientes->cod_cond with iif(ValType(xcod_cond) = "C", ;
      xcod_cond, strzero(xcod_cond, 3))
   replace clientes->ramal_fone with xramal_fon
   replace clientes->ramal_fax with xramal_fax
   replace clientes->jur_fis with iif(m_clientes = 1, "J", "F")
   replace clientes->dt_cad with xdt_cad
   replace clientes->val_cred with xval_cred
   replace clientes->fantasia with xfantasia
   return

********************************
function NUC1111

   local Local1:= clientes->(indexord()), Local2:= clientes->(RecNo())
   clientes->(dbSetOrder(5))
   clientes->(dbSeek(xcgc_cl))
   if (clientes->(RecNo()) = Local2 .OR. clientes->(EOF()))
      clientes->(dbGoto(Local2))
      clientes->(dbSetOrder(Local1))
      return .T.
   else
      ms250("Este CGC ja esta cadastrado para o cliente " + ;
         clientes->(cod_cl) + ". Tecle [ESC] p/ continuar", 24, ;
         0, cor[6], cor[7], {27}, Nil, 80, "C")
      clientes->(dbGoto(Local2))
      clientes->(dbSetOrder(Local1))
      return .F.
   endif

********************************
procedure GET_TAB

   set color to (cor[3])
   @  7, len_vet + 4 get XDESCRICAO picture "@!" valid ;
      !Empty(xdescricao) when ;
      mens_when(vet_msg[iif(m_tabelas = 11, 8, m_tabelas)][2])
   @  9, len_vet + 4 get XCOMPLEMENTO picture "@!" when ;
      mens_when(vet_msg[iif(m_tabelas = 11, 8, m_tabelas)][3])
   return

********************************
procedure LIMPA_VEN

   set color to (cor[1])
   @  5, 36 say Space(40)
   @  7, 20 clear to 12, 76
   @ 13, 20 clear to 14, 34
   @ 13, 42 clear to 14, 76
   set color to 
   return

********************************
procedure NUC12

   local Local1, Local2
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Nome do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Endereco do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Bairro do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite a Cidade do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Estado do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o CEP da Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Produto Comercializado ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CGC do Fornecedor ou tecle <ESC> p/sair", ;
      "Digite o Numero da Insc. Estadual do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFAX do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Nome do contato do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFONE do Fornecedor ou tecle <ESC> p/ sair"}
   private xcod_fo, xnome_fo, xend_fo, xbairro_fo, xcid_fo, xest_fo, ;
      xcep_fo, xpr_pagto, xcgc_fo, xinsc_estf, xfax, xtelex, xfone, ;
      xtipo_fo, xhistorico
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "FORNECEDOR")
   select FORNECED
   set order to 1
   goto bottom
   t_forneced()
   ini_fo()
   do while (.T.)
      forneced->(dbSetOrder(1))
      forneced->(dbGoBottom())
      xcod_fo:= strzero(Val(forneced->cod_fo) + 1, 4)
      set color to (cor[3])
      @  5, 20 get XCOD_FO picture "@k 9999" valid ;
         localiza(stz(@xcod_fo), "FORNECED", 1, "I") when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      do while (.T.)
         get_fo()
         read
         if (LastKey() == K_ESC)
            exit
         endif
         set color to 
         @ 23,  0
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               ycod_fo:= xcod_fo
               xrecno:= forneced->(RecNo())
               forneced->(dbGoBottom())
               xcod_fo:= strzero(Val(forneced->cod_fo) + 1, 4)
               goto xrecno
               grava_fo()
               dbcommit()
               unlock
               if (ycod_fo != xcod_fo)
                  ms250("O codigo para este fornecedor foi alterado para " ;
                     + xcod_fo + ". Tecle [ESC] para continuar.", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               endif
            else
               erro_lock()
            endif
         endif
         exit
      enddo
      ini_fo()
      limpa_fo()
   enddo
   return

********************************
procedure INI_FO

   xnome_fo:= Space(40)
   xend_fo:= Space(45)
   xbairro_fo:= Space(25)
   xcid_fo:= Space(25)
   xest_fo:= Space(2)
   xcep_fo:= Space(8)
   xpr_pagto:= Space(200)
   xcgc_fo:= Space(14)
   xinsc_estf:= Space(18)
   xfax:= Space(13)
   xtelex:= Space(25)
   xfone:= Space(13)
   return

********************************
procedure TRANS_TAB

   xcodigo:= &(vet_alias[xxxnome] + "->CODIGO")
   xdescricao:= &(vet_alias[xxxnome] + "->DESCRICAO")
   xcomplemen:= &(vet_alias[xxxnome] + "->COMPLEMENTO")
   return

********************************
procedure TRA_IMPOS

   xco_impos:= impostos->co_impos
   xde_impos:= impostos->de_impos
   xali_impos:= impostos->ali_impos
   return

********************************
procedure T_FORNECED

   set color to (cor[1])
   window(4, 1, 18, 77, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Fornec..:       Fornec..:"
   @  6,  2 to  6, 76
   @  7,  3 say "Endereco.......:"
   @  9,  3 say "Bairro.........:"
   @ 11,  3 say ;
      "Cidade.........:                             Estado.:     Cep.:"
   @ 13,  3 say ;
      "Produto Comerc.:                             CGC....:"
   @ 15,  3 say ;
      "Insc.Estadual..:                             Nr.Fax.:"
   @ 17,  3 say ;
      "Contato........:                             Nr.Tel.:"
   set color to 
   return

********************************
procedure T_VEN

   set color to (cor[1])
   window(4, 1, 15, 77, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Vendedor:       Vendedor:"
   @  6,  2 to  6, 76
   @  7,  3 say "Endereco.......:"
   @  8,  3 say "Bairro.........:"
   @  9,  3 say "Cidade.........:"
   @ 10,  3 say "Estado.........:"
   @ 11,  3 say "Cep............:"
   @ 12,  3 say "CPF............:"
   @ 13,  3 say "Numero Telefone:                Ramal: "
   @ 14,  3 say "Numero do Fax..:                Ramal:"
   set color to 
   return

********************************
function GETACTIVE(Arg1)

   local Local1
   Local1:= Static28
   if (PCount() > 0)
      Static28:= Arg1
   endif
   return Local1

********************************
procedure GET_FO

   set color to (cor[3])
   @  5, 36 get XNOME_FO valid !Empty(xnome_fo) when ;
      mens_when(mens1[2])
   @  7, 20 get XEND_FO when mens_when(mens1[3])
   @  9, 20 get XBAIRRO_FO when mens_when(mens1[4])
   @ 11, 20 get XCID_FO when mens_when(mens1[5])
   @ 11, 57 get XEST_FO picture "@! AA" valid localiza(xest_fo, ;
      "TAB_UF", 1, "M") when mens_when(mens1[6])
   @ 11, 67 get XCEP_FO picture "@R 99.999-999" when ;
      mens_when(mens1[7])
   @ 13, 20 get XPR_PAGTO picture "@S27" when mens_when(mens1[8])
   @ 13, 57 get XCGC_FO picture "@R 99.999.999/9999-99" valid ;
      checa_cgc(xcgc_fo) when mens_when(mens1[9])
   @ 15, 20 get XINSC_ESTF when mens_when(mens1[10])
   @ 15, 57 get XFAX when mens_when(mens1[11])
   @ 17, 20 get XTELEX when mens_when(mens1[12])
   @ 17, 57 get XFONE when mens_when(mens1[13])
   return

********************************
procedure TRANS_FO

   xcod_fo:= cod_fo
   xnome_fo:= nome_fo
   xend_fo:= end_fo
   xbairro_fo:= bairro_fo
   xcid_fo:= cid_fo
   xest_fo:= est_fo
   xcep_fo:= cep_fo
   xpr_pagto:= pr_fo
   xcgc_fo:= cgc_fo
   xinsc_estf:= insc_estf
   xfax:= fax
   xtelex:= telex
   xfone:= fone
   return

********************************
procedure INI_I_VEN

   xco_prod:= Space(4)
   xqt_pe_pro:= xqt_en_pro:= xval_prod:= xal_icms:= xal_ipi:= 0
   return

********************************
procedure NUC13

   local Local1
   Local1:= {}
   AAdd(Local1, {9, 21, " Moedas               ", ;
      padc("Cadastra Moedas", 80)})
   AAdd(Local1, {10, 21, " Indices de Correcao  ", ;
      padc("Cadastra Indices de Correcao", 80)})
   AAdd(Local1, {11, 21, " Custo Geral de Fab.  ", ;
      padc("Cadastra Custo Geral de Fabricacao", 80)})
   AAdd(Local1, {12, 21, " Cond. do Cliente     ", ;
      padc("Cadastra Condicoes do Cliente", 80)})
   AAdd(Local1, {13, 21, " Unidade de Medida    ", ;
      padc("Cadastra Unidades de Medidas", 80)})
   AAdd(Local1, {14, 21, " Cond. de Pagamento   ", ;
      padc("Cadastra Condicoes de Pagamento", 80)})
   AAdd(Local1, {15, 21, " Transportadores      ", ;
      padc("Cadastra Transportadores", 80)})
   AAdd(Local1, {16, 21, " Vendedores           ", ;
      padc("Cadastra Vendedores", 80)})
   AAdd(Local1, {17, 21, " Impostos             ", ;
      padc("Cadastra Impostos", 80)})
   AAdd(Local1, {18, 21, " Veiculos             ", ;
      padc("Cadastra Veiculos", 80)})
   AAdd(Local1, {19, 21, " Setores              ", ;
      padc("Cadastra Setores", 80)})
   private xtela1
   save screen to xtela1
   @ 23,  0
   private vet_alias:= {}, vet_cod:= {}, vet_des:= {}, vet_msg:= {}, ;
      vet_acess:= {}
   AAdd(vet_alias, "TAB_MOE")
   AAdd(vet_alias, "TAB_IND")
   AAdd(vet_alias, "TAB_CGF")
   AAdd(vet_alias, "TAB_CCL")
   AAdd(vet_alias, "TAB_UNI")
   AAdd(vet_alias, "TAB_CPA")
   AAdd(vet_alias, "TAB_TRA")
   AAdd(vet_alias, "TAB_SET")
   AAdd(vet_acess, "NUC131MOE")
   AAdd(vet_acess, "NUC131IND")
   AAdd(vet_acess, "NUC131CGF")
   AAdd(vet_acess, "NUC131CCL")
   AAdd(vet_acess, "NUC131UNI")
   AAdd(vet_acess, "NUC131CPA")
   AAdd(vet_acess, "NUC131TRA")
   AAdd(vet_acess, "NUC131SET")
   AAdd(vet_cod, "Codigo do Moeda.:")
   AAdd(vet_des, "Nome do Moeda...:")
   AAdd(vet_cod, "Codigo do Indice.:")
   AAdd(vet_des, "Nome do Indice...:")
   AAdd(vet_cod, "Codigo do C.G.F....:")
   AAdd(vet_des, "Descricao do C.G.F.:")
   AAdd(vet_cod, "Codigo do Cond. Cliente....:")
   AAdd(vet_des, "Descricao da Cond. Cliente.:")
   AAdd(vet_cod, "Codigo do Unidade....:")
   AAdd(vet_des, "Descricao da Unidade.:")
   AAdd(vet_cod, "Codigo da cond. Pagamento....:")
   AAdd(vet_des, "Descricao da Cond. Pagamento.:")
   AAdd(vet_cod, "Codigo do Transportador..:")
   AAdd(vet_des, "Nome do Transportador....:")
   AAdd(vet_cod, "Codigo do Setor.:")
   AAdd(vet_des, "Nome do Setor...:")
   AAdd(vet_msg, ;
      {"Codigo da Moeda Indexadora ou tecle <ESC> p/ sair", ;
      "Nome da Moeda Indexadora", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo do Indice de Correcao Financeira ou tecle <ESC> p/ sair", ;
      "Nome do Indice de Correcao Financeira", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo do Custo Geral de Fabricacao ou tecle <ESC> p/ sair", ;
      "Descricao do Custo Geral de Fabricacao", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo da Condicao do Cliente (Quanto a Pagamento) ou tecle <ESC> p/ sair", ;
      "Descricao da Condicao do Cliente (Quanto a Pagamento)", ;
      "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo da Unidade de Medida ou tecle <ESC> p/ sair", ;
      "Descricao da Unidade de Medida", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo da Condicao do Prazo de Pagamento ou tecle <ESC> p/ sair", ;
      "Descricao da Condicao do Prazo de Pagamento", ;
      "Numero de Dias de Prazo de Pagamento separado por barras (/)"})
   AAdd(vet_msg, ;
      {"Codigo do Transportador ou tecle <ESC> p/ sair", ;
      "Nome do Transportador", "Placa do Veiculo"})
   AAdd(vet_msg, {"Codigo do Setor ou tecle <ESC> p/ sair", ;
      "Nome do Setor", "Complemento"})
   sinal("SUB-MENU", "TABELAS")
   m_tabelas:= 1
   do while (.T.)
      set color to (cor[14])
      window(8, 20, 20, 43, "Ŀ ", .T.)
      m_tabelas:= menu_prt(Local1, m_tabelas, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_tabelas = 0
         restore screen from xtela1
         commit
         return
      case m_tabelas = 8
         if (acesso("NUC132VEN"))
            nuc132()
         endif
      case m_tabelas = 10
         if (acesso("NUC133VEI"))
            nuc133()
         endif
      case m_tabelas = 9
         if (acesso("NUC139IMP"))
            nuc139()
         endif
      case acesso(vet_acess[iif(m_tabelas = 11, 8, m_tabelas)])
         nuc131(iif(m_tabelas = 11, 8, m_tabelas))
      endcase
   enddo

********************************
procedure GET_VEI

   set color to (cor[3])
   @  5, 36 get XPLACA_VEI picture "@! AAA-9999" valid ;
      !Empty(xplaca_vei) when mens_when(mens1[2])
   @  7, 20 get XMARCA_VEI picture "@!" when mens_when(mens1[3])
   @  8, 20 get XMODELO_VEI picture "@!" when mens_when(mens1[4])
   @  9, 20 get XANOF_VEI picture "9999" when mens_when(mens1[5])
   @ 10, 20 get XCAPC_VEI picture "@E 99,999" valid LastKey() = K_UP ;
      .OR. !Empty(xcapc_vei) when mens_when(mens1[6])
   @ 11, 20 get XCAPP_VEI picture "@E 99,999" valid LastKey() = K_UP ;
      .OR. !Empty(xcapp_vei) when mens_when(mens1[7])
   return

********************************
procedure GRAVA_VEI

   replace tab_vei->cod_vei with xcod_vei
   replace tab_vei->placa_vei with xplaca_vei
   replace tab_vei->marca_vei with xmarca_vei
   replace tab_vei->modelo_vei with xmodelo_ve
   replace tab_vei->anof_vei with xanof_vei
   replace tab_vei->capc_vei with xcapc_vei
   replace tab_vei->capp_vei with xcapp_vei
   return

********************************
procedure INI_VEI

   xplaca_vei:= Space(8)
   xmarca_vei:= Space(25)
   xmodelo_ve:= Space(25)
   xanof_vei:= Space(4)
   xcapc_vei:= 0
   xcapp_vei:= 0
   return

********************************
procedure INI_PRD

   xco_prod:= Space(4)
   xdt_prod:= CToD("")
   xqt_prod:= 0
   xco_set:= Space(3)
   return

********************************
procedure NUC131

   local Local1
   Local1:= setcursor()
   parameters xxxnome
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", vet_alias[xxxnome])
   private xcodigo, xdescricao, xcomplemen
   private len_vet:= Len(vet_cod[xxxnome])
   select (vet_alias[xxxnome])
   set order to 1
   tel_tab()
   xdescricao:= Space(30)
   xcomplemen:= Space(20)
   do while (.T.)
      setcursor(1)
      if (m_tabelas != 5)
         set order to 1
         goto bottom
         xcodigo:= strzero(iif(Empty(codigo), 1, Val(codigo)) + 1, 3)
         set color to (cor[3])
         @  5, len_vet + 4 get XCODIGO picture "999" valid ;
            localiza(xcodigo, vet_alias[xxxnome], 1, "I") .AND. ;
            !Empty(xcodigo) when ;
            mens_when(vet_msg[iif(m_tabelas = 11, 8, m_tabelas)][1])
         readkill(.T.)
         getlist:= {}
         set color to 
      else
         xcodigo:= "  "
         set color to (cor[3])
         @  5, len_vet + 4 get XCODIGO picture "@!A" valid ;
            localiza(xcodigo, vet_alias[xxxnome], 1, "I") .AND. ;
            !Empty(xcodigo) when ;
            mens_when(vet_msg[iif(m_tabelas = 11, 8, m_tabelas)][1])
         read
         set color to 
         if (LastKey() == K_ESC)
            setcursor(Local1)
            restore screen from xtela1
            return
         endif
      endif
      do while (.T.)
         get_tab()
         read
         set color to 
         if (LastKey() == K_ESC)
            restore screen from xtela1
            return
         endif
         @ 23,  0
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (m_tabelas != 5)
               if (addrec(5))
                  xrecno:= RecNo()
                  set order to 1
                  goto bottom
                  xcodigo:= strzero(iif(Empty(codigo), 1, ;
                     Val(codigo)) + 1, 3)
                  goto xrecno
                  grava_tab()
                  xcodigo:= strzero(Val(xcodigo) + 1, 3)
                  dbcommit()
                  unlock
               else
                  ms250("Nao foi possivel gravar o registro. Tecle [ESC] para continuar.", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               endif
            elseif (addrec(5))
               xrecno:= RecNo()
               seek xcodigo
               if (Found())
                  ms250("Este codigo acaba de ser usado por outro usuario. Tecle [ESC] para continuar.", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               else
                  goto xrecno
                  grava_tab()
                  dbcommit()
                  unlock
               endif
            else
               ms250("Nao foi possivel gravar o registro. Tecle [ESC] para continuar.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
            endif
         endif
         xdescricao:= Space(30)
         xcomplemen:= Space(20)
         limpa_tab()
         exit
      enddo
   enddo
   return

********************************
procedure GRAVA_VEN

   replace tab_ven->cod_ven with xcod_ven
   replace tab_ven->nome_ven with xnome_ven
   replace tab_ven->end_ven with xend_ven
   replace tab_ven->bairro_ven with xbairro_ve
   replace tab_ven->cid_ven with xcid_ven
   replace tab_ven->est_ven with xest_ven
   replace tab_ven->cep_ven with xcep_ven
   replace tab_ven->cpf_ven with xcpf_ven
   replace tab_ven->fax with xfax
   replace tab_ven->fone with xfone
   replace tab_ven->ramal_fone with xramal_fon
   replace tab_ven->ramal_fax with xramal_fax
   return

********************************
procedure INI_VEN

   xnome_ven:= Space(40)
   xend_ven:= Space(45)
   xbairro_ve:= Space(25)
   xcid_ven:= Space(25)
   xest_ven:= Space(2)
   xcep_ven:= Space(8)
   xcpf_ven:= Space(11)
   xfax:= Space(13)
   xfone:= Space(13)
   xramal_fon:= Space(9)
   xramal_fax:= Space(9)
   return

********************************
procedure LIM_IMPOS

   set color to (cor[1])
   @ xl + 2, xc + 27 clear to xl + 6, xc + 74
   set color to 
   return

********************************
procedure GRAVA_BC

   replace bancos->nr_banco with xnr_banco
   replace bancos->nome_ban with xnome_bc
   replace bancos->nr_agencia with xnr_ag
   replace bancos->nome_ag with xnome_ag
   replace bancos->end_ag with xend_ag
   replace bancos->cid_ag with xcid_ag
   replace bancos->est_ag with xest_ag
   replace bancos->cep_ag with xcep_ag
   replace bancos->nr_conta with xnr_conta
   replace bancos->cod_nosso with xcod_nosso
   replace bancos->che_esp with xche_esp
   return

********************************
procedure TRANS_PRD

   xco_prod:= producao->co_prod
   xdt_prod:= producao->dt_prod
   xqt_prod:= producao->qt_prod
   xco_set:= producao->co_set
   return

********************************
procedure NUC_CES


********************************
procedure NUC132

   local Local1
   Local1:= setcursor()
   private mens1:= ;
      {"Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite Nome do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Endereco do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Bairro do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite a Cidade do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Estado do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o CEP do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CPF do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFONE do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFAX do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do telefone do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do Fax do Vendedor ou tecle <ESC> p/ sair"}
   private xcod_ven, xnome_ven, xend_ven, xbairro_ve, xcid_ven, ;
      xest_ven, xcep_ven, xcpf_ven, xfax, xfone, xramal_fon, ;
      xramal_fax
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "VENDEDORES")
   t_ven()
   ini_ven()
   select TAB_VEN
   set order to 1
   goto bottom
   do while (.T.)
      setcursor(1)
      tab_ven->(dbSetOrder(1))
      tab_ven->(dbGoBottom())
      xcod_ven:= strzero(Val(tab_ven->cod_ven) + 1, 3)
      set color to (cor[3])
      @  5, 20 get XCOD_VEN picture "999" when mens_when(mens1[1])
      readkill(.T.)
      getlist:= {}
      set color to 
      do while (.T.)
         get_ven()
         read
         if (LastKey() == K_ESC)
            restore screen from xtela1
            setcursor(Local1)
            return
         endif
         set color to 
         @ 23,  0 say Space(80)
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               xrecno:= tab_ven->(RecNo())
               tab_ven->(dbGoBottom())
               xcod_ven:= strzero(Val(tab_ven->cod_ven) + 1, 3)
               goto xrecno
               grava_ven()
               dbcommit()
               unlock
            else
               erro_lock()
            endif
         endif
         exit
      enddo
      ini_ven()
      limpa_ven()
   enddo
   return

********************************
procedure T_VEI

   set color to (cor[1])
   window(4, 1, 12, 77, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Veiculo.:       Placa...:"
   @  6,  2 to  6, 76
   @  7,  3 say "Marca..........:"
   @  8,  3 say "Modelo.........:"
   @  9,  3 say "Ano Fabricacao.:"
   @ 10,  3 say "Cap. Caixas....:"
   @ 11,  3 say "Cap. Carga.....:"
   set color to 
   return

********************************
procedure TEL_IMPOS

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 7, xc + 76, "ͻȺ ", .T.)
   @ xl + 2, xc + 3 say "Codigo do Imposto....:"
   @ xl + 4, xc + 3 say "Nome do Imposto......:"
   @ xl + 6, xc + 3 say "Aliquota do Imposto..:"
   set color to 
   return

********************************
init procedure DBFINIT

   rddregiste("DBF", 1)
   return

********************************
procedure GET_VEN

   set color to (cor[3])
   @  5, 36 get XNOME_VEN valid !Empty(xnome_ven) when ;
      mens_when(mens1[2])
   @  7, 20 get XEND_VEN when mens_when(mens1[3])
   @  8, 20 get XBAIRRO_VEN when mens_when(mens1[4])
   @  9, 20 get XCID_VEN when mens_when(mens1[5])
   @ 10, 20 get XEST_VEN picture "@! AA" valid LastKey() = K_UP .OR. ;
      !Empty(xest_ven) .AND. localiza(xest_ven, "TAB_UF", 1, "M") ;
      when mens_when(mens1[6])
   @ 11, 20 get XCEP_VEN picture "@R 99.999-999" when ;
      mens_when(mens1[7])
   @ 12, 20 get XCPF_VEN picture "@R 999.999.999-99" valid ;
      cpf(Trim(xcpf_ven)) when mens_when(mens1[8])
   @ 13, 20 get XFONE when mens_when(mens1[9])
   @ 13, 42 get XRAMAL_FONE when mens_when(mens1[11])
   @ 14, 20 get XFAX when mens_when(mens1[10])
   @ 14, 42 get XRAMAL_FAX when mens_when(mens1[12])
   return

********************************
procedure TRANS_VEN

   xcod_ven:= cod_ven
   xnome_ven:= nome_ven
   xend_ven:= end_ven
   xbairro_ve:= bairro_ven
   xcid_ven:= cid_ven
   xest_ven:= est_ven
   xcep_ven:= cep_ven
   xcpf_ven:= cpf_ven
   xfax:= fax
   xfone:= fone
   xramal_fon:= ramal_fone
   xramal_fax:= ramal_fax
   return

********************************
procedure LIMPA_VEI

   set color to (cor[1])
   @  5, 36 say Space(40)
   @  7, 20 clear to 11, 76
   set color to 
   return

********************************
procedure FUNC0023


********************************
procedure NUC133

   local Local1
   Local1:= setcursor()
   private mens1:= ;
      {"Digite o Codigo do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite a Placa do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite o Marca do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite o Modelo do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite a Ano de Fabricacao do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite o Capacidade do Veiculo em Caixas Padrao ou tecle <ESC> p/ sair", ;
      "Digite o Capacidade do Veiculo em Peso ou tecle <ESC> p/ sair", ;
      Nil}
   private xcod_vei, xplaca_vei, xmarca_vei, xmodelo_ve, xanof_vei, ;
      xcapc_vei, xcapp_vei
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "VEICULOS")
   t_vei()
   ini_vei()
   select TAB_VEI
   set order to 1
   goto bottom
   do while (.T.)
      setcursor(1)
      tab_vei->(dbSetOrder(1))
      tab_vei->(dbGoBottom())
      xcod_vei:= strzero(Val(tab_vei->cod_vei) + 1, 3)
      set color to (cor[3])
      @  5, 20 get XCOD_VEI picture "999" when mens_when(mens1[1])
      readkill(.T.)
      getlist:= {}
      set color to 
      do while (.T.)
         get_vei()
         read
         if (LastKey() == K_ESC)
            restore screen from xtela1
            setcursor(Local1)
            return
         endif
         set color to 
         @ 23,  0 say Space(80)
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               xrecno:= tab_vei->(RecNo())
               tab_vei->(dbGoBottom())
               xcod_vei:= strzero(Val(tab_vei->cod_vei) + 1, 3)
               goto xrecno
               grava_vei()
               dbcommit()
               unlock
            else
               erro_lock()
            endif
         endif
         exit
      enddo
      ini_vei()
      limpa_vei()
   enddo
   return

********************************
procedure CAD_CRE

   do while (.T.)
      set color to (cor[3])
      setcursor(1)
      get_cre()
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         exit
      endif
      @ 23,  0 clear
      gra()
      if (gra = "A")
         loop
      elseif (gra = "G")
         select CONT_RER
         if (addrec(5))
            grav_rer()
            if (!xcx2)
               select CONT_REF
               if (addrec(5))
                  grav_ref()
                  unlock
               else
                  select CONT_RER
                  delete
               endif
            endif
            select CONT_RER
            unlock
         else
         endif
      endif
      exit
   enddo
   return

********************************
procedure TEL_CRE

   set color to (cor[1])
   @  5,  3 say "Numero documento...:"
   @  6,  2 to  6, 73
   @  7,  3 say "Codigo Cliente.....:"
   @  8,  3 say "Data da emissao....:"
   @  9,  3 say "Data do vencimento.:"
   @ 10,  3 say "Valor do Documento.:"
   @ 11,  3 say "Moeda do Documento.:"
   @ 12,  3 say "Referencia.........:"
   @ 13,  3 say "Banco/Carteira.....:"
   set color to 
   return

********************************
procedure TEL_CRE2

   set color to (cor[1])
   @ 16,  3 say "Data da Liquidacao.:"
   @ 17,  3 say "Valor do Juros.....:"
   @ 18,  3 say "Valor recebido.....:"
   set color to 
   return

********************************
procedure NUC139

   local Local1
   private mens:= {"Codigo do Imposto", "Descricao do Imposto", ;
      "Aliquota do Imposto"}
   private xco_impos, xde_impos, xali_impos
   private xl:= 3, xc:= 0, xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "IMPOSTOS")
   tel_impos()
   ini_impos()
   do while (.T.)
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 27 get XCO_IMPOS picture "@!" valid ;
         !Empty(xco_impos) when mens_when(mens[1])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      select IMPOSTOS
      set order to 1
      seek xco_impos
      if (Found())
         setcursor(1)
         set color to (cor[3])
         @ xl + 4, xc + 27 get DE_IMPOS
         @ xl + 6, xc + 27 get ALI_IMPOS
         readkill(.T.)
         getlist:= {}
         setcursor(0)
         set color to 
         mensagem("Imposto ja cadastrado. Tecle [ESC] para sair.", 27)
         ini_impos()
         lim_impos()
         loop
      endif
      do while (.T.)
         setcursor(1)
         set color to (cor[3])
         @ xl + 4, xc + 27 get XDE_IMPOS valid !Empty(xde_impos) ;
            when mens_when(mens[2])
         @ xl + 6, xc + 27 get XALI_IMPOS picture "99.99" valid ;
            !Empty(xali_impos) when mens_when(mens[3])
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               gra_impos()
               unlock
            else
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
            endif
         endif
         exit
      enddo
      ini_impos()
      lim_impos()
   enddo

********************************
procedure EXT_GET1

   set color to (cor[3])
   @ 10, 26 get XDAT_LANCA picture "@D" valid !Empty(xdat_lanca) ;
      when mens_when(mens1[12])
   @ 12, 26 get XHISTORICO picture "@S35" valid LastKey() = K_UP ;
      .OR. !Empty(xhistorico) when mens_when(mens1[13])
   @ 14, 26 get XVAL_LANCA picture "@E 999,999,999,999.99" valid ;
      LastKey() = K_UP .OR. !Empty(xval_lanca) when ;
      mens_when(mens1[15])
   @ 16, 26 get XNR_DOC picture "9999999999" valid LastKey() = K_UP ;
      .OR. !Empty(xnr_doc) when mens_when(mens1[16])
   @ 18, 26 get XD_C_LANCA picture "@!" valid LastKey() = K_UP .OR. ;
      xd_c_lanca $ "DC" .AND. tel_ext3() when mens_when(mens1[14])
   @ 18, 46 get XBLOQUEADO picture "@!" valid LastKey() = K_UP .OR. ;
      xbloqueado $ "SN" when ;
      mens_when(mens1[iif(xd_c_lanca = "C", 17, 18)]) .AND. ;
      iif(Empty(xbloqueado), xbloqueado:= iif(xd_c_lanca = "C", "N", ;
      "S"), xbloqueado) = xbloqueado
   return

********************************
function TEL_EXT3

   if (xd_c_lanca = "D")
      @ 18, 33 say "Compensado.:" color cor[1]
   else
      @ 18, 33 say "Bloqueado..:" color cor[1]
   endif
   return .T.

********************************
procedure TRANS_FPR

   xco_prod:= formula->co_prod
   xco_mp:= formula->co_mp
   xqt_mp_u:= formula->qt_mp_u
   return

********************************
procedure NUC14

   local Local1
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Nome do Contato        [F5] Mostra relacao de contatos do cliente", ;
      "Cargo do Contado na Empresa", ;
      "Setor de trabalho do Contato", ;
      "Telefone Comercial do Setor", ;
      "Telefone residencial do Contato", ;
      "Data de Nascimento do Contato"}
   private xcontato, xdata_nasc, ulttecla, nr, vet, varia, xnivel
   private xcargo, xsetor, xtel_com, xtel_res
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "CONTATOS")
   select CONTATOS
   set order to 1
   t_contatos()
   setcursor(1)
   do while (.T.)
      SetKey(K_F5, Nil)
      ini_co()
      xcod_cl:= Space(5)
      set color to (cor[1])
      @  5, 22 clear to  5, 68
      set color to 
      set color to (cor[3])
      @  5, 22 get XCod_CL picture "99999" when mens_when(mens1[1])
      read
      set color to 
      xcod_cl:= strzero(Val(xcod_cl), 5)
      set color to (cor[3])
      @  5, 22 get XCod_CL picture "99999"
      readkill(.T.)
      getlist:= {}
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         SetKey(K_F5, Nil)
         return
      endif
      select CLIENTES
      set order to 1
      seek xcod_cl
      if (EOF())
         @ 23,  0 clear
         tone(870, 5)
         ms250("Cliente no cadastrado, tecle <ESC> para continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      @  5, 28 say nome_cl color cor[1]
      set key K_F5 to help_conta
      select CONTATOS
      do while (.T.)
         get_co()
         read
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               grava_co()
               unlock
            else
            endif
         endif
         ini_co()
      enddo
      limpa_co()
   enddo
   return

********************************
procedure HELP_CONTA(Arg1, Arg2, Arg3)

   local Local1:= 10, Local2:= 10, Local3:= 20, Local4:= 46, ;
      Local5:= {"contato"}, Local6:= {"CONTATOS"}, Local7
   Local7:= SaveScreen(Local1, Local2, Local3, Local4)
   SetKey(K_F5, Nil)
   select CONTATOS
   set order to 4
   set filter to Cod_CL = XCod_CL
   goto top
   set color to (cor[4])
   window(Local1, Local2, Local3, Local4, "Ŀ ")
   dbedit(Local1 + 1, Local2 + 1, Local3 - 1, Local4 - 1, Local5, ;
      "", .T., Local6, .T., .T., .T., .T.)
   set key K_F5 to help_conta
   set color to 
   RestScreen(Local1, Local2, Local3, Local4, Local7)
   set filter to
   return

********************************
procedure TRANS_BC

   xcod_nosso:= cod_nosso
   xnr_banco:= nr_banco
   xnome_bc:= nome_ban
   xnr_ag:= nr_agencia
   xnome_ag:= nome_ag
   xend_ag:= end_ag
   xcid_ag:= cid_ag
   xest_ag:= est_ag
   xcep_ag:= cep_ag
   xnr_conta:= nr_conta
   xcod_cl:= cod_cl
   xche_esp:= che_esp
   return

********************************
procedure TRAN_CRE

   xcod_cl:= cod_cl
   xnr_doc_re:= nr_doc_re
   xdt_emi_do:= dt_emi_doc
   xdt_ven_do:= dt_ven_doc
   xdt_liq_do:= dt_liq_doc
   xval_doc:= val_doc
   xval_liq:= val_liq
   xval_jur:= val_jur
   xcod_moe:= cod_moe
   xrefer_cr:= refer_cr
   xban_car:= ban_car
   return

********************************
procedure L_TELA27

   set color to (cor[1])
   @  5, 24 clear to  5, 73
   @  7, 24 clear to 13, 73
   set color to 
   return

********************************
procedure FUNC0021


********************************
procedure NUC15

   local Local1
   Local1:= {}
   AAdd(Local1, {9, 22, " Bancos               ", ;
      padc("Cadastra Bancos", 80)})
   AAdd(Local1, {10, 22, " Movimento Bancario   ", ;
      padc("Cadastra Movimento Bancario", 80)})
   AAdd(Local1, {11, 22, " Contas a Receber     ", ;
      padc("Cadastra Contas a Receber", 80)})
   AAdd(Local1, {12, 22, " Contas a Pagar       ", ;
      padc("Cadastra Contas a Pagar", 80)})
   AAdd(Local1, {13, 22, " Emprestimos          ", ;
      padc("Cadastra Emprestimos", 80)})
   AAdd(Local1, {14, 22, " Indices Financeiros  ", ;
      padc("Cadastra Indices Financeiros", 80)})
   AAdd(Local1, {15, 22, " Moedas               ", ;
      padc("Cadastra Moedas Indexadoras", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "FINANCEIRO")
   m_clientes:= 1
   do while (.T.)
      set color to (cor[14])
      window(8, 21, 16, 44, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("NUC151"))
            nuc151()
         endif
      case m_clientes = 2
         if (acesso("NUC152"))
            nuc152()
         endif
      case m_clientes = 3
         if (acesso("NUC153"))
            nuc153()
         endif
      case m_clientes = 4
         if (acesso("NUC154"))
            nuc154()
         endif
      case m_clientes = 5
         if (acesso("NUC155"))
            nuc155()
         endif
      case m_clientes = 6
         if (acesso("NUC156IN"))
            nuc156("IN")
         endif
      case m_clientes = 7
         if (acesso("NUC156MO"))
            nuc156("MO")
         endif
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure T_BANCOS

   set color to (cor[1])
   window(4, 1, 18, 68, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Interno...:"
   @  6,  2 say Replicate("", 66)
   @  7,  3 say "Numero do Banco..:          Nome Banco....:"
   @  9,  3 say "Numero Agencia...:          Nome Agencia..:"
   @ 11,  3 say "Endereco Agencia.:"
   @ 13,  3 say ;
      "Cidade Agencia...:                                Estado Ag.:"
   @ 15,  3 say "Cep da Agencia...:                  Nr. da Conta..:"
   @ 17,  3 say "Cheque Especial..:"
   set color to 
   return

********************************
procedure LIMPA_BC

   set color to (cor[1])
   @  7, 22 say Space(3)
   @  7, 47 say Space(20)
   @  9, 22 say Space(6)
   @  9, 47 say Space(20)
   @ 11, 22 say Space(45)
   @ 13, 22 say Space(25)
   @ 13, 65 say Space(2)
   @ 15, 22 say Space(11)
   @ 15, 55 say Space(12)
   set color to 
   return

********************************
procedure TEL_EXT1

   set color to (cor[1])
   window(4, 1, 6, 60, "ͻȺ ", .T.)
   @  5,  3 say "Codigo..:"
   set color to 
   return

********************************
procedure NUC151

   local Local1, Local2, Local3, Local4
   Local4:= {}
   private mens1:= ;
      {"Digite o Codigo interno do banco ou tecle <ESC> para sair", ;
      "Digite o Numero do banco junto ao BANCO CENTRAL ou tecle <ESC> para sair", ;
      "Digite o Nome do banco ou tecle <ESC> para sair", ;
      "Digite o Numero da agencia ou tecle <ESC> para sair", ;
      "Digite o Nome da agencia ou tecle <ESC> para sair", ;
      "Digite o Endereco da agencia ou tecle <ESC> para sair", ;
      "Digite a Cidade da agencia ou tecle <ESC> para sair", ;
      "Digite o Estado da agencia ou tecle <ESC> para sair", ;
      "Digite o CEP da agencia ou tecle <ESC> para sair", ;
      "Digite o Numero da conta corrente da " + _xempresa + ;
      " ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Cheque Especial ou tecle ,<ESC> para sair", ;
      "Digite o Codigo interno do Banco ou tecle <ESC> para sair", ;
      "Digite a Data do lancamento ou tecle <ESC> para sair", ;
      "Digite o Historico do lancamento ou tecle <ESC> para sair", ;
      "Digite o  lancamento (Debito ou Credito ou tecle <ESC> para sair", ;
      "Digite o Valor do lancamento ou tecle <ESC> para sair", ;
      "Digite o Numero do Documento ou tecle <ESC> para sair"}
   private xnr_banco, xnome_bc, xnr_ag, xnome_ag, xend_ag, xcid_ag, ;
      xest_ag, xcep_ag, xnr_conta, xcod_cl, xcod_nosso, xdat_lanca, ;
      xhistorico, xd_c_lanca, xval_lanca, xdat_saldo, xval_saldo, ;
      xnr_doc, xche_esp
   Local3:= SaveScreen(3, 0, 24, 79)
   sinal("CADASTRO", "BANCOS")
   select BANCOS
   set order to 4
   goto bottom
   t_bancos()
   ini_bc()
   @ 23,  0 clear
   do while (.T.)
      bancos->(dbSetOrder(4))
      bancos->(dbGoBottom())
      xcod_nosso:= strzero(Val(bancos->cod_nosso) + 1, 3)
      set color to (cor[3])
      @  5, 22 get XCOD_NOSSO picture "999"
      readkill(.T.)
      getlist:= {}
      set color to 
      get_bc()
      read
      set color to 
      if (LastKey() == K_ESC)
         RestScreen(3, 0, 24, 79, Local3)
         return
      endif
      bancos->(dbSetOrder(1))
      seek xnr_banco + xnr_ag + xnr_conta
      if (Found())
         mensagem("Conta digitada para este Banco ja cadastrada. Tecle <ESC> p/sair", ;
            27)
         ini_bc()
         limpa_bc()
         loop
      else
      endif
      @ 23,  0 say Space(80)
      gra()
      if (gra = "A")
         loop
      elseif (gra = "G")
         if (bancos->(addrec(5)))
            xrecno:= bancos->(RecNo())
            bancos->(dbSetOrder(4))
            bancos->(dbGoBottom())
            xcod_nosso:= strzero(Val(bancos->cod_nosso) + 1, 3)
            goto xrecno
            grava_bc()
            dbcommit()
            unlock
         else
            erro_lock()
         endif
      endif
      ini_bc()
      limpa_bc()
   enddo
   return

********************************
procedure INI_BC

   xnr_banco:= Space(3)
   xnome_bc:= Space(20)
   xnr_ag:= Space(6)
   xnome_ag:= Space(20)
   xend_ag:= Space(45)
   xcid_ag:= Space(25)
   xest_ag:= Space(2)
   xcep_ag:= Space(8)
   xnr_conta:= Space(12)
   xche_esp:= 0
   return

********************************
procedure TRANS_TB2

   xnome_prod:= valor_ta->nome_prod
   xdata_prod:= valor_ta->data_prod
   xvalor_pro:= valor_ta->valor_prod
   return

********************************
procedure GET_BC

   set color to (cor[3])
   @  7, 22 get XNR_BANCO picture "999" valid !Empty(xnr_banco) when ;
      mens_when(mens1[2])
   @  7, 47 get XNOME_BC picture "@!" valid LastKey() = K_UP .OR. ;
      !Empty(xnome_bc) when mens_when(mens1[3])
   @  9, 22 get XNR_AG picture "999!!9" valid LastKey() = K_UP .OR. ;
      !Empty(xnr_ag) when mens_when(mens1[4])
   @  9, 47 get XNOME_AG picture "@!" valid LastKey() = K_UP .OR. ;
      !Empty(xnome_ag) when mens_when(mens1[5])
   @ 11, 22 get XEND_AG picture "@!" valid LastKey() = K_UP .OR. ;
      !Empty(xend_ag) when mens_when(mens1[6])
   @ 13, 22 get XCID_AG picture "@!" valid LastKey() = K_UP .OR. ;
      !Empty(xcid_ag) when mens_when(mens1[7])
   @ 13, 65 get XEST_AG picture "@! AA" valid LastKey() = K_UP .OR. ;
      localiza(xest_ag, "TAB_UF", 1, "M") when mens_when(mens1[8])
   @ 15, 22 get XCEP_AG picture "@R 99.999-999" valid LastKey() = ;
      K_UP .OR. !Empty(xcep_ag) when mens_when(mens1[9])
   @ 15, 55 get XNR_CONTA picture "@!" valid LastKey() = K_UP .OR. ;
      !Empty(xnr_conta) when mens_when(mens1[10])
   @ 17, 22 get XCHE_ESP picture "999,999,999.99" when ;
      mens_when(mens1[11])
   return

********************************
procedure INI_CRE

   xcod_cl:= Space(5)
   xnr_doc_re:= Space(7)
   xrefer_cr:= Space(40)
   xcod_moe:= "   "
   xdt_emi_do:= xdt_ven_do:= xdt_liq_do:= CToD("")
   xval_doc:= xval_liq:= xval_jur:= 0
   xban_car:= Space(1)
   return

********************************
procedure NUC152

   local Local1, Local2, Local3, Local4
   Local4:= {}
   private mens1:= ;
      {"Digite o Codigo interno do banco ou tecle <ESC> para sair", ;
      "Digite o Numero do banco junto ao BANCO CENTRAL ou tecle <ESC> para sair", ;
      "Digite o Nome do banco ou tecle <ESC> para sair", ;
      "Digite o Numero da agencia ou tecle <ESC> para sair", ;
      "Digite o Nome da agencia ou tecle <ESC> para sair", ;
      "Digite o Endereco da agencia ou tecle <ESC> para sair", ;
      "Digite a Cidade da agencia ou tecle <ESC> para sair", ;
      "Digite o Estado da agencia ou tecle <ESC> para sair", ;
      "Digite o CEP da agencia ou tecle <ESC> para sair", ;
      "Digite o Numero da conta corrente da " + _xempresa + ;
      " ou tecle <ESC> p/ sair", ;
      "Digite o Codigo interno do Banco ou tecle <ESC> para sair", ;
      "Digite a Data do lancamento ou tecle <ESC> para sair", ;
      "Digite o Historico do lancamento ou tecle <ESC> para sair", ;
      "Digite o  lancamento (Debito ou Credito) ou tecle <ESC> para sair", ;
      "Digite o Valor do lancamento ou tecle <ESC> para sair", ;
      "Digite o Numero do Documento ou tecle <ESC> para sair", ;
      "O documento acima esta Bloqueado (Sim/Nao) ?             Tecle <ESC> para sair", ;
      "O documento acima ja foi compensado (Sim/Nao) ?          Tecle <ESC> para sair"}
   private xnr_banco, xnome_bc, xnr_ag, xnome_ag, xend_ag, xcid_ag, ;
      xest_ag, xcep_ag, xnr_conta, xcod_cl, xcod_nosso, xdat_lanca, ;
      xhistorico, xd_c_lanca, xval_lanca, xdat_saldo, xval_saldo, ;
      xnr_doc, xbloqueado
   Local3:= SaveScreen(3, 0, 24, 79)
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("LANCAMENTO", "BANCARIO")
   tel_ext1()
   do while (.T.)
      set color to (cor[12])
      @  9,  1 clear to 20, 63
      set color to 
      xcod_nosso:= Space(3)
      set color to (cor[3])
      @  5, 13 get XCOD_NOSSO picture "@K 999" valid ;
         localiza(stz(@xcod_nosso), "BANCOS", 4, "M", ;
         "NOME_BAN+[  ]+NR_AGENCIA+[  ]+NR_CONTA", 5, 17) when ;
         mens_when(mens1[11])
      read
      set color to 
      if (LastKey() == K_ESC)
         RestScreen(3, 0, 24, 79, Local3)
         return
      endif
      tel_ext2()
      xdat_lanca:= CToD(Space(8))
      do while (.T.)
         xhistorico:= Space(70)
         xbloqueado:= xd_c_lanca:= Space(1)
         xnr_doc:= Space(10)
         xval_lanca:= 0
         ext_get1()
         read
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0 clear
         gra()
         do while (gra = "A")
            ext_get1()
            read
            set color to 
            @ 23,  0 clear
            gra()
         enddo
         if (gra = "G")
            select SALDO
            if (!fillock(5))
               exit
            else
               select EXTRATO
               if (!addrec(5))
                  select SALDO
                  unlock
               else
                  select SALDO
               endif
            endif
            set softseek on
            set order to 1
            seek xcod_nosso + DToS(xdat_lanca)
            set softseek off
            if (cod_nosso + DToS(dat_saldo) != xcod_nosso + ;
                  DToS(xdat_lanca))
               skip -1
               if (BOF())
                  xval_saldo:= 0
               elseif (xcod_nosso = cod_nosso)
                  xval_saldo:= val_saldo
               else
                  xval_saldo:= 0
               endif
               append blank
               replace saldo->cod_nosso with xcod_nosso
               replace saldo->dat_saldo with xdat_lanca
               replace saldo->val_saldo with xval_saldo
            endif
            xxval_lanc:= iif(xd_c_lanca = "D", -1, 1) * xval_lanca
            if (xdat_lanca > data_virad - 1)
               DBEval({|| field->val_saldo:= val_saldo + ;
                  xxval_lanc}, Nil, {|| xcod_nosso = cod_nosso}, ;
                  Nil, Nil, .T.)
            else
               DBEval({|| field->val_saldo:= val_saldo + ;
                  xxval_lanc}, Nil, {|| xcod_nosso = cod_nosso .AND. ;
                  saldo->dat_saldo < data_virad}, Nil, Nil, .T.)
               xval_real:= conv_moeda(xxval_lanc, valor_vira)
               DBEval({|| field->val_saldo:= val_saldo + xval_real}, ;
                  Nil, {|| xcod_nosso = cod_nosso}, Nil, Nil, .T.)
            endif
            select EXTRATO
            replace extrato->cod_nosso with xcod_nosso
            replace extrato->dat_lanca with xdat_lanca
            replace extrato->historico with xhistorico
            replace extrato->d_c_lanca with xd_c_lanca
            replace extrato->nr_doc with xnr_doc
            replace extrato->val_lanca with xval_lanca
            replace extrato->bloqueado with xbloqueado
            extrato->(dbUnlock())
            saldo->(dbUnlock())
         endif
      enddo
      @  5, 13 say Space(46) color cor[1]
   enddo
   return

********************************
procedure TEL_EXT2

   set color to (cor[1])
   window(9, 1, 19, 62, "ͻȺ ", .T.)
   @ 10,  3 say "Data.................:"
   @ 12,  3 say "Historico............:"
   @ 14,  3 say "Valor lanamento.....:"
   @ 16,  3 say "Numero do Documento..:"
   if (xd_c_lanca = "D")
      @ 18,  3 say "<D>ebito ou <C>redito:        Compensado.:"
   else
      @ 18,  3 say "<D>ebito ou <C>redito:        Bloqueado..:"
   endif
   set color to 
   return

********************************
procedure INI_FPR

   xco_prod:= Space(4)
   xco_mp:= Space(4)
   xqt_mp_u:= 0
   return

********************************
procedure NUC153

   local Local1, Local2, Local3
   Local2:= setcursor()
   save screen to Local1
   private xalias, xtela_2
   private xcod_cl, xnr_doc_re, xdt_emi_do, xdt_ven_do, xrefer_cr, ;
      xdt_liq_do, xval_doc, xval_liq, xval_jur, xcod_moe
   private xban_car
   private mens1:= ;
      {"Digite o Numero do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite a Data da Emissao do Documento ou tecle <ESC> p/ sair", ;
      "Digite a Data do Vencimento do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Documento ou tecle <ESC> p/ sair", ;
      "Digite a Data de Liquidacao do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Juros na data da liquidacao ou tecle <ESC> p/ sair", ;
      "Digite o Valor recebido na data da liquidacao ou tecle <ESC> p/ sair", ;
      "Digite a Moeda do documento ou tecle <ESC> p/ sair", ;
      "Digite a Referencia ou tecle <ESC> p/ sair", ;
      "Digite (B)anco ou (C)arteira ou tecle <ESC> p/ sair"}
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 14, 74, "ͻȺ ", .T.)
   set color to 
   do while (.T.)
      tel_cre()
      ini_cre()
      set color to (cor[3])
      setcursor(1)
      @  5, 24 get XNR_DOC_RE picture iif(xcx2, "@K 9999999", ;
         "@K 9999999") valid !Empty(stz(@xnr_doc_re, "L")) when ;
         mens_when(mens1[1])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      if (xcx2)
         xalias:= "CONT_RER"
      else
         xalias:= "CONT_REF"
      endif
      select (xalias)
      set order to 2
      seek descend(xnr_doc_re)
      if (Found())
         tran_cre()
         tel_cre()
         fcod_cl(@xcod_cl, 8)
         set color to (cor[3])
         @  5, 24 get XNR_DOC_RE picture "9999999" when ;
            mens_when(mens1[2])
         get_cre()
         if (!Empty(xdt_liq_do))
            set color to (cor[1])
            xtela_2:= window(15, 1, 19, 74, "ͻȺ ", .T.)
            tel_cre2()
            set color to (cor[3])
            get_cre2()
         endif
         readkill(.T.)
         getlist:= {}
         set color to 
         mensagem("Documento ja cadastrado. Tecle <ESC> p/ continuar.", ;
            27)
         iif(xtela_2 != Nil, restscr(xtela_2), "")
         l_tela27()
         loop
      endif
      if (xcx2 = .F.)
         select CONT_RER
         set order to 2
         seek descend(xnr_doc_re)
         if (Found())
            mensagem("Documento nao pode ser cadastrado. <ESC> p/ continuar.", ;
               27)
            l_tela27()
            loop
         endif
      endif
      cad_cre()
      l_tela27()
   enddo

********************************
procedure GRAV_REF

   replace cont_ref->cod_cl with xcod_cl
   replace cont_ref->nr_doc_re with xnr_doc_re
   replace cont_ref->dt_emi_doc with xdt_emi_do
   replace cont_ref->dt_ven_doc with xdt_ven_do
   replace cont_ref->dt_liq_doc with xdt_liq_do
   replace cont_ref->val_doc with xval_doc
   replace cont_ref->val_jur with xval_jur
   replace cont_ref->val_liq with xval_liq
   replace cont_ref->cod_moe with xcod_moe
   replace cont_ref->refer_cr with xrefer_cr
   replace cont_ref->ban_car with xban_car
   return

********************************
procedure LIMPA_EMP

   set color to (cor[1])
   @ xl + 2, xc + 25 clear to xl + 12, xc + 69
   set color to 
   return

********************************
procedure GET_CRE

   @  7, 24 get XCod_CL picture "@K 99999" valid ;
      fcod_cl(stz(@xcod_cl), 7) when mens_when(mens1[2])
   @  8, 24 get XDT_EMI_DOC picture "@D" valid !Empty(xdt_emi_do) ;
      .AND. xdt_emi_do <= Date() .OR. LastKey() = K_UP when ;
      mens_when(mens1[3])
   @  9, 24 get XDT_VEN_DOC picture "@D" valid !Empty(xdt_ven_do) ;
      .AND. xdt_ven_do >= xdt_emi_do .OR. LastKey() = K_UP when ;
      mens_when(mens1[4])
   @ 10, 24 get XVAL_DOC picture "@E 999,999,999.99" valid ;
      !Empty(xval_doc) .OR. LastKey() = K_UP when mens_when(mens1[5])
   @ 11, 24 get XCOD_MOE picture "@k 999" valid ;
      localiza(stz(@xcod_moe), "TAB_MOE", 1, "M", "DESCRICAO", 11, ;
      28) when mens_when(mens1[9])
   @ 12, 24 get XREFER_CR picture "@!" when mens_when(mens1[10])
   @ 13, 24 get XBAN_CAR picture "@!a" valid xban_car $ "C/B" when ;
      mens_when(mens1[11])
   return
   return

********************************
procedure GET_CRE2

   @ 16, 24 get XDT_LIQ_DOC picture "@D" valid !Empty(xdt_liq_do) ;
      .AND. xdt_liq_do <= Date() .AND. xdt_liq_do >= xdt_emi_do when ;
      mens_when(mens1[6])
   @ 17, 24 get XVAL_JUR picture "@E 999,999,999.99" when ;
      mens_when(mens1[7])
   @ 18, 24 get XVAL_LIQ picture "@E 999,999,999.99" valid ;
      !Empty(xval_liq) when mens_when(mens1[8])
   return

********************************
procedure INI_MP

   xde_mp:= Space(40)
   xco_unid:= Space(2)
   xest_mp_at:= xest_mp_mi:= xult_p_mp:= xali_ipi:= xali_icms:= ;
      xest_mp_ma:= 0
   return

********************************
procedure GRAV_RER

   replace cont_rer->cod_cl with xcod_cl
   replace cont_rer->nr_doc_re with xnr_doc_re
   replace cont_rer->dt_emi_doc with xdt_emi_do
   replace cont_rer->dt_ven_doc with xdt_ven_do
   replace cont_rer->dt_liq_doc with xdt_liq_do
   replace cont_rer->val_doc with xval_doc
   replace cont_rer->val_jur with xval_jur
   replace cont_rer->val_liq with xval_liq
   replace cont_rer->cod_moe with xcod_moe
   replace cont_rer->refer_cr with xrefer_cr
   replace cont_rer->ban_car with xban_car
   return

********************************
procedure CAD_CPG

   do while (.T.)
      set color to (cor[3])
      setcursor(1)
      get_cpg()
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         exit
      endif
      @ 23,  0 clear
      gra()
      if (gra = "A")
         xtipo_doc:= Space(16)
         set color to (cor[1])
         @  8, 42 clear to  8, 73
         set color to 
         loop
      elseif (gra = "G")
         select CONT_PGR
         if (addrec(5))
            grav_pgr()
            if (!xcx2)
               select CONT_PGF
               if (addrec(5))
                  grav_pgf()
                  unlock
               else
                  select CONT_PGR
                  delete
               endif
            endif
            select CONT_PGR
            unlock
         else
         endif
      endif
      exit
   enddo
   return

********************************
procedure INI_CPG

   xcod_fo:= Space(4)
   xnr_doc_cp:= Space(7)
   xtipo_doc:= Space(16)
   xrefer_cp:= Space(40)
   xnr_cheq:= xnr_cc:= Space(20)
   xcod_moe:= Space(3)
   xdt_ven_cp:= xdt_rec_cp:= xdt_liq_do:= CToD("")
   xval_cp:= xval_icm_c:= xval_acres:= xval_liqui:= 0
   return

********************************
procedure TEL_CPG2

   set color to (cor[1])
   @ 16,  3 say "Cheque.............:"
   @ 17,  3 say "Data da Liquidacao.:"
   @ 18,  3 say "Valor acrescimo....:"
   @ 19,  3 say "Valor pago.........:"
   set color to 
   return

********************************
procedure TRAN_CPG

   xcod_fo:= cod_fo
   xnr_doc_cp:= nr_doc_cp
   xrefer_cp:= refer_cp
   xdt_ven_cp:= dt_ven_cp
   xdt_rec_cp:= dt_rec_cp
   xval_cp:= val_cp
   xcod_moe:= cod_moe
   xval_icm_c:= val_icm_cp
   xdt_liq_do:= dt_liq_do
   xval_acres:= val_acres
   xval_liqui:= val_liqui
   xnr_cheq:= nr_cheq
   xtipo_doc:= tipo_doc
   xnr_cc:= nr_cc
   return

********************************
function __GETSETNA(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[7]:= Arg1
   endif
   return qself()[7]

********************************
procedure NUC154

   local Local1, Local2, Local3
   Local2:= setcursor()
   save screen to Local1
   private xalias
   private xcod_fo, xnr_doc_cp, xrefer_cp, xdt_ven_cp, xdt_rec_cp, ;
      xval_cp
   private xval_icm_c, xdt_liq_do, xval_acres, xval_liqui, xnr_cheq, ;
      xcod_moe
   private xtipo_doc, xnr_cc
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou <ESC> p/ sair", ;
      "Digite o Numero do Documento ou <ESC> p/ sair", ;
      "Digite a Data de Recebimento do Documento. <ESC> p/ sair", ;
      "Digite a Data do Vencimento do Documento. <ESC> p/ sair", ;
      "Digite o Valor do Documento ou <ESC> p/ sair", ;
      "Digite o Valor do ICMS ou <ESC> p/ sair", ;
      "Digite a Referencia do Documento ou <ESC> p/ sair", ;
      "Digite o Numero do Cheque/Conta Corrente/Banco ou <ESC> p/ sair", ;
      "Digite a Data de Liquidacao do Documento. <ESC> p/ sair", ;
      "Digite o Valor do Acrescimo ou <ESC> p/ sair", ;
      "Digite o Valor do pago ou <ESC> p/ sair", ;
      "Digite a Moeda do documento ou tecle <ESC> p/ sair", ;
      "Digite o Tipo do documento ou tecle <ESC> p/ sair", ;
      "Digite o Nr. do Banco/Nr. da Agencia/Nr. da Conta C. ou tecle <ESC> p/ sair"}
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 15, 74, "ͻȺ ", .T.)
   set color to 
   do while (.T.)
      tel_cpg()
      ini_cpg()
      set color to (cor[3])
      setcursor(1)
      @  5, 24 get XCOD_FO picture "@k 9999" valid ;
         fcod_fo(stz(@xcod_fo), 5) .AND. gera_nr_do() when ;
         mens_when(mens1[1])
      @  6, 24 get XNR_DOC_CP picture "@K 9999999" valid ;
         !Empty(stz(@xnr_doc_cp, "L")) when mens_when(mens1[2])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      if (xcx2)
         xalias:= "CONT_PGR"
      else
         xalias:= "CONT_PGF"
      endif
      select (xalias)
      set order to 1
      seek xcod_fo + descend(xnr_doc_cp)
      if (Found())
         tran_cpg()
         tel_cpg()
         fcod_fo(@xcod_fo, 5)
         set color to (cor[3])
         @  5, 24 get XCOD_FO picture "9999" when mens_when(mens1[1])
         @  6, 24 get XNR_DOC_CP when mens_when(mens1[2])
         get_cpg()
         if (!Empty(xdt_liq_do))
            set color to (cor[1])
            window(16, 1, 21, 74, "ͻȺ ", .T.)
            tel_cpg2()
            set color to (cor[3])
            get_cpg2()
         endif
         readkill(.T.)
         getlist:= {}
         set color to 
         mensagem("Documento ja cadastrado. Tecle [ESC] p/ continuar.", ;
            27)
         set color to (cor[12])
         set color to 
         l_tela()
         loop
      endif
      if (xcx2 = .F.)
         select CONT_PGR
         set order to 1
         seek xcod_fo + descend(xnr_doc_cp)
         if (Found())
            mensagem("Documento nao pode ser cadastrado. [ESC] p/ continuar.", ;
               27)
            l_tela()
            loop
         endif
      endif
      cad_cpg()
      l_tela()
   enddo

********************************
procedure TEL_CPG

   set color to (cor[1])
   @  5,  3 say "Codigo Fornecedor..:"
   @  6,  3 say "Numero documento...:"
   @  7,  2 to  7, 73
   @  8,  3 say "Tipo do documento..:"
   @  9,  3 say "Data da recebimento:"
   @ 10,  3 say "Data do vencimento.:"
   @ 11,  3 say "Valor do documento.:"
   @ 12,  3 say "Moeda do documento.:"
   @ 13,  3 say "Valor do ICMS......:"
   @ 14,  3 say "Referencia.........:"
   set color to 
   return

********************************
procedure GET_CPG2

   @ 16, 24 get XNR_CHEQ picture "@!" when mens_when(mens1[8])
   @ 17, 24 get XDT_LIQ_DO picture "@D" valid !Empty(xdt_liq_do) ;
      .AND. xdt_liq_do <= Date() when mens_when(mens1[9])
   @ 18, 24 get XVAL_ACRES picture "@E 999,999,999.99" valid ;
      (xval_liqui:= xval_cp + xval_acres) = xval_liqui when ;
      mens_when(mens1[10])
   @ 19, 24 get XVAL_LIQUI picture "@E 999,999,999.99" when ;
      mens_when(mens1[11])
   return

********************************
procedure GRAV_PGF

   replace cont_pgf->cod_fo with xcod_fo
   replace cont_pgf->nr_doc_cp with xnr_doc_cp
   replace cont_pgf->refer_cp with xrefer_cp
   replace cont_pgf->dt_ven_cp with xdt_ven_cp
   replace cont_pgf->dt_rec_cp with xdt_rec_cp
   replace cont_pgf->val_cp with xval_cp
   replace cont_pgf->cod_moe with xcod_moe
   replace cont_pgf->val_icm_cp with xval_icm_c
   replace cont_pgf->dt_liq_do with xdt_liq_do
   replace cont_pgf->val_acres with xval_acres
   replace cont_pgf->val_liqui with xval_liqui
   replace cont_pgf->nr_cheq with xnr_cheq
   replace cont_pgf->tipo_doc with xtipo_doc
   replace cont_pgf->nr_cc with iif(xtipo_doc = "Cheque", xnr_cc, "")
   return

********************************
procedure GET_CPG

   @  8, 24 get XTIPO_DOC when mens_when(mens1[13]) .AND. escolha(7, ;
      40, {"   C h e q u e    ", "    Duplicata     ", ;
      " Despesas  Gerais ", "   Promissorias   ", ;
      " Des. Tributarias ", " Des. de  Pessoal ", ;
      "   Emprestimos    ", "    Comissoes     "}, ;
      {"Cheque          ", "Duplicatas      ", "Despesas  Gerais", ;
      "Promissorias    ", "Des. Tributarias", "Des. de  Pessoal", ;
      "Emprestimos     ", "Comissoes       "}, cor[8], 2, .T., Nil, ;
      Nil, Nil, Nil, .T., Nil, .T.)
   @  8, 42 get XNR_CC valid !Empty(xnr_cc) .OR. sb() when ;
      mens_when(mens1[14]) .AND. iif(xtipo_doc = "Cheque", .T., ;
      (xnr_cc:= Space(20)) = "NADA")
   @  9, 24 get XDT_REC_CP picture "@D" valid !Empty(xdt_rec_cp) ;
      .AND. xdt_rec_cp <= Date() .OR. LastKey() = K_UP when ;
      mens_when(mens1[3])
   @ 10, 24 get XDT_VEN_CP picture "@D" valid !Empty(xdt_ven_cp) ;
      .AND. xdt_ven_cp >= xdt_rec_cp .OR. LastKey() = K_UP when ;
      mens_when(mens1[4])
   @ 11, 24 get XVAL_CP picture "@E 999,999,999.99" valid ;
      !Empty(xval_cp) .OR. LastKey() = K_UP when mens_when(mens1[5])
   @ 12, 24 get XCOD_MOE picture "@K 999" valid ;
      localiza(stz(@xcod_moe), "TAB_MOE", 1, "M", "DESCRICAO", 12, ;
      28) when mens_when(mens1[12])
   @ 13, 24 get XVAL_ICM_C picture "@E 9999,999,999.99" when ;
      mens_when(mens1[6])
   @ 14, 24 get XREFER_CP picture "@!" when mens_when(mens1[7])
   return

********************************
procedure GRAV_PGR

   replace cont_pgr->cod_fo with xcod_fo
   replace cont_pgr->nr_doc_cp with xnr_doc_cp
   replace cont_pgr->refer_cp with xrefer_cp
   replace cont_pgr->dt_ven_cp with xdt_ven_cp
   replace cont_pgr->dt_rec_cp with xdt_rec_cp
   replace cont_pgr->val_cp with xval_cp
   replace cont_pgr->cod_moe with xcod_moe
   replace cont_pgr->val_icm_cp with xval_icm_c
   replace cont_pgr->dt_liq_do with xdt_liq_do
   replace cont_pgr->val_acres with xval_acres
   replace cont_pgr->val_liqui with xval_liqui
   replace cont_pgr->nr_cheq with xnr_cheq
   replace cont_pgr->tipo_doc with xtipo_doc
   replace cont_pgr->nr_cc with iif(xtipo_doc = "Cheque", xnr_cc, "")
   return

********************************
procedure L_TELA

   set color to (cor[1])
   @  5, 24 clear to  6, 73
   @  8, 24 clear to 14, 73
   set color to 
   return

********************************
function GERA_NR_DO

   cont_pgr->(dbSeek(xcod_fo))
   if (cont_pgr->nr_doc_cp = "Z")
      xnr_doc_cp:= strzero(Val(cont_pgr->nr_doc_cp) + 1, 7)
   else
      xnr_doc_cp:= "0000001"
   endif
   return .T.

********************************
procedure GRAVA_EMP

   replace empresti->nome_emp with xnome_emp
   replace empresti->ref_emp with xref_emp
   replace empresti->tipo_oper with xtipo_oper
   replace empresti->dt_oper with xdt_oper
   replace empresti->val_oper with xval_oper
   replace empresti->cod_moe with xcod_moe
   replace empresti->cod_ind with xcod_ind
   replace empresti->perc_acr with xperc_acr
   replace empresti->dt_pr_liq with xdt_pr_liq
   replace empresti->val_liqui with xval_liqui
   replace empresti->dt_liqui with xdt_liqui
   replace empresti->val_atu with xval_atu
   replace empresti->emp_bp with xemp_bp
   return

********************************
procedure DISP155

   localiza(xcod_moe, "TAB_MOE", 1, "M", "DESCRICAO", xl + 7, xc + 29)
   iif(!Empty(xcod_ind), localiza(xcod_ind, "TAB_IND", 1, "M", ;
      "DESCRICAO", xl + 8, xc + 29), "")
   return

********************************
function AT_VAL_EMP

   local Local1, Local2, Local3, Local4, Local5, Local6
   Local1:= dif_ma(d_to_ma(xdt_oper), d_to_ma(xdt_pr_liq))
   Local2:= 0
   if ((Local3:= Day(xdt_oper)) < (Local4:= Day(xdt_pr_liq)))
      Local2:= Local4 - Local3
   elseif ((Local3:= Day(xdt_oper)) > (Local4:= Day(xdt_pr_liq)))
      Local1--
      Local2:= 30 - (Local3 - Local4)
   endif
   Local6:= xval_oper
   for Local5:= 1 to Local1
      Local6:= Local6 * (1 + xperc_acr / 100)
   next
   Local6:= Local6 * (1 + xperc_acr / 30 / 100 * Local2)
   return Local6

********************************
function __GETBUFFE

   return iif(Len(qself()) == 13, qself()[12], Nil)

********************************
procedure NUC155

   local Local1
   private mens:= {"Digite o do Nome Credor/. <ESC> p/ sair", ;
      "Digite a Referencia.", ;
      "Digite o Tipo da Operacao, <C>redito ou <D>ebito", ;
      "Digite a Data da Operacao", "Digite o Valor da Operacao", ;
      "Digite a Moeda da Operacao", ;
      "Digite o Indexador de Correcao da Operacao", ;
      "Digite o Percentual adicional da Operacao", ;
      "Digite a Data Provavel de Liquidacao", ;
      "Digite se o Emprestimo e Bancario ou Particular"}
   private xnome_emp, xref_emp, xtipo_oper, xdt_oper, xval_oper, ;
      xcod_moe, xemp_bp
   private xcod_ind, xperc_acr, xdt_pr_liq, xval_liqui, xdt_liqui, ;
      xval_atu
   private xl:= 3, xc:= 0, xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "EMPRESTIMOS")
   tel_emp()
   ini_emp()
   do while (.T.)
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
         !Empty(xnome_emp) when mens_when(mens[1])
      get_emp()
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      @ 23,  0
      gra()
      if (gra = "A")
         loop
      elseif (gra = "G")
         select EMPRESTI
         if (addrec(5))
            grava_emp()
            unlock
         else
            mensagem("Dados nao podem ser gravado. Tecle <ESC> p/ continuar.", ;
               27)
            loop
         endif
      endif
      ini_emp()
      limpa_emp()
   enddo
   return

********************************
procedure TEL_EMP

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 13, xc + 70, "Ŀ ", .T.)
   @ xl + 2, xc + 3 say "Nome................:"
   @ xl + 3, xc + 3 say "Referencia..........:"
   @ xl + 4, xc + 3 say "Credito ou Debito...:"
   @ xl + 5, xc + 3 say "Data da Operacao....:"
   @ xl + 6, xc + 3 say "Valor da Operacao...:"
   @ xl + 7, xc + 3 say "Moeda...............:"
   @ xl + 8, xc + 3 say "Indice de Correcao .:"
   @ xl + 9, xc + 3 say "% adicional.........:"
   @ xl + 10, xc + 3 say "Provavel liquidacao.:"
   @ xl + 11, xc + 3 say "Valor Atualizado....:"
   @ xl + 12, xc + 3 say "Origem do Emprestimo:"
   set color to 
   return

********************************
procedure TRANS_EMP

   xnome_emp:= empresti->nome_emp
   xref_emp:= empresti->ref_emp
   xtipo_oper:= empresti->tipo_oper
   xdt_oper:= empresti->dt_oper
   xval_oper:= empresti->val_oper
   xcod_moe:= empresti->cod_moe
   xcod_ind:= empresti->cod_ind
   xperc_acr:= empresti->perc_acr
   xdt_pr_liq:= empresti->dt_pr_liq
   xval_liqui:= empresti->val_liqui
   xdt_liqui:= empresti->dt_liqui
   xval_atu:= empresti->val_atu
   xemp_bp:= empresti->emp_bp
   return

********************************
procedure INI_EMP

   xnome_emp:= Space(40)
   xref_emp:= Space(60)
   xtipo_oper:= xemp_bp:= Space(1)
   xdt_oper:= xdt_pr_liq:= xdt_liqui:= CToD("")
   xval_oper:= xval_liqui:= xperc_acr:= xval_atu:= 0
   xcod_moe:= xcod_ind:= Space(3)
   return

********************************
procedure GRAVA_TB2

   replace valor_ta->cod_prod with xcod_prod
   replace valor_ta->nome_prod with xnome_prod
   replace valor_ta->data_prod with xdata_prod
   replace valor_ta->valor_prod with xvalor_pro
   return

********************************
procedure GET_EMP(Arg1)

   @ xl + 3, xc + 25 get XREF_EMP picture "@!S40" valid ;
      !Empty(xref_emp) .OR. sb() when mens_when(mens[2])
   @ xl + 4, xc + 25 get XTIPO_OPER picture "!" valid xtipo_oper $ ;
      "CD" .OR. sb() when mens_when(mens[3])
   @ xl + 5, xc + 25 get XDT_OPER picture "@D" valid ;
      !Empty(xdt_oper) .AND. xdt_oper <= Date() .OR. sb() when ;
      mens_when(mens[4])
   @ xl + 6, xc + 25 get XVAL_OPER picture "@E 999,999,999.99" valid ;
      !Empty(xval_oper) .OR. sb() when mens_when(mens[5])
   @ xl + 7, xc + 25 get XCOD_MOE picture "@k 999" valid ;
      localiza(stz(@xcod_moe), "TAB_MOE", 1, "M", "DESCRICAO", xl + ;
      7, xc + 29) when mens_when(mens[6])
   @ xl + 8, xc + 25 get XCOD_IND picture "@k 999" valid ;
      iif(Empty(xcod_ind), .T., localiza(stz(@xcod_ind), "TAB_IND", ;
      1, "M", "DESCRICAO", xl + 8, xc + 29)) when mens_when(mens[7])
   @ xl + 9, xc + 25 get XPERC_ACR picture "999.99" when ;
      mens_when(mens[8])
   @ xl + 10, xc + 25 get XDT_PR_LIQ picture "@D" valid xdt_pr_liq ;
      >= xdt_oper .OR. sb() when mens_when(mens[9])
   @ xl + 11, xc + 25 get XVAL_ATU picture "@E 999,999,999.99" when ;
      (xval_atu:= at_val_emp()) = xval_atu
   @ xl + 12, xc + 25 get XEMP_BP picture "@!A" valid xemp_bp $ "BP" ;
      .OR. sb() when xtipo_oper = "D" .AND. mens_when(mens[10])
   return

********************************
procedure GET_TB2

   @  5, 22 get XNOME_PROD picture "@k 999" valid ;
      localiza(stz(@xnome_prod), "TAB_" + iif(xcod_prod = "IN", ;
      "IND", "MOE"), 1, "M", "DESCRICAO", 5, 27) when ;
      mens_when(mens1[1][i_n_d_i])
   @  7, 22 get XDATA_PROD valid !Empty(xdata_prod) .OR. sb() when ;
      mens_when(mens1[2][i_n_d_i])
   @  9, 22 get XDATA_FINAL valid xdata_prod <= xdata_fina .OR. sb() ;
      when mens_when(mens1[3][i_n_d_i]) .AND. iif(Empty(xdata_fina), ;
      (xdata_fina:= xdata_prod) = xdata_fina, .T.)
   @ 11, 22 get XVALOR_PROD picture "@E 999,999,999.999999" valid ;
      !Empty(xvalor_pro) .OR. sb() when mens_when(mens1[4][i_n_d_i])
   return

********************************
procedure DISP161

   localiza(xco_unid, "TAB_UNI", 1, "M", "DESCRICAO", xl + 4, xc + 28)
   return

********************************
procedure TELA_MP

   set color to (cor[1])
   window(4, 1, 20, 61, "ͻȺ ", .T.)
   @  5,  3 say "Cod. Mat. Prima:"
   @  7,  3 say "Descricao M.P. :"
   @  9,  3 say "Unidade........:"
   if (xcx2)
      @ 11,  3 say "Estoque Fiscal.:                 Real.:"
   else
      @ 11,  3 say "Estoque atual..:"
   endif
   @ 13,  3 say "Estoque minimo.:"
   @ 15,  3 say "Ultimo preco...:"
   @ 17,  3 say "Aliquota ICMS..:"
   @ 19,  3 say "Aliquota IPI...:"
   set color to 
   return

********************************
procedure NUC156

   local Local1
   parameters xcod_prod, xxcod_prod, xxdata
   private i_n_d_i:= iif(xcod_prod = "IN", 1, 2)
   private mens1:= {{"Codigo do Indice Financeiro", ;
      "Codigo da Moeda"}, ;
      {"Data Inicial de Referncia do Indice Financeiro", ;
      "Data Inicial de Referncia da Moeda"}, ;
      {"Data Final de Referncia do Indice Financeiro", ;
      "Data Final de Referncia da Moeda"}, ;
      {"Valor do Indice Financeiro na Data Supra em Porcentagen", ;
      "Valor da Moeda na Data Supra em Cruzeiros"}}, sinal:= ;
      {"VALOR_IN", "VALOR_MO"}, xcod_prod, xnome_prod, xdata_prod, ;
      xvalor_pro, m_tabelas, xdata_fina
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear
   sinal("CADASTRO", sinal[i_n_d_i])
   select VALOR_TA
   set order to 1
   set color to (cor[1])
   t_tabela2()
   ini_tb2()
   if (xxcod_prod != Nil)
      xnome_prod:= xxcod_prod
      xdata_prod:= xxdata
   endif
   setcursor(1)
   do while (.T.)
      set color to (cor[3])
      get_tb2()
      read
      set color to (cor[1])
      if (LastKey() == K_ESC)
         if (Empty(xnome_prod))
            restore screen from Local1
            return
         else
            ini_tb2()
            limpa_tb2()
            loop
         endif
      endif
      seek xcod_prod + xnome_prod + DToS(xdata_prod)
      if (Found())
         tone(800, 5)
         ms250("Valor ja cadastrado p/ esta DATA, Tecle <ESC> p/ continuar.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
         ini_tb2()
         limpa_tb2()
         loop
      endif
      gra()
      if (gra = "A")
         loop
      elseif (gra = "G")
         if (!fillock(5))
            tone(800, 5)
            ms250("Nao foi possivel gravar os dados, Tecle <ESC> p/ continuar.", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
            ini_tb2()
            limpa_tb2()
            loop
         endif
         do while (xdata_prod <= xdata_fina)
            append blank
            grava_tb2()
            xdata_prod++
         enddo
         unlock
      endif
      ini_tb2()
      limpa_tb2()
   enddo
   return

********************************
static procedure LIMPA_TB2

   @  5, 22 say Space(35)
   @  7, 22 say Space(30)
   @  9, 22 say Space(30)
   @ 11, 22 say Space(30)
   return

********************************
static procedure INI_TB2

   xnome_prod:= Space(3)
   xdata_prod:= CToD("  /  /  ")
   xdata_fina:= CToD("  /  /  ")
   xvalor_pro:= 0
   return

********************************
procedure T_TABELA2

   window(4, 1, 12, 58, "ͻȺ ", .T.)
   @  5,  3 say "Codigo ..........:"
   @  7,  3 say "Data Inicial.....: "
   @  9,  3 say "Data Final.......: "
   @ 11,  3 say "Valor............: "
   return

********************************
procedure TRANS_PAC

   xco_prod:= prod_aca->co_prod
   xde_prod:= prod_aca->de_prod
   xco_unid:= prod_aca->co_unid
   xest_atu:= prod_aca->est_atu
   xval_mp:= prod_aca->val_mp
   xval_prod:= prod_aca->val_prod
   xali_ipi:= prod_aca->ali_ipi
   xali_icms:= prod_aca->ali_icms
   xval_fatu:= prod_aca->val_fatu
   xval_custo:= prod_aca->val_custo
   xqtd_padra:= prod_aca->qtd_padrao
   xpeso_prod:= prod_aca->peso_prod
   return

********************************
procedure GRAVA_PAC

   replace prod_aca->co_prod with xco_prod
   replace prod_aca->de_prod with xde_prod
   replace prod_aca->co_unid with xco_unid
   replace prod_aca->est_atu with xest_atu
   replace prod_aca->val_mp with xval_mp
   replace prod_aca->val_prod with xval_prod
   replace prod_aca->ali_ipi with xali_ipi
   replace prod_aca->ali_icms with xali_icms
   replace prod_aca->val_fatu with xval_fatu
   replace prod_aca->val_custo with xval_custo
   replace prod_aca->qtd_padrao with xqtd_padra
   replace prod_aca->peso_prod with xpeso_prod
   return

********************************
procedure LIMPA_PAC

   set color to (cor[1])
   @ xl + 2, xc + 25 clear to xl + 13, xc + 59
   set color to 
   return

********************************
function READEXIT(Arg1)

   return Set(_SET_EXIT, Arg1)

********************************
procedure NUC16

   local Local1
   Local1:= {}
   AAdd(Local1, {9, 22, " Produto Acabado      ", ;
      padc("Cadastra Produto Acabado", 80)})
   AAdd(Local1, {10, 22, " Materia Prima        ", ;
      padc("Cadastra Materia Prima", 80)})
   AAdd(Local1, {11, 22, " Formulas de Producao ", ;
      padc("Cadastra Formulas de Producao", 80)})
   AAdd(Local1, {12, 22, " Producao Diaria      ", ;
      padc("Cadastra Producao Diaria", 80)})
   AAdd(Local1, {13, 22, " Custo G. Fabricacao  ", ;
      padc("Cadastra Custo Geral de Fabricacao", 80)})
   AAdd(Local1, {14, 22, " Movimento M.P.       ", ;
      padc("Cadastra Movimento de Materia Prima para producao", ;
      80)})
   AAdd(Local1, {15, 22, " Est. Materia Prima   ", ;
      padc("Cadastra Estoque de Materia Prima para producao", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "CLIENTES")
   m_clientes:= 1
   do while (.T.)
      set color to (cor[14])
      window(8, 21, 16, 44, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("NUC161"))
            nuc161()
         endif
      case m_clientes = 2
         if (acesso("NUC162"))
            nuc162()
         endif
      case m_clientes = 3
         if (acesso("NUC163"))
            nuc163()
         endif
      case m_clientes = 4
         if (acesso("NUC164"))
            nuc164()
         endif
      case m_clientes = 5
         if (acesso("NUC165"))
            nuc165()
         endif
      case m_clientes = 6
         if (acesso("NUC166"))
            nuc166()
         endif
      case m_clientes = 7
         if (acesso("NUC167"))
            nuc167()
         endif
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure GRAVA_MP_R

   replace mp_r->co_mp with xco_mp
   replace mp_r->de_mp with xde_mp
   replace mp_r->co_unid with xco_unid
   replace mp_r->est_mp_at with xest_mp_at
   replace mp_r->est_mp_mi with xest_mp_mi
   replace mp_r->est_mp_max with xest_mp_ma
   replace mp_r->ult_p_mp with xult_p_mp
   replace mp_r->ali_icms with xali_icms
   replace mp_r->ali_ipi with xali_ipi
   return

********************************
procedure LIMPA_MP

   set color to (cor[1])
   @  7, 20 say Space(40)
   @  9, 20 clear to  9, 50
   @ 11, 20 clear to 11, 34
   @ 11, 43 clear to 11, 59
   @ 12, 20 clear to 19, 50
   set color to 
   return

********************************
procedure TRANS_MP

   xco_mp:= co_mp
   xde_mp:= de_mp
   xco_unid:= co_unid
   xest_mp_at:= est_mp_at
   xest_mp_mi:= est_mp_mi
   xest_mp_ma:= est_mp_max
   xult_p_mp:= ult_p_mp
   xali_ipi:= ali_ipi
   xali_icms:= ali_icms
   return

********************************
function UNIDADE(Arg1)

   if (Empty(Arg1))
      return .F.
   else
      tab_uni->(dbSetOrder(1))
      tab_uni->(dbSeek(Arg1))
      if (tab_uni->(Found()))
         return .T.
      else
         mensagem("Codigo nao encontrado. P/ continuar tecle [ESC].", ;
            27)
         xco_unid:= Space(2)
         return .F.
      endif
   endif

********************************
procedure LIMPA_FPR

   set color to (cor[1])
   @ xl + 2, xc + 27 clear to xl + 4, xc + 74
   set color to 
   return

********************************
procedure LIMPA_PRD

   set color to (cor[1])
   @ xl + 2, xc + 24 clear to xl + 5, xc + 61
   set color to 
   return

********************************
static function SETACOR(Arg1)

   set color to (Arg1)
   return SetColor()

********************************
procedure NUC161

   local Local1
   private mens:= {"Codigo do Produto Acabado", ;
      "Descricao do Produto Acabado", ;
      "Codigo da Unidade do Produto Acabado", ;
      "Estoque Atual do Produto Acabado", ;
      "Custo da Materia Prima no Produto Acabado", ;
      "Preco Atual do Produto Acabado", ;
      "Aliquota ICMS do Produto Acabado", ;
      "Aliquota IPI do Produto Acabado", ;
      "Preco de Faturamento do Produto Acabado", ;
      "Preco de Custo do Produto Acabado", ;
      "Capacidade da Caixa Padrao de Transporte", ;
      "Peso por unidade do produto"}
   private xco_prod, xde_prod, xco_unid, xest_atu, xval_mp, xval_prod
   private xali_ipi, xali_icms, xval_fatu, xval_custo, xqtd_padra, ;
      xpeso_prod
   private xl:= 3, xc:= 0, xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "PROD.ACAB.")
   tel_pac()
   ini_pac()
   do while (.T.)
      setcursor(1)
      select PROD_ACA
      set order to 1
      goto bottom
      yco_prod:= xco_prod:= strzero(Val(prod_aca->co_prod) + 1, 4)
      set color to (cor[3])
      @ xl + 2, xc + 25 get xco_prod picture "@k 9999" valid ;
         localiza(stz(@xco_prod), "PROD_ACA", 1, "I")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(xcursor)
         return
      endif
      set color to 
      do while (.T.)
         set color to (cor[3])
         get_pac()
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            select PROD_ACA
            set order to 1
            goto bottom
            if (xco_prod = yco_prod)
               xco_prod:= strzero(Val(prod_aca->co_prod) + 1, 4)
            endif
            if (addrec(5))
               grava_pac()
               unlock
            endif
         endif
         exit
      enddo
      ini_pac()
      limpa_pac()
   enddo
   return

********************************
procedure TEL_PAC

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 14, xc + 60, "ͻȺ ", .T.)
   @ xl + 2, xc + 3 say "Codigo do Produto...:"
   @ xl + 3, xc + 3 say "Descricao...........:"
   @ xl + 4, xc + 3 say "Unidade.............:"
   @ xl + 5, xc + 3 say "Estoque Atual.......:"
   @ xl + 6, xc + 3 say "Custo da Mat. Prima.:"
   @ xl + 7, xc + 3 say "Preco Final.........:"
   @ xl + 8, xc + 3 say "Aliquota de ICMS....:"
   @ xl + 9, xc + 3 say "Aliquota de IPI.....:"
   @ xl + 10, xc + 3 say "Preco de Faturamento:"
   @ xl + 11, xc + 3 say "Preco de Custo......:"
   @ xl + 12, xc + 3 say "Quantidade/Cx Padrao:"
   @ xl + 13, xc + 3 say "Peso por Unidade....:"
   set color to 
   return

********************************
procedure INI_PAC

   xco_prod:= Space(4)
   xde_prod:= Space(30)
   xco_unid:= Space(2)
   xest_atu:= xval_mp:= xval_prod:= xali_ipi:= xali_icms:= 0
   xval_fatu:= xval_custo:= xqtd_padra:= xpeso_prod:= 0
   return

********************************
procedure GET_PAC

   @ xl + 3, xc + 25 get xde_prod picture "@!" valid ;
      !Empty(xde_prod) .OR. sb() when mens_when(mens[2])
   @ xl + 4, xc + 25 get xco_unid picture "!!" valid ;
      localiza(xco_unid, "TAB_UNI", 1, "M", "DESCRICAO", xl + 4, xc ;
      + 28) when mens_when(mens[3])
   @ xl + 5, xc + 25 get xest_atu picture "@E 999,999.99" when ;
      mens_when(mens[4])
   @ xl + 6, xc + 25 get xval_mp picture "@E 999,999.99" when ;
      mens_when(mens[5])
   @ xl + 7, xc + 25 get xval_prod picture "@E 999,999.99" when ;
      mens_when(mens[6])
   @ xl + 8, xc + 25 get XALI_ICMS picture "@E 999,999.99" when ;
      mens_when(mens[7])
   @ xl + 9, xc + 25 get XALI_IPI picture "@E 999,999.99" when ;
      mens_when(mens[8])
   @ xl + 10, xc + 25 get XVAL_FATU picture "@E 999,999.99" when ;
      mens_when(mens[9])
   @ xl + 11, xc + 25 get XVAL_CUSTO picture "@E 999,999.99" when ;
      mens_when(mens[10])
   @ xl + 12, xc + 25 get XQTD_PADRAO picture "@E 999,999.99" when ;
      mens_when(mens[11])
   @ xl + 13, xc + 25 get XPESO_PROD picture "@E 999.999999" when ;
      mens_when(mens[12])
   return

********************************
procedure NUC162

   local Local1, Local2
   Local2:= setcursor()
   private mens1:= ;
      {"Digite o Codigo da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Descricao da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Unidade ou tecle <ESC> p/ sair", ;
      "Digite o Estoque atual ou tecle <ESC> p/ sair", ;
      "Digite o Estoque minimo ou tecle <ESC> p/ sair", ;
      "Digite o Ultimo preco de compra ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do ICMS ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do IPI ou tecle <ESC> p/ sair", ;
      "Digite o Estoque Real ou tecle <ESC> p/ sair"}
   private xco_mp, xde_mp, xco_unid, xest_mp_at, xest_mp_mi, xult_p_mp
   private xali_ipi, xali_icms, xest_mp_ma
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "MAT. PRIMA")
   select MP_R
   set order to 1
   goto bottom
   tela_mp()
   ini_mp()
   do while (.T.)
      setcursor(1)
      set order to 1
      goto bottom
      yco_mp:= xco_mp:= strzero(Val(mp_r->co_mp) + 1, 4)
      set color to (cor[3])
      @  5, 20 get XCO_MP picture "@k 9999" valid ;
         localiza(stz(@xco_mp), "MP_R", 1, "I")
      read
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      set color to 
      do while (.T.)
         set color to (cor[3])
         get_mp()
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            select MP_R
            set order to 1
            goto bottom
            if (xco_mp = yco_mp)
               xco_mp:= strzero(Val(mp_r->co_mp) + 1, 4)
            endif
            if (addrec(5))
               grava_mp_r()
               unlock
            endif
         endif
         exit
      enddo
      ini_mp()
      limpa_mp()
   enddo
   return

********************************
procedure GET_MP

   set color to (cor[3])
   @  7, 20 get XDE_MP picture "@!" valid !Empty(xde_mp) when ;
      mens_when(mens1[2])
   @  9, 20 get XCO_UNID picture "@!" valid localiza(xco_unid, ;
      "TAB_UNI", 1, "M", "DESCRICAO", 9, 23) when mens_when(mens1[3])
   @ 11, 20 get XEST_MP_AT picture "@E 999999999.99" when ;
      mens_when(mens1[4])
   if (xcx2)
      @ 11, 43 get XEST_MP_MAX picture "@E 999999999.99" when ;
         mens_when(mens1[9])
   endif
   @ 13, 20 get XEST_MP_MI picture "@E 999999999.99" when ;
      mens_when(mens1[5])
   @ 15, 20 get XULT_P_MP picture "@E 99999.999999" when ;
      mens_when(mens1[6])
   @ 17, 20 get XALI_ICMS picture "@E 99999.99" when ;
      mens_when(mens1[7])
   @ 19, 20 get XALI_IPI picture "@E 99999.99" when ;
      mens_when(mens1[8])
   return

********************************
procedure GRAVA_FPR

   replace formula->co_prod with xco_prod
   replace formula->co_mp with xco_mp
   replace formula->qt_mp_u with xqt_mp_u
   return

********************************
procedure NUC163

   local Local1
   private mens:= {"Codigo do Produto a ser produzido", ;
      "Codigo da Materia Prima utilizada no produto", ;
      "Quantidade da Materia Prima utilizada no produto"}
   private xco_prod, xco_mp, xqt_mp_u, xl:= 3, xc:= 0, xcursor:= ;
      setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "FORMULAS")
   tel_fpr()
   ini_fpr()
   do while (.T.)
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 27 get xco_prod picture "@k 9999" valid ;
         localiza(stz(@xco_prod), "PROD_ACA", 1, "M", ;
         "DE_PROD+[           ]+CO_UNID", xl + 2, xc + 32) when ;
         mens_when(mens[1])
      @ xl + 3, xc + 27 get xco_mp picture "@k 9999" valid ;
         localiza(stz(@xco_mp), "MP_R", 1, "M", "DE_MP+[ ]+CO_UNID", ;
         xl + 3, xc + 32) when mens_when(mens[2])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      select FORMULA
      set order to 1
      seek xco_prod + xco_mp
      if (Found())
         setcursor(1)
         set color to (cor[3])
         xqt_mp_u:= qt_mp_u
         @ xl + 4, xc + 27 get xqt_mp_u picture "@E 99,999.999999"
         readkill(.T.)
         getlist:= {}
         setcursor(0)
         set color to 
         mensagem("Formula p/ este Produto com esta Materia Prima ja cadastrada. [ESC] sai.", ;
            27)
         ini_fpr()
         limpa_fpr()
         loop
      endif
      do while (.T.)
         setcursor(1)
         set color to (cor[3])
         @ xl + 4, xc + 27 get xqt_mp_u picture "@E 99,999.999999" ;
            valid xqt_mp_u > 0 when mens_when(mens[3])
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (addrec(5))
               grava_fpr()
               unlock
            else
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
            endif
         endif
         exit
      enddo
      ini_fpr()
      limpa_fpr()
   enddo

********************************
procedure TEL_FPR

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 5, xc + 76, "ͻȺ ", .T.)
   @ xl + 2, xc + 3 say "Codigo do Produto....:"
   @ xl + 3, xc + 3 say "Codigo da Mat. Prima.:"
   @ xl + 4, xc + 3 say "Quant. Mat. Prima....:"
   set color to 
   return

********************************
procedure TEL_PRD

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 6, xc + 63, "ͻȺ ", .T.)
   @ xl + 2, xc + 3 say "Codigo do Produto..:"
   @ xl + 3, xc + 3 say "Codigo do Setor....:"
   @ xl + 4, xc + 3 say "Data da Producao...:"
   @ xl + 5, xc + 3 say "Quant. Produzida...:"
   set color to 
   return

********************************
procedure GRAVA_PRD

   replace producao->co_prod with xco_prod
   replace producao->dt_prod with xdt_prod
   replace producao->qt_prod with xqt_prod
   replace producao->co_set with xco_set
   return

********************************
procedure PERMUTA_FJ

   replace clientes->jur_fis with iif(clientes->jur_fis = "J", "F", ;
      "J")
   return

********************************
procedure NUC164

   local Local1
   private mens:= {"Codigo do Produto Acabado", "Codigo do Setor", ;
      "Data da Producao", "Quantidade Produzida"}
   private xco_prod, xco_set, xdt_prod, xqt_prod, xl:= 3, xc:= 0, ;
      xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "PRODUCAO")
   tel_prd()
   ini_prd()
   do while (.T.)
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 24 get xco_prod picture "@k 9999" valid ;
         localiza(stz(@xco_prod), "PROD_ACA", 1, "M", ;
         "DE_PROD+[ ]+CO_UNID", xl + 2, xc + 29) when ;
         mens_when(mens[1])
      @ xl + 3, xc + 24 get xco_set picture "@k 999" valid ;
         localiza(stz(@xco_set), "TAB_SET", 1, "M", "DESCRICAO", xl ;
         + 3, xc + 29) .OR. sb() when mens_when(mens[2])
      @ xl + 4, xc + 24 get xdt_prod valid !Empty(xdt_prod) .AND. ;
         xdt_prod <= Date() .OR. sb() when mens_when(mens[3])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      select PRODUCAO
      set order to 1
      seek xco_prod + xco_set + DToS(xdt_prod)
      if (Found())
         xqt_prod:= qt_prod
         setcursor(1)
         set color to (cor[3])
         @ xl + 5, xc + 24 get xqt_prod picture "@E999,999.99"
         readkill(.T.)
         getlist:= {}
         setcursor(0)
         set color to 
         mensagem("Producao deste produto p/ esta data ja cadastrada. [ESC] sai.", ;
            27)
         ini_prd()
         limpa_prd()
         loop
      endif
      do while (.T.)
         xqt_prod:= qt_prod
         setcursor(1)
         set color to (cor[3])
         @ xl + 5, xc + 24 get xqt_prod picture "@E999,999.99" valid ;
            xqt_prod > 0 .OR. sb() when mens_when(mens[4])
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (!addrec(5))
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
               loop
            endif
            select PROD_ACA
            if (!reclock(5))
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
               loop
            endif
            select MP_R
            set order to 1
            if (!fillock(5))
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
               loop
            else
               select PROD_ACA
               replace prod_aca->est_atu with prod_aca->est_atu + ;
                  xqt_prod
               select FORMULA
               set order to 1
               seek xco_prod
               do while (xco_prod = formula->co_prod)
                  mp_r->(dbSeek(formula->co_mp))
                  replace mp_r->est_mp_int with mp_r->est_mp_int - ;
                     formula->qt_mp_u * xqt_prod
                  skip 
               enddo
               select PRODUCAO
               grava_prd()
               unlock all
            endif
         endif
         unlock all
         exit
      enddo
      ini_prd()
      limpa_prd()
   enddo
   return

********************************
procedure GRAVA_CGF

   replace custo_gf->co_custo with xco_custo
   replace custo_gf->co_set with xco_set
   replace custo_gf->mes_ano with xmes_ano
   replace custo_gf->val_custo with xval_custo
   return

********************************
procedure INI_CGF

   xco_custo:= Space(3)
   xco_set:= Space(3)
   xmes_ano:= Space(5)
   xval_custo:= 0
   return

********************************
procedure NUC165

   local Local1
   private mens:= {"Codigo do custo geral de fabricacao (CGF)", ;
      "Codigo do Setor", "Mes e Ano que ocorreu o custo", ;
      "Valor do custo geral de fabricacao"}
   private xco_custo, xco_set, xmes_ano, xval_custo, xl:= 3, xc:= 0, ;
      xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("LANCA", "C. G. F.")
   tel_cgf()
   ini_cgf()
   do while (.T.)
      setcursor(1)
      set color to (cor[3])
      get_cgf()
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      gra()
      if (gra = "A")
         loop
      else
         select CUSTO_GF
         if (addrec(5))
            grava_cgf()
            unlock
         else
            mensagem("Dados nao foram gravados. [ESC] p/ continuar.", ;
               27)
            loop
         endif
      endif
      ini_cgf()
      limpa_cgf()
   enddo
   return

********************************
procedure TEL_CGF

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 6, xc + 62, "ͻȺ ", .T.)
   @ xl + 2, xc + 3 say "Codigo do Custo...:"
   @ xl + 3, xc + 3 say "Codigo do Setor...:"
   @ xl + 4, xc + 3 say "Mes/Ano do Custo..:"
   @ xl + 5, xc + 3 say "Valor do Custo....:"
   set color to 
   return

********************************
procedure TRANS_CGF

   xco_custo:= custo_gf->co_custo
   xco_set:= custo_gf->co_set
   xmes_ano:= custo_gf->mes_ano
   xval_custo:= custo_gf->val_custo
   return

********************************
static function FURBOF(Arg1)

   Arg1:= SubStr(Arg1, At(">", Arg1) + 1)
   Arg1:= Trim(Upper(Arg1))
   return Arg1

********************************
procedure GET_CGF

   @ xl + 2, xc + 23 get xco_custo picture "@k 999" valid ;
      localiza(stz(@xco_custo), "TAB_CGF", 1, "M", "DESCRICAO", xl + ;
      2, xc + 28) when mens_when(mens[1])
   @ xl + 3, xc + 23 get xco_set picture "@k 999" valid ;
      localiza(stz(@xco_set), "TAB_SET", 1, "M", "DESCRICAO", xl + ;
      3, xc + 28) .OR. sb() when mens_when(mens[2])
   @ xl + 4, xc + 23 get xmes_ano picture "99/99" valid ;
      val_ma(xmes_ano) .AND. localiza(xco_custo + xco_set + ;
      descend(ma_to_s(xmes_ano)), "CUSTO_GF", 1, "I", Nil, Nil, Nil, ;
      Nil, ;
      "Custo e setor ja cadastro para este mes. Tecle [ESC] para sair") ;
      .OR. sb() when mens_when(mens[3])
   @ xl + 5, xc + 23 get xval_custo picture "@E 999,999.99" valid ;
      xval_custo > 0 when mens_when(mens[4])
   return

********************************
procedure LIMPA_CGF

   set color to (cor[1])
   @ xl + 2, xc + 23 clear to xl + 5, xc + 58
   set color to 
   return

********************************
procedure TEL_MMP

   set color to (cor[1])
   window(xl + 1, xc + 1, xl + 6, xc + 73, "ͻȺ ", .T.)
   @ xl + 2, xc + 3 say "Codigo da M.Prima..:"
   @ xl + 3, xc + 3 say "Codigo do Setor....:"
   @ xl + 4, xc + 3 say "Data do Movimento..:"
   @ xl + 5, xc + 3 say "Quant. Movimentada.:"
   set color to 
   return

********************************
procedure INI_MMP

   xco_mp:= Space(4)
   xdt_mp:= CToD("")
   xqt_mp:= 0
   xco_set:= Space(3)
   return

********************************
procedure FUNC0019


********************************
procedure NUC166

   local Local1
   private mens:= {"Codigo do Materia Prima", "Codigo do Setor", ;
      "Data do Movimento", "Quantidade Movimentada"}
   private xco_mp, xco_set, xdt_mp, xqt_mp, xl:= 3, xc:= 0, ;
      xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "MOVIMENTO")
   tel_mmp()
   ini_mmp()
   do while (.T.)
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 24 get xco_mp picture "@K 9999" valid ;
         localiza(stz(@xco_mp), "MP_R", 1, "M", "DE_MP+[ ]+CO_UNID", ;
         xl + 2, xc + 29) when mens_when(mens[1])
      @ xl + 3, xc + 24 get xco_set picture "@K 999" valid ;
         localiza(stz(@xco_set), "TAB_SET", 1, "M", "DESCRICAO", xl ;
         + 3, xc + 29) .OR. sb() when mens_when(mens[2])
      @ xl + 4, xc + 24 get xdt_mp valid !Empty(xdt_mp) .AND. xdt_mp ;
         <= Date() .OR. sb() when mens_when(mens[3])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      select MP_INT
      set order to 1
      seek xco_mp + xco_set + DToS(xdt_mp)
      if (Found())
         xqt_mp:= qt_mp
         setcursor(1)
         set color to (cor[3])
         @ xl + 5, xc + 24 get xqt_mp picture "@E999,999.99"
         readkill(.T.)
         getlist:= {}
         setcursor(0)
         set color to 
         ms250("Movimento de materia prima p/ este setor/data ja cadastrada. [ESC] sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         ini_mmp()
         limpa_mmp()
         loop
      endif
      do while (.T.)
         xqt_mp:= qt_mp
         setcursor(1)
         set color to (cor[3])
         @ xl + 5, xc + 24 get xqt_mp picture "@E999,999.99" valid ;
            xqt_mp > 0 .OR. sb() when mens_when(mens[4])
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            if (!addrec(5))
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
               loop
            endif
            select MP_R
            if (!reclock(5))
               mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                  27)
               loop
            endif
         endif
         grava_mmp()
         replace mp_r->est_mp_int with mp_r->est_mp_int + xqt_mp
         replace mp_r->est_mp_max with mp_r->est_mp_max - xqt_mp
         unlock all
         exit
      enddo
      ini_mmp()
      limpa_mmp()
   enddo
   return

********************************
procedure TRANS_MMP

   xco_mp:= mp_int->co_mp
   xdt_mp:= mp_int->dt_mp
   xqt_mp:= mp_int->qt_mp
   xco_set:= mp_int->co_set
   return

********************************
procedure GRAVA_MMP

   replace mp_int->co_mp with xco_mp
   replace mp_int->dt_mp with xdt_mp
   replace mp_int->qt_mp with xqt_mp
   replace mp_int->co_set with xco_set
   return

********************************
procedure LIMPA_MMP

   set color to (cor[1])
   @ xl + 2, xc + 24 clear to xl + 5, xc + 72
   set color to 
   return

********************************
procedure INI_MP2

   cco_mp:= Space(4)
   nqtd_mp:= 0
   ctipo_mov:= Space(1)
   cco_set:= Space(3)
   crefer:= Space(40)
   ddt_mov_mp:= CToD(" ")
   return

********************************
procedure TRANS_MP2

   cco_mp:= mov_mp->co_mp
   nqtd_mp:= mov_mp->qtd_mp
   ctipo_mov:= mov_mp->tipo_mov
   cco_set:= mov_mp->co_set
   crefer:= mov_mp->refer
   ddt_mov_mp:= mov_mp->dt_mov_mp
   return

********************************
procedure NUC167

   local Local1, Local2
   Local2:= setcursor()
   private cco_mp, nqtd_mp, ctipo_mov, cco_set, crefer, ddt_mov_mp
   private mp2:= ;
      {"Digite o Codigo da Materia Prima, ou tecle [ESC] para sair", ;
      "Digite o Codigo do Setor da Materia Prima ", ;
      "Digite a Data de Movimento da Materia Prima", ;
      "Digite a Quantidade de Materia Prima", ;
      "Digite a Referencia da Materia Prima", ;
      "Digite se o Tipo de Movimento e de Entrada ou Saida de Materia Prima"}
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "ESTOQUE")
   set date british
   set century on
   ini_mp2()
   set color to (cor[1])
   tela_mp2()
   set color to 
   do while (.T.)
      setcursor(1)
      set color to (cor[1])
      @  5, 25 clear to 15, 69
      set color to 
      set color to (cor[3])
      get_mp2("I")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select MP_R
      mp_r->(dbSetOrder(1))
      mov_mp->(dbSeek(cco_mp))
      if (mp_r->(EOF()))
         ms250("Codigo de Materia Prima nao Cadastrada, tecle [ESC] para continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      gra()
      if (gra = "A")
         loop
      elseif (gra = "G")
         select MP_R
         mp_r->(dbSetOrder(1))
         mp_r->(dbSeek(cco_mp))
         mp_r->(reclock())
         select MOV_MP
         if (addrec(5))
            grava_mp2()
            if (ctipo_mov = "E")
               replace mp_r->est_mp_at with mp_r->est_mp_at + nqtd_mp
            else
               replace mp_r->est_mp_at with mp_r->est_mp_at - nqtd_mp
            endif
            unlock all
         else
            set color to (cor[1])
            ms250("Sr. usuario, nao foi possivel gravar este registro. Aperte uma tecla", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         endif
      endif
      ini_mp2()
      set color to (cor[1])
      @  5, 25 clear to 15, 69
      set color to 
   enddo
   return

********************************
procedure TELA_MP2

   window(4, 1, 16, 70, "ͻȺ ", .T.)
   @  5,  3 say "Cod.Materia Prima...:"
   @  7,  3 say "Codigo Setor........:"
   @  9,  3 say "Data Movimento......:"
   @ 11,  3 say "Quantidade..........:"
   @ 13,  3 say "Referencia..........:"
   @ 15,  3 say "Tipo Movimento(E/S).:"
   return

********************************
procedure GRAVA_MP2

   replace mov_mp->co_mp with cco_mp
   replace mov_mp->qtd_mp with nqtd_mp
   replace mov_mp->tipo_mov with ctipo_mov
   replace mov_mp->co_set with cco_set
   replace mov_mp->refer with crefer
   replace mov_mp->dt_mov_mp with ddt_mov_mp
   return

********************************
procedure TELA_PED

   set color to (cor[1])
   window(4, 1, 9, 70, "ͻȺ ", .T.)
   @  5,  3 say "Num. do pedido.:"
   @  6,  3 say "Pedido anterior:"
   @  7,  3 say "Fornecedor.....:"
   @  8,  3 say "Data do pedido.:"
   set color to 
   return

********************************
procedure INI_PED

   xnr_ped_o:= xnr_ped:= xnr_nf:= Space(6)
   xcod_fo:= Space(4)
   xdt_ped:= xdt_re_ped:= xdt_em_nf:= CToD("")
   return

********************************
function __GETDWLEF

   qself():wordleft()
   qself():delwordrig()
   return qself()

********************************
procedure GET_MP2(Arg1)

   @  5, 25 get cCO_MP picture "@k 9999" valid ;
      localiza(stz(@cco_mp), "MP_R", 1, "M", ;
      "trim(substr(DE_MP,01,30))+[ ]+CO_UNID", 5, 30) when iif(Arg1 ;
      = "I", .T., .F.) .AND. mens_when(mp2[1])
   @  7, 25 get cCO_SET picture "@k 999" valid ;
      localiza(stz(@cco_set), "TAB_SET", 1, "M", "DESCRICAO", 7, 30) ;
      .OR. sb() when mens_when(mp2[2])
   @  9, 25 get dDT_MOV_MP valid !Empty(ddt_mov_mp) .AND. ddt_mov_mp ;
      <= Date() .OR. sb() when mens_when(mp2[3])
   @ 11, 25 get nQTD_MP picture "@E 9999999999.999" when ;
      mens_when(mp2[4])
   @ 13, 25 get cREFER picture "@!" when mens_when(mp2[5])
   @ 15, 25 get cTIPO_MOV picture "!" valid ctipo_mov $ "ES" when ;
      iif(Arg1 = "I", .T., .F.) .AND. mens_when(mp2[6])
   return

********************************
procedure GET_PED

   set color to (cor[3])
   @  6, 20 get XNR_PED_O picture "999999" when mens_when(mens1[1])
   @  7, 20 get XCOD_FO picture "@k 9999" valid ;
      localiza(stz(@xcod_fo), "FORNECED", 1, "M", "NOME_FO", 7, 25) ;
      .OR. sb() when mens_when(mens1[2])
   @  8, 20 get XDT_PED picture "@D" valid !Empty(xdt_ped) .AND. ;
      xdt_ped <= Date() .OR. sb() when mens_when(mens1[3])
   return

********************************
procedure DISP_IT3

   localiza(xco_prod, "PROD_ACA", 1, "M", "DE_PROD", 15, 25)
   return

********************************
procedure NUC17

   local Local1
   Local1:= {}
   AAdd(Local1, {12, 24, " Compras  ", padc("Cadastra Compras", ;
      80)})
   AAdd(Local1, {13, 24, " Vendas   ", padc("Cadastra Vendas", ;
      80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "COMERCIAL")
   m_clientes:= 1
   do while (.T.)
      set color to (cor[14])
      window(11, 23, 14, 34, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("NUC171"))
            nuc171()
         endif
      case m_clientes = 2
         if (acesso("NUC172"))
            nuc172()
         endif
      case m_clientes = 3
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure GRAV_PED_R

   replace ped_mp_r->nr_ped_o with xnr_ped_o
   replace ped_mp_r->nr_ped with xnr_ped
   replace ped_mp_r->cod_fo with xcod_fo
   replace ped_mp_r->dt_ped with xdt_ped
   replace ped_mp_r->dt_re_ped with xdt_re_ped
   replace ped_mp_r->dt_em_nf with xdt_em_nf
   replace ped_mp_r->nr_nf with xnr_nf
   replace ped_mp_r->editavel with xcx2
   return

********************************
procedure GRAV_PED_F

   replace ped_mp_f->nr_ped_o with xnr_ped_o
   replace ped_mp_f->nr_ped with xnr_ped
   replace ped_mp_f->cod_fo with xcod_fo
   replace ped_mp_f->dt_ped with xdt_ped
   replace ped_mp_f->dt_re_ped with xdt_re_ped
   replace ped_mp_f->dt_em_nf with xdt_em_nf
   replace ped_mp_f->nr_nf with xnr_nf
   return

********************************
procedure LIMPA_PED

   set color to (cor[1])
   @  5, 20 clear to  8, 69
   set color to 
   return

********************************
procedure TRANS_PED

   xnr_ped_o:= nr_ped_o
   xnr_ped:= nr_ped
   xcod_fo:= cod_fo
   xdt_ped:= dt_ped
   xdt_re_ped:= dt_re_ped
   xdt_em_nf:= dt_em_nf
   xnr_nf:= nr_nf
   return

********************************
procedure TRANS_IT

   xnr_ped:= nr_ped
   xnr_item_p:= nr_item_pd
   xco_mp:= co_mp
   xqt_pe_mp:= qt_pe_mp
   xqt_re_mp:= qt_re_mp
   xval_mp:= val_mp
   xper_icms:= per_icms
   xper_ipi:= per_ipi
   return

********************************
function __GETSETPR(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[5]:= Arg1
   endif
   return qself()[5]

********************************
procedure NUC171

   local Local1, Local2
   Local2:= setcursor()
   private mens1:= ;
      {"Digite o Numero do Pedido Anterior ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite a Data do Pedido ou tecle <ESC> p/ sair"}
   private mens2:= ;
      {"Digite o Codigo da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade Pedida da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite o Preco Unitario da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do ICMS ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do IPI ou tecle <ESC> p/ sair"}
   private xnr_ped_o, xnr_ped, xcod_fo, xdt_ped, xdt_re_ped, ;
      xdt_em_nf, xnr_nf
   private xnr_item_p, xco_mp, xqt_pe_mp, xqt_re_mp, xval_mp, ;
      xper_icms
   private xper_ipi
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "PEDIDO")
   tela_ped()
   ini_ped()
   do while (.T.)
      setcursor(1)
      ped_mp_r->(dbSetOrder(1))
      ped_mp_r->(dbGoBottom())
      xnr_ped:= strzero(Val(ped_mp_r->nr_ped) + 1, 6)
      set color to (cor[3])
      @  5, 20 get XNR_PED picture "@K 999999" valid ;
         localiza(stz(@xnr_ped), "PED_MP_R", 1, "I") when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      do while (.T.)
         set color to (cor[3])
         get_ped()
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0
         xcontinua:= confirme()
         exit
      enddo
      if (LastKey() = K_ESC .OR. xcontinua = .F.)
         ini_ped()
         limpa_ped()
         loop
      endif
      tela_item()
      ini_item()
      xnr_item_p:= strzero(1, 2)
      do while (.T.)
         set color to (cor[3])
         @ 13, 20 get XNR_ITEM_P picture "99"
         readkill(.T.)
         getlist:= {}
         set color to 
         do while (.T.)
            setcursor(1)
            set color to (cor[3])
            get_item()
            read
            setcursor(0)
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            gra()
            if (gra = "A")
               loop
            elseif (gra = "G")
               xok:= .T.
               if (xnr_item_p = "01")
                  select PED_MP_R
                  if (!addrec(5))
                     xok:= .F.
                  endif
               endif
               select IT_P_MPR
               if (!addrec(5))
                  xok:= .F.
               endif
               if (!xcx2 .AND. xok)
                  if (Val(xnr_item_p) == 1)
                     select PED_MP_F
                     if (!addrec(5))
                        xok:= .F.
                     endif
                  endif
                  if (xok)
                     select IT_P_MPF
                     if (!addrec(5))
                        xok:= .F.
                        if (Val(xnr_item_p) == 1)
                           select PED_MP_F
                           delete
                        endif
                     endif
                  endif
               endif
               if (!xok)
                  select IT_P_MPR
                  delete
               endif
               if (xok)
                  if (Val(xnr_item_p) == 1)
                     select PED_MP_R
                     ynr_ped:= xnr_ped
                     ped_mp_r->(dbSetOrder(1))
                     xrecno:= ped_mp_r->(RecNo())
                     ped_mp_r->(dbGoBottom())
                     xnr_ped:= strzero(Val(ped_mp_r->nr_ped) + 1, 6)
                     goto xrecno
                     grav_ped_r()
                     dbcommit()
                     unlock
                     if (ynr_ped != xnr_ped)
                        ms250("O numero deste pedido foi alterado para " ;
                           + xnr_ped + ;
                           ". Tecle [ESC] para continuar.", 24, ;
                           0, cor[6], cor[7], {27}, Nil, 80, "C")
                     endif
                     if (!xcx2)
                        select PED_MP_F
                        grav_ped_f()
                        unlock
                     endif
                  endif
                  select IT_P_MPR
                  grav_it_r()
                  unlock
                  if (!xcx2)
                     select IT_P_MPF
                     grav_it_f()
                     unlock
                  endif
               else
                  xnr_item_p:= strzero(Val(xnr_item_p) + 1, 2)
               endif
            endif
            exit
         enddo
         if (LastKey() = K_ESC .OR. gra = "R")
            ini_ped()
            limpa_ped()
            set color to (cor[1])
            @ 11,  1 clear to 18, 71
            set color to 
            exit
         endif
         xnr_item_p:= strzero(Val(xnr_item_p) + 1, 2)
         ini_item()
         limpa_item()
      enddo
      set color to (cor[12])
      @ 11,  1 clear to 21, 71
      set color to 
   enddo
   return

********************************
procedure TELA_ITEM

   set color to (cor[1])
   window(12, 1, 19, 70, "ͻȺ ", .T.)
   @ 13,  3 say "Numero do Item.:"
   @ 14,  3 say "Codigo da M.P. :"
   @ 15,  3 say "Quantidade M.P.:"
   @ 16,  3 say "Val. unit. M.P.:"
   @ 17,  3 say "Aliquota ICMS..:"
   @ 18,  3 say "Aliquota IPI...:"
   set color to 
   return

********************************
procedure LIMPA_ITEM

   set color to (cor[1])
   @ 14, 20 clear to 18, 69
   set color to 
   return

********************************
procedure GRAV_IT_R

   replace it_p_mpr->nr_ped with xnr_ped
   replace it_p_mpr->nr_item_pd with xnr_item_p
   replace it_p_mpr->co_mp with xco_mp
   replace it_p_mpr->qt_pe_mp with xqt_pe_mp
   replace it_p_mpr->qt_re_mp with xqt_re_mp
   replace it_p_mpr->val_mp with xval_mp
   replace it_p_mpr->per_icms with xper_icms
   replace it_p_mpr->per_ipi with xper_ipi
   return

********************************
procedure GRAV_IT_F

   replace it_p_mpf->nr_ped with xnr_ped
   replace it_p_mpf->nr_item_pd with xnr_item_p
   replace it_p_mpf->co_mp with xco_mp
   replace it_p_mpf->qt_pe_mp with xqt_pe_mp
   replace it_p_mpf->qt_re_mp with xqt_re_mp
   replace it_p_mpf->val_mp with xval_mp
   replace it_p_mpf->per_icms with xper_icms
   replace it_p_mpf->per_ipi with xper_ipi
   return

********************************
procedure LIMPA_VEND

   set color to (cor[1])
   @  5, 20 clear to 11, 69
   set color to 
   return

********************************
procedure FUNC0016


********************************
procedure GET_ITEM

   set color to (cor[3])
   @ 14, 20 get XCO_MP picture "@K 9999" valid ;
      localiza(stz(@xco_mp), "MP_R", 1, "M", "DE_MP", 14, 25) .AND. ;
      mp_pedida() when mens_when(mens2[1])
   @ 15, 20 get XQT_PE_MP picture "@E 99,999,999.999999" valid ;
      !Empty(xqt_pe_mp) .OR. sb() when mens_when(mens2[2])
   @ 16, 20 get XVAL_MP picture "@E 99,999,999.999999" valid ;
      !Empty(xval_mp) .OR. sb() when mens_when(mens2[3])
   @ 17, 20 get XPER_ICMS picture "@E 999,999.99" when ;
      mens_when(mens2[4]) .AND. iif(xper_icms = 0, (xper_icms:= ;
      ali_mp("ICMS")) = xper_icms, .T.)
   @ 18, 20 get XPER_IPI picture "@E 999,999.99" when ;
      mens_when(mens2[5]) .AND. iif(xper_ipi = 0, (xper_ipi:= ;
      ali_mp("IPI")) = xper_ipi, .T.)
   return

********************************
function MP_PEDIDA

   it_p_mpr->(dbSetOrder(2))
   it_p_mpr->(dbSeek(xco_mp + xnr_ped))
   if (it_p_mpr->(Found()))
      @ 23,  0
      mensagem("Pedido p/ esta Materia Prima ja foi cadastrado. <ESC> p/ sair", ;
         27)
      return .F.
   endif
   return .T.

********************************
function ALI_MP(Arg1)

   mp_r->(dbSetOrder(1))
   mp_r->(dbSeek(xco_mp))
   if (Arg1 = "ICMS")
      return mp_r->ali_icms
   else
      return mp_r->ali_ipi
   endif

********************************
procedure INI_VEND

   xnr_ped_o:= xnr_ped:= xnr_nf:= Space(6)
   xcod_cl:= Space(5)
   xdt_ped:= xdt_em_nf:= CToD("")
   xco_cpag:= xco_ven:= Space(3)
   xper_comis:= 0
   xnr_carga:= Space(6)
   return

********************************
procedure TRANS_VEND

   xnr_ped_o:= nr_ped_o
   xnr_ped:= nr_ped
   xcod_cl:= cod_cl
   xdt_ped:= dt_ped
   xdt_em_nf:= dt_em_nf
   xnr_nf:= nr_nf
   xco_cpag:= co_cpag
   xco_ven:= co_ven
   xnr_carga:= nr_carga
   xper_comis:= per_comis
   return

********************************
procedure FUNC0044


********************************
procedure NUC172

   local Local1
   private mens1:= ;
      {"Digite o Numero do Pedido Anterior ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite a Data do Pedido ou tecle <ESC> p/ sair", ;
      "Digite o Codigo da Condicao de Pagamento ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Percentual de Comissao do Vendedor ou tecle <ESC> p/ sair"}
   private mens2:= ;
      {"Digite o Codigo do Produto ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade Pedida do Produto ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade de Brinde ou tecle <ESC> p/ sair", ;
      "Digite o Valor Unitario do Produto ou tecle <ESC> p/ sair"}
   private xnr_ped_o, xnr_ped, xcod_cl, xdt_ped, xdt_em_nf, xnr_nf
   private xco_cpag, xco_ven, xper_comis, xnr_item_p, xco_prod, ;
      xqt_pe_pro
   private xqt_en_pro, xval_prod, xal_icms, xal_ipi, xnr_carga
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "PEDIDO")
   tela_vend()
   setcursor(1)
   do while (.T.)
      setcursor(1)
      set color to (cor[1])
      ini_vend()
      limpa_vend()
      select VENDAS_R
      set order to 1
      goto bottom
      xnr_ped:= strzero(Val(nr_ped) + 1, 6)
      ynr_ped:= xnr_ped
      set color to (cor[3])
      @  5, 20 get XNR_PED picture "@K 999999" valid ;
         localiza(stz(@xnr_ped), "VENDAS_R", 1, "I") when ;
         mens_when("Digite o Numero do Pedido ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         set color to (cor[1])
         restore screen from Local1
         return
      endif
      if (xnr_ped > ynr_ped)
         loop
      endif
      do while (.T.)
         xok:= .T.
         get_ven172()
         read
         if (LastKey() == K_ESC)
            exit
         endif
         set color to 
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            xok:= .T.
            select VENDAS_R
            set order to 1
            goto bottom
            xnr_ped:= iif(xnr_ped != ynr_ped, xnr_ped, ;
               strzero(Val(nr_ped) + 1, 6))
            if (addrec(5))
               if (!xcx2)
                  select VENDAS_F
                  if (addrec(5))
                     gra_vend_f()
                     select VENDAS_R
                     gra_vend_r()
                  else
                     xok:= .F.
                     select VENDAS_R
                     delete
                     unlock
                  endif
               else
                  gra_vend_r()
               endif
            else
               xok:= .F.
            endif
         endif
         exit
      enddo
      if (LastKey() = K_ESC .OR. gra = "R")
         loop
      endif
      if (!xok)
         if (gra = "G")
            tone(880, 5)
            ms250("Nao foi possivel gravar os dados acima, tecle [ESC] para continuar", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         endif
         loop
      endif
      xxv_total:= 0
      xyv_total:= 0
      set color to (cor[1])
      window(15, 19, 17, 60, "ͻȺ ", .T.)
      @ 16, 21 say "Valor total do pedido :"
      set color to (cor[3])
      set confirm on
      @ 16, 45 get xxv_total picture "@e 999,999,999.99"
      read
      set confirm off
      tel_i_ven()
      xnr_item_p:= strzero(1, 2)
      xdigitou_i:= .F.
      do while (.T.)
         lim_i_ven()
         ini_i_ven()
         set color to (cor[3])
         @ 14, 20 get XNR_ITEM_P picture "99"
         readkill(.T.)
         getlist:= {}
         set color to 
         do while (.T.)
            xok:= .T.
            if (xdigitou_i)
               ms250(" Pressione [Shift + F6] para verificar itens digitados.", ;
                  23, 0, cor[1], cor[2], Nil, Nil, 80, "C")
               set key K_SH_F6 to mostra_ped
            endif
            setcursor(1)
            set color to (cor[3])
            get_i_ven()
            read
            set color to 
            @ 23,  0 say Space(80)
            SetKey(K_SH_F6, Nil)
            if (LastKey() == K_ESC)
               tone(540, 2)
               if ;
                     (ms250("Deseja sair do cadastro de pedidos <S/N> ?", ;
                     24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") ;
                     == 78)
                  loop
               endif
               setcursor(1)
               if (xnr_item_p = "01")
                  select VENDAS_R
                  delete
                  unlock
                  if (!xcx2)
                     select VENDAS_F
                     delete
                     unlock
                  endif
               endif
               ms250("O Valor Total dos Itens Digitados e de " + ;
                  LTrim(Transform(xyv_total, "@E 999,999,999.99")) + ;
                  ". Tecle [ESC] p/ cont.", 24, 0, cor[6], ;
                  cor[7], {27}, Nil, 80, "c")
               if (xxv_total != xyv_total)
                  tone(880, 5)
                  tone(1220, 3)
                  ms250("Valor digitado dos ITENS diferente do valor do PEDIDO. Tecle [ESC] p/ cont.", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
               endif
               exit
            endif
            gra()
            if (gra = "A")
               loop
            elseif (gra = "G")
               select ITEM_VER
               if (addrec(5))
                  if (!xcx2)
                     select ITEM_VEF
                     if (addrec(5))
                        gra_itve_f()
                        select ITEM_VER
                        gra_itve_r()
                        unlock all
                     else
                        xok:= .F.
                        select ITEM_VER
                        delete
                        unlock
                     endif
                  else
                     gra_itve_r()
                     unlock all
                  endif
                  xyv_total:= xyv_total + item_ver->val_prod * ;
                     item_ver->qt_pe_prod
               else
                  xok:= .F.
               endif
            endif
            exit
         enddo
         if (LastKey() == K_ESC)
            exit
         endif
         if (!xok)
            if (gra = "G")
               tone(880, 5)
               ms250("Nao foi possivel gravar o ITEM acima, tecle [ESC] para continuar", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
            endif
            loop
         endif
         if (gra = "G")
            xdigitou_i:= .T.
            xnr_item_p:= strzero(Val(xnr_item_p) + 1, 2)
         endif
      enddo
      set color to (cor[12])
      @ 13,  1 clear to 21, 71
      set color to 
      unlock all
   enddo
   return

********************************
procedure TELA_VEND

   set color to (cor[1])
   window(4, 1, 12, 70, "ͻȺ ", .T.)
   @  5,  3 say "Num. do pedido.:"
   @  6,  3 say "Pedido anterior:"
   @  7,  3 say "Cliente........:"
   @  8,  3 say "Data do pedido.:"
   @  9,  3 say "Cond. pagamento:"
   @ 10,  3 say "Codigo Vendedor:"
   @ 11,  3 say "Comissao Vend. :"
   set color to 
   return

********************************
procedure GRA_VEND_R

   replace vendas_r->nr_ped_o with xnr_ped_o
   replace vendas_r->nr_ped with xnr_ped
   replace vendas_r->cod_cl with xcod_cl
   replace vendas_r->dt_ped with xdt_ped
   replace vendas_r->dt_em_nf with xdt_em_nf
   replace vendas_r->nr_nf with xnr_nf
   replace vendas_r->co_cpag with xco_cpag
   replace vendas_r->co_ven with xco_ven
   replace vendas_r->per_comis with xper_comis
   replace vendas_r->editavel with xcx2
   return

********************************
function M_PED(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2
   if (Local1 == 27)
      Local2:= 0
   endif
   return Local2

********************************
procedure FUNC0012


********************************
procedure GET_VEND

   set color to (cor[3])
   @  6, 20 get XNR_PED_O picture "999999" when mens_when(mens1[1])
   @  6, 60 get XNR_CARGA when .F.
   @  7, 20 get XCod_CL picture "@K 99999" valid ;
      localiza(stz(@xcod_cl), "CLIENTES", 1, "M", "NOME_CL", 7, 26) ;
      .OR. sb() when mens_when(mens1[2])
   @  8, 20 get XDT_PED picture "@D" valid !Empty(xdt_ped) .AND. ;
      xdt_ped <= Date() .OR. sb() when mens_when(mens1[3])
   @  9, 20 get XCO_CPAG picture "@K 999" valid ;
      localiza(stz(@xco_cpag), "TAB_CPA", 1, "M", "DESCRICAO", 9, ;
      25) .OR. sb() when mens_when(mens1[4])
   @ 10, 20 get XCO_VEN picture "@K 999" valid ;
      localiza(stz(@xco_ven), "TAB_VEN", 1, "M", "NOME_VEN", 10, 25) ;
      .OR. sb() when mens_when(mens1[5])
   @ 11, 20 get XPER_COMIS picture "99.99" when mens_when(mens1[6])
   return

********************************
procedure GRA_VEND_F

   replace vendas_f->nr_ped_o with xnr_ped_o
   replace vendas_f->nr_ped with xnr_ped
   replace vendas_f->cod_cl with xcod_cl
   replace vendas_f->dt_ped with xdt_ped
   replace vendas_f->dt_em_nf with xdt_em_nf
   replace vendas_f->nr_nf with xnr_nf
   replace vendas_f->co_cpag with xco_cpag
   replace vendas_f->co_ven with xco_ven
   replace vendas_f->per_comis with xper_comis
   return

********************************
procedure GRA_ITVE_R

   replace item_ver->nr_ped with xnr_ped
   replace item_ver->nr_item_pd with xnr_item_p
   replace item_ver->co_prod with xco_prod
   replace item_ver->qt_pe_prod with xqt_pe_pro
   replace item_ver->qt_en_prod with xqt_en_pro
   replace item_ver->val_prod with xval_prod
   replace item_ver->al_icms with xal_icms
   replace item_ver->al_ipi with xal_ipi
   return

********************************
function ALI_PA(Arg1)

   prod_aca->(dbSetOrder(1))
   prod_aca->(dbSeek(xco_prod))
   if (Arg1 = "ICMS")
      return prod_aca->ali_icms
   else
      return prod_aca->ali_ipi
   endif

********************************
procedure __KILLREAD

   Static23:= .T.
   return

********************************
procedure GET_VEN172

   set color to (cor[3])
   @  6, 20 get XNR_PED_O picture "999999" when mens_when(mens1[1])
   @  7, 20 get XCod_CL picture "@K 99999" valid ;
      localiza(stz(@xcod_cl), "CLIENTES", 1, "M", "NOME_CL", 7, 26) ;
      .OR. sb() when mens_when(mens1[2])
   @  8, 20 get XDT_PED picture "@D" valid !Empty(xdt_ped) .AND. ;
      xdt_ped <= Date() .OR. sb() when mens_when(mens1[3])
   @  9, 20 get XCO_CPAG picture "@K 999" valid ;
      localiza(stz(@xco_cpag), "TAB_CPA", 1, "M", "DESCRICAO", 9, ;
      25) .OR. sb() when mens_when(mens1[4])
   @ 10, 20 get XCO_VEN picture "@K 999" valid ;
      localiza(stz(@xco_ven), "TAB_VEN", 1, "M", "NOME_VEN", 10, 25) ;
      .OR. sb() when mens_when(mens1[5])
   @ 11, 20 get XPER_COMIS picture "99.99" when mens_when(mens1[6])
   return

********************************
procedure TEL_I_VEN

   set color to (cor[1])
   window(13, 1, 18, 70, "ͻȺ ", .T.)
   @ 14,  3 say "Numero do Item.:"
   @ 15,  3 say "Cod. do Produto:"
   @ 16,  3 say "Qtde Produto...:"
   @ 17,  3 say "Val. unit. Prod:"
   set color to 
   return

********************************
procedure TRA_I_RF

   xnr_ped:= nr_ped
   xnr_item_p:= nr_item_pd
   xco_prod:= co_prod
   xqt_pe_pro:= qt_pe_prod
   xqt_en_pro:= qt_en_prod
   xval_prod:= val_prod
   xal_icms:= al_icms
   xal_ipi:= al_ipi
   return

********************************
procedure LIM_I_VEN

   set color to (cor[1])
   @ 14, 20 clear to 17, 69
   set color to 
   return

********************************
procedure GET_I_VEN

   set color to (cor[3])
   @ 15, 20 get XCO_PROD picture "@K 9999" valid ;
      localiza(stz(@xco_prod), "PROD_ACA", 1, "M", "DE_PROD", 15, ;
      25) .AND. prod_pedi() when mens_when(mens2[1])
   @ 16, 20 get XQT_PE_PRO picture "@E 999,999.99" valid ;
      !Empty(xqt_pe_pro) .OR. sb() when mens_when(mens2[2])
   @ 17, 20 get XVAL_PROD picture "@E 999,999.99" when ;
      mens_when(mens2[3])
   return

********************************
procedure GRA_ITVE_F

   replace item_vef->nr_ped with xnr_ped
   replace item_vef->nr_item_pd with xnr_item_p
   replace item_vef->co_prod with xco_prod
   replace item_vef->qt_pe_prod with xqt_pe_pro
   replace item_vef->qt_en_prod with xqt_en_pro
   replace item_vef->val_prod with xval_prod
   replace item_vef->al_icms with xal_icms
   replace item_vef->al_ipi with xal_ipi
   return

********************************
function PROD_PEDI

   item_ver->(dbSetOrder(2))
   item_ver->(dbSeek(xco_prod + xnr_ped))
   if (item_ver->(Found()))
      @ 23,  0
      mensagem("Pedido p/ este Produto ja foi cadastrado. <ESC> p/ sair", ;
         27)
      return .F.
   endif
   return .T.

********************************
function HIST_CL

   parameters usr_memo, lin1, col1, lin2, col2, rest_tela
   private salva_hist, ret_val:= 0
   set scoreboard off
   salva_hist:= SaveScreen(lin1 - 1, col1 - 1, lin2, col2 + 1)
   set color to (cor[1])
   window(lin1, col1, lin2, col2, "ͻȺ ", .T.)
   set color to (cor[9])
   @ lin2, col1 + 63 say " [  ] Grava "
   set color to (cor[10])
   @ lin2, col1 + 65 say "F2"
   set color to 
   set color to 
   set color to (cor[1])
   usr_memo:= memoedit(usr_memo, lin1 + 1, col1 + 2, lin2 - 1, col2 ;
      - 1, .T., "XFUNC", 73)
   set color to 
   if (rest_tela = Nil)
      RestScreen(lin1 - 1, col1 - 1, lin2, col2 + 1, salva_hist)
   endif
   return hardcr(usr_memo)

********************************
procedure GRAVA_EMP2

   replace empresti->val_liqui with xval_liqui
   replace empresti->dt_liqui with xdt_liqui
   return

********************************
procedure MOSTRA_PED

   local Local1:= alias(), Local2, Local3:= SetColor(""), Local4, ;
      Local5, Local6, Local7, Local8, Local9
   save screen to Local2
   select (iif(xcx2, "ITEM_VER", "ITEM_VEF"))
   set order to 1
   seek xnr_ped
   prod_aca->(dbSetOrder(1))
   Local4:= {}
   do while (nr_ped = xnr_ped .AND. !EOF())
      Local5:= co_prod
      Local6:= qt_pe_prod
      Local7:= val_prod
      prod_aca->(dbSeek(Local5))
      Local8:= prod_aca->de_prod
      AAdd(Local4, " " + nr_item_pd + "  " + Local8 + "  " + ;
         Transform(Local6, "@E 999,999.99") + "  " + ;
         Transform(Local7, "@E 999,999,999.99") + " ")
      skip 
   enddo
   set color to 
   @ 23,  0 say Space(80)
   ms250(" Tecle <ESC> para continuar...", 24, 0, cor[1], cor[2], ;
      Nil, Nil, 80, "C")
   set color to (cor[19])
   window(13, 1, 20, 70, "ͻȺ ", .T.)
   @ 14,  2 say ;
      "Item  Descricao da Mercadoria          Quantidade   Preco Unitario"
   @ 15,  2 to 15, 69
   Local9:= achoice(16, 2, 19, 69, Local4, Nil, "M_PED")
   set color to 
   restore screen from Local2
   select (Local1)
   set color to (Local3)
   return

********************************
function XFUNC(Arg1, Arg2, Arg3)

   local Local1
   ret_val:= 0
   if (Arg1 = 0)
      @ lin1, col1 + 3 say "[ " + strzero(Arg2, 3) + ", " + ;
         strzero(Arg3, 3) + " ]"
   else
      Local1:= LastKey()
      if (Local1 = -1)
         ret_val:= 23
      elseif (Local1 = 27)
         ret_val:= 27
      endif
   endif
   return ret_val

********************************
procedure TEL_F4F5

   set color to (cor[9])
   @ 22,  2 say " F4 Contatos "
   @ 22, 62 say " F5 Observao "
   set color to 
   set color to (cor[10])
   @ 22,  3 say "F4"
   @ 22, 63 say "F5"
   set color to 
   return

********************************
procedure FUNC0037


********************************
procedure NUC21

   local Local1
   Local1:= {}
   AAdd(Local1, {7, 31, " Codigo Cliente       ", ;
      padc("Consulta pelo Codigo do Cliente", 80)})
   AAdd(Local1, {8, 31, " Nome Cliente         ", ;
      padc("Consulta pelo Nome do Cliente", 80)})
   AAdd(Local1, {9, 31, " Numero CGC           ", ;
      padc("Consulta pelo Numero do CGC do Cliente", 80)})
   AAdd(Local1, {10, 31, " Numero Insc.Estadual ", ;
      padc("Consulta pelo Numero da Insc. Estadual do Cliente", ;
      80)})
   AAdd(Local1, {11, 31, " Todos Clientes       ", ;
      padc("Consulta Todos os Clientes do arquivo", 80)})
   AAdd(Local1, {12, 31, " CPF Clientes         ", ;
      padc("Consulta pelo CPF do Cliente", 80)})
   AAdd(Local1, {13, 31, " Historico Clientes   ", ;
      padc("Cadastra o Historico do Cliente", 80)})
   AAdd(Local1, {14, 31, " Nome Parcial         ", ;
      padc("Consulta por Parte do Nome do Cliente", 80)})
   AAdd(Local1, {15, 31, " Cidade               ", ;
      padc("Consulta pelo Nome da Cidade", 80)})
   AAdd(Local1, {16, 31, " Fantasia             ", ;
      padc("Consulta pelo Nome Fantasia", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "CLIENTES")
   m_clientes:= 1
   do while (.T.)
      set color to (cor[14])
      window(6, 30, 17, 53, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         nuc211("211")
      case m_clientes = 2
         nuc211("212")
      case m_clientes = 3
         nuc211("213")
      case m_clientes = 4
         nuc211("214")
      case m_clientes = 5
         nuc211("215")
      case m_clientes = 6
         nuc211("216")
      case m_clientes = 7
         @ 23,  0 clear to 24, 79
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         set color to (cor[1])
         window(4, 1, 6, 70, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         set color to 
         do while (.T.)
            xcod_cl:= Space(5)
            set color to (cor[3])
            @  5, 19 get XCod_CL picture "@k 99999" valid ;
               !Empty(xcod_cl) .AND. localiza(stz(@xcod_cl), ;
               "CLIENTES", 1, "M", "NOME_CL", 5, 25) when ;
               mens_when("Digite o Codigo do Cliente ou tecle <ESC> p/ sair")
            read
            if (LastKey() == K_ESC)
               exit
            endif
            select clientes
            if (reclock(5))
               replace historico with hist_cl(historico, 9, 1, 20, ;
                  77, .T.)
               unlock
            endif
            @  5, 25 say Space(40) color cor[1]
            set color to (cor[12])
            @  9,  1 clear to 21, 78
            set color to 
         enddo
         restore screen from xtela1
      case m_clientes = 8
         nuc218()
      case m_clientes = 9
         nuc211("210")
      case m_clientes = 10
         nuc211("210A")
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure EDITA_OBS

   local Local1
   Local1:= savescr(7, 0, 21, 79)
   select clientes
   if (reclock(5))
      replace historico with hist_cl(historico, 7, 2, 19, 76, .T.)
      unlock
   endif
   restscr(Local1)

********************************
procedure NUC2671

   local Local1, Local2, Local3
   Local3:= savescr(3, 0, 22, 79)
   parameters xynr_carga
   private pg:= 0, vet_est:= {}, vet_ped:= {}, new_vet, vet_item:= {}
   private vet_edita:= {}, vet_lin:= {}, xtotal_cai:= 0, xtravou:= .F.
   private xtotal_pes:= xtotal_val:= 0, yxest_cl:= "", xnr_carga
   sinal("RELATORIO", "PROG.PROD.")
   setcursor(1)
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 6, 29, "ͻȺ ", .T.)
   @  5,  3 say "Numero da Carga : "
   set color to 
   Local1:= savescr(3, 0, 22, 79)
   do while (.T.)
      new_vet:= {}
      vet_est:= {}
      vet_ped:= {}
      vet_item:= {}
      vet_edita:= {}
      vet_lin:= {}
      xtotal_cai:= 0
      xtotal_pes:= 0
      xtotal_val:= 0
      yxest_cl:= ""
      if (xynr_carga = Nil)
         xnr_carga:= Space(6)
      else
         xnr_carga:= xynr_carga
         keyboard Chr(13)
      endif
      set color to (cor[3])
      @  5, 21 get XNR_CARGA picture "@K 999999" valid ;
         !Empty(xnr_carga) .AND. localiza(stz(@xnr_carga), ;
         "VENDAS_R", 3, "M") when ;
         mens_when("Digite o Numero da Carga ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restscr(Local3)
         return
      endif
      nuc26711()
      restscr(Local1)
      if (xynr_carga != Nil)
         restscr(Local3)
         return
      endif
   enddo

********************************
procedure NUC211

   parameters opcao_cons
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite Nome do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Endereco do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Bairro do Cliente ou tecle <ESC> p/ sair", ;
      "Digite a Cidade do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Estado do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o CEP do cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CPF do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CGC do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero da Insc. Estadual do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFAX do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEX do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFONE do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Codigo da Condicao do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do telefone ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do fax ou tecle <ESC> p/ sair", ;
      "Digite a Data de Aprovacao do Cadastro ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Credito Aprovado ou tecle <ESC> p/ sair", ;
      "Digite o Nome Fantasia ou tecle <ESC> p/ sair", ;
      "Digite a Sigla do pais ou tecle <ESC> para sair"}
   private xcod_cl, xnome_cl, xend_cl, xbairro_cl, xcid_cl, xest_cl, ;
      xcep_cl, xcpf_cl, xcgc_cl, xinsc_estc, xfax, xtelex, xfone, ;
      xtipo_cl, xhistorico, xcod_vend, xcod_cond, xramal_fon, ;
      xramal_fax, xdt_cad, xval_cred, m_clientes, xfantasia, xpais_cl
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "CODIGO")
   select CLIENTES
   set order to 1
   do while (.T.)
      do case
      case opcao_cons = "210A"
         xfantasia:= Space(25)
         set color to (cor[1])
         window(4, 1, 6, 45, "ͻȺ ", .T.)
         @  5,  3 say "Nome Fantasia.:"
         set color to (cor[3])
         @  5, 19 get XFANTASIA picture "@!" valid !Empty(xfantasia) ;
            when mens_when(mens1[20])
         read
      case opcao_cons = "210"
         xcod_cid:= Space(25)
         set color to (cor[1])
         window(4, 1, 6, 45, "ͻȺ ", .T.)
         @  5,  3 say "Nome da Cidade:"
         set color to (cor[3])
         @  5, 19 get XCOD_CID picture "@!" valid !Empty(xcod_cid) ;
            when mens_when(mens1[5])
         read
      case opcao_cons = "211"
         xcod_cl:= Space(5)
         set color to (cor[1])
         window(4, 1, 6, 24, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         set color to (cor[3])
         @  5, 19 get XCod_CL picture "99999" valid !Empty(xcod_cl) ;
            when mens_when(mens1[1])
         read
         xcod_cl:= strzero(Val(xcod_cl), 5)
      case opcao_cons = "212"
         xnome_cl:= Space(40)
         set color to (cor[1])
         window(4, 1, 6, 59, "ͻȺ ", .T.)
         @  5,  3 say "Nome Cliente : "
         set color to (cor[3])
         @  5, 18 get XNOME_CL valid !Empty(xnome_cl) when ;
            mens_when(mens1[2])
         read
      case opcao_cons = "213"
         xcgc_cl:= Space(14)
         set color to (cor[1])
         window(4, 1, 6, 38, "ͻȺ ", .T.)
         @  5,  3 say "Numero do CGC : "
         set color to (cor[3])
         @  5, 19 get XCGC_CL picture "@R 99.999.999/9999-99" valid ;
            !Empty(xcgc_cl) .AND. checa_cgc(xcgc_cl) when ;
            mens_when(mens1[9])
         read
      case opcao_cons = "214"
         xinsc_estc:= Space(18)
         set color to (cor[1])
         window(4, 1, 6, 48, "ͻȺ ", .T.)
         @  5,  3 say "Numero da Insc.Estadual :"
         set color to (cor[3])
         @  5, 29 get XINSC_ESTC picture "@!" valid ;
            !Empty(xinsc_estc) when mens_when(mens1[10])
         read
      case opcao_cons = "215"
         goto bottom
      case opcao_cons = "216"
         xcpf_cl:= Space(11)
         set color to (cor[1])
         window(4, 1, 6, 33, "ͻȺ ", .T.)
         @  5,  3 say "Numero do CPF:"
         set color to (cor[3])
         @  5, 18 get XCPF_CL picture "@R 999.999.999-99" valid ;
            !Empty(xcpf_cl) .AND. cpf(xcpf_cl) when ;
            mens_when(mens1[8])
         read
      endcase
      set color to 
      if (LastKey() == K_ESC)
         SetKey(K_F5, Nil)
         restore screen from xtela1
         return
      endif
      do case
      case opcao_cons = "210A"
         set order to 11
         seek Trim(xfantasia)
      case opcao_cons = "210"
         set order to 10
         seek Trim(xcod_cid)
      case opcao_cons = "211"
         set order to 1
         seek xcod_cl
      case opcao_cons = "212"
         set order to 2
         seek Trim(Upper(xnome_cl))
      case opcao_cons = "213"
         set order to 5
         seek xcgc_cl
      case opcao_cons = "214"
         set order to 6
         seek xinsc_estc
      case opcao_cons = "215"
         set order to 1
         goto top
      case opcao_cons = "216"
         set order to 4
         seek xcpf_cl
      endcase
      if (EOF())
         mensagem("Registro nao localizado. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      m_clientes:= iif(clientes->jur_fis = "J", 1, 2)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      set color to (cor[1])
      window(4, 1, 20, 77, "ͻȺ ", .T.)
      t_clientes()
      do while (.T.)
         tel_f4f5()
         tk:= nav(5, 20, "Cod_CL", "trans_cl", "get_cl", Nil, Nil, ;
            .T., "NUC211")
         if (tk = -1)
            set key K_CTRL_F2 to permuta_fj
            if (!reclock(5))
               loop
            endif
            trans_cl()
            set color to (cor[12])
            @ 22,  1 say Replicate("", 78)
            set color to 
            do while (acesso("NUC211ALT"))
               @ 24,  0
               get_cl("MANUTENCAO")
               read
               set color to 
               if (LastKey() != K_ESC .AND. updated())
                  @ 23,  0
                  gra()
                  if (gra = "A")
                     loop
                  elseif (gra = "G")
                     grava_cl()
                  endif
               endif
               unlock
               exit
            enddo
            SetKey(K_CTRL_F2, Nil)
         elseif (tk = -2 .AND. acesso("NUC211EXC"))
            if (contr_excl("CLIENTES"))
               if (!reclock(5))
                  loop
               endif
               trans_cl()
               get_cl()
               readkill(.T.)
               getlist:= {}
               set color to (cor[12])
               @ 22,  1 say Replicate("", 35)
               set color to 
               if (excluir())
                  delete
                  unlock
                  skip 
                  skip -1
               endif
               unlock
            endif
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      @ 22,  1 say Replicate("", 78)
      set color to 
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
procedure VER_CONTAT

   local Local1:= {}, Local2:= SetColor(), Local3:= alias(), ;
      Local4:= indexord(), Local5:= 0, Local6
   select CONTATOS
   set order to 1
   seek xcod_cl
   if (Found())
      do while (cod_cl = xcod_cl .AND. !EOF())
         AAdd(Local1, " " + contato + "  " + SubStr(setor, 1, 17) + ;
            "  " + tel_com)
         skip 
      enddo
      Local5:= iif(Len(Local1) + 11 > 21, 21, Len(Local1) + 11)
      set color to (cor[5])
      Local6:= window(10, 2, Local5, 77, "ͻȺ ", .T.)
      @ 10,  4 say "Relacao de Contatos"
      set color to (cor[4])
      achoice(11, 3, Local5 - 1, 76, Local1)
   else
      @ 23,  0 clear
      mensagem("Nenhum contato encontrado para este Cliente. Tecle <ESC>.", ;
         27)
   endif
   select (Local3)
   set order to Local4
   set color to (Local2)
   iif(Local6 != Nil, restscr(Local6), "")
   return

********************************
procedure NUC218

   private xfile_d, stru, xnome, xtela, xtitulo, xordem, xarea:= ;
      alias(), xtela2:= savescr(4, 0, 24, 79)
   private xcod_cl, xnome_cl, xend_cl, xbairro_cl, xcid_cl, xest_cl, ;
      xcep_cl, xcpf_cl, xcgc_cl, xinsc_estc, xfax, xtelex, xfone, ;
      xcod_vend, xhistorico, xramal_fon, xramal_fax, xcod_cond, ;
      xdt_cad, xval_cred, m_clientes, xfantasia, xpais_cl
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   xfile_d:= newfile()
   select CLIENTES
   xordem:= indexord()
   stru:= asize(dbstruct(), 2)
   dbcreate(xfile_d, {{"Cod_CL    ", "C", 5, 0}, {"NOME_CL   ", "C", ;
      40, 0}, {"CID_CL    ", "C", 25, 0}, {"EST_CL    ", "C", 2, 0}})
   use (xfile_d) alias TEMP new
   select CLIENTES
   do while (.T.)
      set color to (cor[3])
      window(4, 1, 6, 51, "Ŀ ", .T.)
      xnome:= Space(40)
      @  5,  3 say "Nome :" get xnome picture "@!"
      read
      if (LastKey() == K_ESC)
         temp->(dbCloseArea())
         erase (xfile_d)
         if ("" != xarea)
            select (xarea)
         endif
         clientes->(dbSetOrder(xordem))
         restscr(xtela2)
         return
      endif
      xnome:= alltrim(xnome)
      select CLIENTES
      set order to 
      goto top
      do while (!EOF())
         if (xnome $ clientes->nome_cl)
            temp->(dbAppend())
            replace temp->cod_cl with clientes->cod_cl
            replace temp->nome_cl with clientes->nome_cl
            replace temp->cid_cl with clientes->cid_cl
            replace temp->est_cl with clientes->est_cl
         endif
         dbSkip()
      enddo
      if (temp->(LastRec()) == 0)
         tone(800, 5)
         tone(1200, 3)
         ms250("Nao foi encontrado nenhum cliente com " + xnome + ;
            "no nome. tecle [ESC] para cont.", 24, 0, cor[6], ;
            cor[7], {27}, Nil, 80, "c")
         loop
      endif
      set color to (cor[8])
      xtela:= savescr(3, 0, 24, 0)
      xtitulo:= {[Clientes que possuem "] + xnome + [" no nome]}
      xcoluna:= {"nuc218a()"}
      select TEMP
      goto top
      window(8, 1, 19, 77, "Ŀ ", .T.)
      dbedit(9, 2, 18, 76, xcoluna, "edit_218a", .T., xtitulo)
      restscr(xtela)
   enddo

********************************
function EDIT_218A(Arg1)

   local Local1:= strzero(LastKey(), 2), Local2:= savescr(4, 1, 24, ;
      78)
   if (!(Local1 $ "13/27") .OR. Arg1 = 0)
      return 1
   endif
   set color to (cor[1])
   setcursor(1)
   if (Local1 = "27")
      return 0
   elseif (Local1 = "13" .AND. niv_oper >= "2")
      select CLIENTES
      clientes->(dbSetOrder(1))
      clientes->(dbSeek(temp->cod_cl))
      m_clientes:= iif(clientes->jur_fis = "J", 1, 2)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      set color to (cor[1])
      window(4, 1, 20, 77, "ͻȺ ", .T.)
      t_clientes()
      trans_cl()
      get_cl()
      readkill(.T.)
      getlist:= {}
      ms250("Pressione qualquer tecla para continuar.", 24, 0, ;
         cor[4], cor[5], {60}, "T", 80, "C")
      select TEMP
   endif
   select TEMP
   restscr(Local2)
   setcursor(0)
   set color to (cor[8])
   return 1

********************************
function NUC218A

   return " " + temp->cod_cl + "  " + SubStr(temp->nome_cl, 1, 38) ;
      + "  " + SubStr(temp->cid_cl, 1, 15) + "  " + temp->est_cl + ;
      " "

********************************
function ALT_NIVEL

   local Local1, Local2
   Local2:= LastKey()
   if (Local2 == 27)
      return 0
   elseif (Local2 == 13)
      Local1:= RecNo()
      DBEval({|| field->nivel:= "S"}, Nil, Nil, Nil, Nil, .F.)
      goto Local1
      replace nivel with "P"
      keyboard Chr(5)
      return 2
   endif
   return 1

********************************
procedure TRANS_TB22

   xnome_prod:= valor_ta->nome_prod
   xdata_prod:= valor_ta->data_prod
   xvalor_pro:= valor_ta->valor_prod
   return

********************************
procedure FUNC0004


********************************
procedure NUC22

   local Local1
   Local1:= {}
   AAdd(Local1, {8, 31, " Codigo Fornecedor    ", ;
      padc("Consulta pelo Codigo do Fornecedor", 80)})
   AAdd(Local1, {9, 31, " Nome Fornecedor      ", ;
      padc("Consulta pelo Nome do Fornecedor", 80)})
   AAdd(Local1, {10, 31, " Numero CGC           ", ;
      padc("Consulta pelo Numero do CGC do Fornecedor", 80)})
   AAdd(Local1, {11, 31, " Numero Insc.Estadual ", ;
      padc("Consulta pelo Numero da Insc. Estadual do Fornecedor", ;
      80)})
   AAdd(Local1, {12, 31, " Prd. Comercializado  ", ;
      padc("Consulta pelo Produto Comercializado do fornecedor", ;
      80)})
   AAdd(Local1, {13, 31, " Todos Fornecedores   ", ;
      padc("Consulta Todos os Fornecedores do arquivo", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "FORNECEDOR")
   m_fornec:= 1
   do while (.T.)
      set color to (cor[14])
      window(7, 30, 14, 53, "Ŀ ", .T.)
      m_fornec:= menu_prt(Local1, m_fornec, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_fornec = 1
         nuc221("221")
      case m_fornec = 2
         nuc221("222")
      case m_fornec = 3
         nuc221("223")
      case m_fornec = 4
         nuc221("224")
      case m_fornec = 5
         nuc221("225")
      case m_fornec = 6
         nuc221("226")
      case m_fornec = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure LISTA_IT2

   local Local1, Local2
   Local1:= alias()
   private xtela_ven:= savescr(5, 1, 21, 78)
   select (iif(xcx2, "ITEM_VER", "ITEM_VEF"))
   set order to 1
   seek xnr_ped
   prod_aca->(dbSetOrder(1))
   v_itens:= {}
   do while (nr_ped = xnr_ped .AND. !EOF())
      xco_prod:= co_prod
      xqt_pe_pro:= qt_pe_prod
      xval_prod:= val_prod
      prod_aca->(dbSeek(xco_prod))
      xdesc_mp:= SubStr(prod_aca->de_prod, 1, 30)
      AAdd(v_itens, " " + nr_item_pd + "  " + xdesc_mp + "  " + ;
         Transform(xqt_pe_pro, "@E 999,999.99") + "  " + ;
         Transform(xval_prod, "@E 999,999,999.99") + " ")
      skip 
   enddo
   @ 23,  0 say Space(80)
   if (xprog_pai != "NUC365")
      ms250(" [ENTER] Alterar Item    [DEL] Excluir Item   [F6] Incluir Item    [ESC] Sair  ", ;
         24, 0, cor[1], cor[2], Nil, Nil, 80, "C")
   else
      ms250("Use as setas de movimentacao do cursor ou [ESC] para sair", ;
         24, 0, cor[1], cor[2], Nil, Nil, 80, "C")
   endif
   set color to (cor[19])
   xtela_item:= savescr(13, 1, 21, 71)
   window(13, 1, 20, 70, "ͻȺ ", .T.)
   @ 14,  2 say ;
      "Item  Descricao da Mercadoria          Quantidade   Preco Unitario"
   @ 15,  2 to 15, 69
   xop_itens:= achoice(16, 2, 19, 69, v_itens, Nil, "REC_IT2")
   set color to 
   restscr(xtela_item)
   select (Local1)
   return

********************************
procedure GRA_RES

   replace temp_res->nome_cl with clientes->nome_cl
   replace temp_res->nr_ped with vendas_r->nr_ped
   replace temp_res->dt_ped with vendas_r->dt_ped
   replace temp_res->val_ped with xval_ped
   return

********************************
init procedure RDDINIT

   rddsetdefa("DBFNTX")
   return

********************************
procedure NUC221

   parameters opcao_cons
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Nome do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Endereco do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Bairro do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite a Cidade do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Estado do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o CEP da Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite a Praca de Pagamento ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CGC do Fornecedor ou tecle <ESC> p/sair", ;
      "Digite o Numero da Insc. Estadual do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFAX do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Nome do contato do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFONE do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Produto Comercializado ou tecle <ESC> p/ sair"}
   private xcod_fo, xnome_fo, xend_fo, xbairro_fo, xcid_fo, xest_fo, ;
      xcep_fo, xpr_pagto, xcgc_fo, xinsc_estf, xfax, xtelex, xfone, ;
      xtipo_fo, xhistorico
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "CODIGO")
   select FORNECED
   set order to 1
   do while (.T.)
      do case
      case opcao_cons = "221"
         xcod_fo:= Space(4)
         set color to (cor[1])
         window(4, 1, 6, 27, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Fornecedor: "
         set color to (cor[3])
         @  5, 22 get XCOD_FO picture "9999" when mens_when(mens1[1])
         read
         xcod_fo:= strzero(Val(xcod_fo), 4)
      case opcao_cons = "222"
         xnome_fo:= Space(40)
         set color to (cor[1])
         window(4, 1, 6, 62, "ͻȺ ", .T.)
         @  5,  3 say "Nome Fornecedor :"
         set color to (cor[3])
         @  5, 21 get XNOME_FO when mens_when(mens1[2])
         read
      case opcao_cons = "223"
         xcgc_fo:= Space(14)
         set color to (cor[1])
         window(4, 1, 6, 38, "ͻȺ ", .T.)
         @  5,  3 say "Numero do CGC : "
         set color to (cor[3])
         @  5, 19 get XCGC_FO picture "@R 99.999.999/9999-99" valid ;
            checa_cgc(xcgc_fo) when mens_when(mens1[9])
         read
      case opcao_cons = "224"
         xinsc_estf:= Space(18)
         set color to (cor[1])
         window(4, 1, 6, 48, "ͻȺ ", .T.)
         @  5,  3 say "Numero da Insc.Estadual :"
         set color to (cor[3])
         @  5, 29 get XINSC_ESTF when mens_when(mens1[10])
         read
      case opcao_cons = "225"
         xpr_fo:= Space(50)
         set color to (cor[1])
         window(4, 1, 6, 78, "ͻȺ ", .T.)
         @  5,  3 say "Produto Comercializado:"
         set color to (cor[3])
         @  5, 27 get XPR_FO when mens_when(mens1[14])
         read
         xpr_fo:= Upper(xpr_fo)
      case opcao_cons = "226"
         goto bottom
      endcase
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      do case
      case opcao_cons = "221"
         set order to 1
         seek xcod_fo
      case opcao_cons = "222"
         set order to 2
         seek Trim(Upper(xnome_fo))
      case opcao_cons = "223"
         set order to 5
         seek xcgc_fo
      case opcao_cons = "224"
         set order to 6
         seek xinsc_estf
      case opcao_cons = "225"
         set order to 7
         seek Trim(xpr_fo)
      case opcao_cons = "226"
         set order to 1
         goto top
      endcase
      if (EOF())
         mensagem("Registro nao localizado, Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      t_forneced()
      do while (.T.)
         tk:= navega(5, 20, "COD_FO", "trans_fo", "get_fo")
         if (tk = -1)
            if (!reclock(5))
               loop
            endif
            trans_fo()
            do while (acesso("NUC221ALT"))
               @ 24,  0
               get_fo()
               read
               set color to 
               if (LastKey() != K_ESC .AND. updated())
                  @ 23,  0
                  gra()
                  if (gra = "A")
                     loop
                  elseif (gra = "G")
                     grava_fo()
                  endif
               endif
               unlock
               exit
            enddo
         elseif (tk = -2 .AND. acesso("NUC221EXC"))
            if (contr_excl("FORNECED"))
               if (!reclock(5))
                  loop
               endif
               trans_fo()
               get_fo()
               readkill(.T.)
               getlist:= {}
               if (excluir())
                  delete
                  unlock
                  skip 
                  skip -1
               endif
            endif
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
procedure P259_3

   set color to (cor[3])
   @ 10, 26 get XDAT_LANCA picture "@D" valid !Empty(xdat_lanca) ;
      when mens_when(mens1[2])
   @ 12, 26 get XHISTORICO picture "@S35" valid LastKey() = K_UP ;
      .OR. !Empty(xhistorico) when mens_when(mens1[3])
   @ 14, 26 get XVAL_LANCA picture "@E 999,999,999,999.99" valid ;
      LastKey() = K_UP .OR. !Empty(xval_lanca) when ;
      mens_when(mens1[5])
   @ 16, 26 get XNR_DOC picture "9999999999" valid LastKey() = K_UP ;
      .OR. !Empty(xnr_doc) when mens_when(mens1[6])
   @ 18, 26 get XD_C_LANCA picture "@!" valid LastKey() = K_UP .OR. ;
      xd_c_lanca $ "DC" .AND. tel_ext3() when mens_when(mens1[4])
   readkill(.T.)
   getlist:= {}
   @  7, 13 get XNR_DOC
   readkill(.T.)
   getlist:= {}
   @ 18, 46 get XBLOQUEADO picture "@!" valid LastKey() = K_UP .OR. ;
      xbloqueado $ "SN" when ;
      mens_when(mens1[iif(xd_c_lanca = "C", 7, 8)]) .AND. tel_ext3()
   return

********************************
function NUC27221

   return " " + temp->nr_ped + "  " + DToC(temp->dt_ped) + "  " + ;
      temp->nome_cl + "  " + Transform(temp->valor_ped, ;
      "@E 99,999,999.99") + "  "

********************************
procedure NUC23

   local Local1
   Local1:= {}
   AAdd(Local1, {9, 31, " Moedas               ", ;
      padc("Consulta Moedas", 80)})
   AAdd(Local1, {10, 31, " Indices de Correcao  ", ;
      padc("Consulta Indices de Correcao", 80)})
   AAdd(Local1, {11, 31, " Custo Geral de Fab.  ", ;
      padc("Consulta Custo Geral de Fabricacao", 80)})
   AAdd(Local1, {12, 31, " Cond. do Cliente     ", ;
      padc("Consulta Condicoes do Cliente", 80)})
   AAdd(Local1, {13, 31, " Unidade de Medida    ", ;
      padc("Consulta Unidades de Medidas", 80)})
   AAdd(Local1, {14, 31, " Cond. de Pagamento   ", ;
      padc("Consulta Condicoes de Pagamento", 80)})
   AAdd(Local1, {15, 31, " Transportadores      ", ;
      padc("Consulta Transportadores", 80)})
   AAdd(Local1, {16, 31, " Vendedores           ", ;
      padc("Consulta Vendedores", 80)})
   AAdd(Local1, {17, 31, " Impostos             ", ;
      padc("Consulta Impostos", 80)})
   AAdd(Local1, {18, 31, " Veiculos             ", ;
      padc("Consulta Veiculos", 80)})
   AAdd(Local1, {19, 31, " Setores              ", ;
      padc("Consulta Setores", 80)})
   private xtela1
   save screen to xtela1
   private xcod_ven, xnome_ven, xend_ven, xbairro_ve, xcid_ven, ;
      xest_ven, xcep_ven, xcpf_ven, xfax, xfone, xramal_fon, ;
      xramal_fax
   private mens1:= ;
      {"Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite Nome do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Endereco do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Bairro do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite a Cidade do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Estado do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o CEP do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do CPF do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFONE do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do TELEFAX do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do telefone do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Numero do RAMAL do Fax do Vendedor ou tecle <ESC> p/ sair"}
   private vet_alias:= {}, vet_cod:= {}, vet_des:= {}, vet_msg:= {}, ;
      vet_acess:= {}
   AAdd(vet_alias, "TAB_MOE")
   AAdd(vet_alias, "TAB_IND")
   AAdd(vet_alias, "TAB_CGF")
   AAdd(vet_alias, "TAB_CCL")
   AAdd(vet_alias, "TAB_UNI")
   AAdd(vet_alias, "TAB_CPA")
   AAdd(vet_alias, "TAB_TRA")
   AAdd(vet_alias, "TAB_SET")
   AAdd(vet_acess, "NUC231MOE")
   AAdd(vet_acess, "NUC231IND")
   AAdd(vet_acess, "NUC231CGF")
   AAdd(vet_acess, "NUC231CCL")
   AAdd(vet_acess, "NUC231UNI")
   AAdd(vet_acess, "NUC231CPA")
   AAdd(vet_acess, "NUC231TRA")
   AAdd(vet_acess, "NUC231SET")
   AAdd(vet_cod, "Codigo do Moeda.:")
   AAdd(vet_des, "Nome do Moeda...:")
   AAdd(vet_cod, "Codigo do Indice.:")
   AAdd(vet_des, "Nome do Indice...:")
   AAdd(vet_cod, "Codigo do C.G.F....:")
   AAdd(vet_des, "Descricao do C.G.F.:")
   AAdd(vet_cod, "Codigo do Cond. Cliente....:")
   AAdd(vet_des, "Descricao da Cond. Cliente.:")
   AAdd(vet_cod, "Codigo do Unidade....:")
   AAdd(vet_des, "Descricao da Unidade.:")
   AAdd(vet_cod, "Codigo da cond. Pagamento....:")
   AAdd(vet_des, "Descricao da Cond. Pagamento.:")
   AAdd(vet_cod, "Codigo do Transportador..:")
   AAdd(vet_des, "Nome do Transportador....:")
   AAdd(vet_cod, "Codigo do Setor.:")
   AAdd(vet_des, "Nome do Setor...:")
   AAdd(vet_msg, ;
      {"Codigo da Moeda Indexadora ou tecle <ESC> p/ sair", ;
      "Nome da Moeda Indexadora", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo do Indice de Correcao Financeira ou tecle <ESC> p/ sair", ;
      "Nome do Indice de Correcao Financeira", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo do Custo Geral de Fabricacao ou tecle <ESC> p/ sair", ;
      "Descricao do Custo Geral de Fabricacao", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo da Condicao do Cliente (Quanto a Pagamento) ou tecle <ESC> p/ sair", ;
      "Descricao da Condicao do Cliente (Quanto a Pagamento)", ;
      "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo da Unidade de Medida ou tecle <ESC> p/ sair", ;
      "Descricao da Unidade de Medida", "Complemento"})
   AAdd(vet_msg, ;
      {"Codigo da Condicao do Prazo de Pagamento ou tecle <ESC> p/ sair", ;
      "Descricao da Condicao do Prazo de Pagamento", ;
      "Numero de Dias de Prazo de Pagamento separado por barras (/)"})
   AAdd(vet_msg, ;
      {"Codigo do Transportador ou tecle <ESC> p/ sair", ;
      "Nome do Transportador", "Placa do Veiculo"})
   AAdd(vet_msg, {"Codigo do Setor ou tecle <ESC> p/ sair", ;
      "Nome do Setor", "Complemento"})
   sinal("SUB-MENU", "TABELAS")
   m_tabelas:= 1
   do while (.T.)
      set color to (cor[14])
      window(8, 30, 20, 53, "Ŀ ", .T.)
      m_tabelas:= menu_prt(Local1, m_tabelas, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_tabelas = 0
         commit
         restore screen from xtela1
         return
      case m_tabelas = 8
         if (acesso("NUC232VEN"))
            nuc232()
         endif
      case m_tabelas = 9
         if (acesso("NUC239IMP"))
            nuc239()
         endif
      case m_tabelas = 10
         if (acesso("NUC233VEI"))
            nuc233()
         endif
      otherwise
         _tabelas:= vet_alias[iif(m_tabelas = 11, 8, m_tabelas)]
         nuc231(iif(m_tabelas = 11, 8, m_tabelas))
         _tabelas:= Nil
      endcase
   enddo
   return

********************************
procedure NUC27224

   local Local1:= RecNo(), Local2:= {}, Local3, Local4, Local5
   Local5:= SetColor(cor[12])
   prod_aca->(dbSetOrder(1))
   item_ver->(dbSetOrder(1))
   select TEMP
   goto top
   do while (!EOF())
      item_ver->(dbSeek(temp->nr_ped))
      do while (item_ver->nr_ped = temp->nr_ped)
         pos_vet:= ascan(Local2, {|_1| _1[1] = item_ver->co_prod})
         if (pos_vet == 0)
            AAdd(Local2, {item_ver->co_prod, item_ver->qt_pe_prod + ;
               item_ver->al_icms, (item_ver->qt_pe_prod + ;
               item_ver->al_icms) * item_ver->val_prod})
         else
            Local2[pos_vet][2]:= Local2[pos_vet][2] + ;
               (item_ver->qt_pe_prod + item_ver->al_icms)
            Local2[pos_vet][3]:= Local2[pos_vet][3] + ;
               (item_ver->qt_pe_prod + item_ver->al_icms) * ;
               item_ver->val_prod
         endif
         item_ver->(dbSkip(1))
      enddo
      temp->(dbSkip(1))
   enddo
   if ((xlen_vet:= Len(Local2)) > 0)
      Local3:= asort(Local2, Nil, Nil, {|_1, _2| _1[1] < _2[1]})
      Local2:= {}
      for ind:= 1 to xlen_vet
         prod_aca->(dbSeek(Local3[ind][1]))
         AAdd(Local2, " " + Local3[ind][1] + " " + prod_aca->de_prod ;
            + " " + Transform(Local3[ind][2], "@E 999,999.99") + ;
            "  " + Transform(Local3[ind][3], "@E 99,999,999.99") + ;
            " ")
      next
   endif
   Local4:= savescr(5, 1, 24, 75)
   window(5, 2, iif(xlen_vet > 10, 19, xlen_vet + 8), 66, ;
      "ͻȺ ", .T.)
   @  6,  3 say ;
      " Produto                                   Qtde          Valor "
   @  7,  3 to  7, 65
   ms250("Tecle [ESC] para sair do resumo", 24, 0, cor[4], cor[5], ;
      Nil, Nil, 80, "C")
   achoice(8, 3, iif(xlen_vet > 10, 18, xlen_vet + 7), 65, Local2, ;
      Nil, "NUC27225")
   restscr(Local4)
   goto Local1
   return

********************************
procedure NUC231

   parameters xxxnome
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", vet_alias[xxxnome])
   private xcodigo, xdescricao, xcomplemen
   private len_vet:= Len(vet_cod[xxxnome])
   select (vet_alias[xxxnome])
   set order to 1
   goto bottom
   tel_tab()
   xdescricao:= Space(30)
   xcomplemen:= Space(20)
   do while (.T.)
      set color to (cor[3])
      if (xxxnome == 5)
         xcodigo:= "  "
         @  5, len_vet + 4 get XCODIGO picture "@!A" valid ;
            localiza(xcodigo, vet_alias[xxxnome], 1, "M") .AND. ;
            !Empty(xcodigo) when ;
            mens_when(vet_msg[iif(m_tabelas = 11, 8, m_tabelas)][1])
      else
         xcodigo:= "   "
         @  5, len_vet + 4 get XCODIGO picture "@k 999" valid ;
            localiza(xcodigo:= strzero(Val(xcodigo), 3), ;
            vet_alias[xxxnome], 1, "M") .AND. !Empty(xcodigo) when ;
            mens_when(vet_msg[iif(m_tabelas = 11, 8, m_tabelas)][1])
      endif
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      trans_tab()
      do while (.T.)
         set color to 
         tk:= navega(5, len_vet + 4, "CODIGO", "TRANS_TAB", "GET_TAB")
         if (tk = -1)
            if (reclock(5))
               trans_tab()
            else
               loop
            endif
            setcursor(1)
            do while ;
                  (acesso(vet_acess[iif(m_tabelas = 11, 8, m_tabelas)] ;
                  + "ALT"))
               set color to (cor[3])
               get_tab()
               read
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  limpa_tab()
                  exit
               endif
               @ 23,  0
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_tab(xxxnome)
                  unlock
               endif
               xdescricao:= Space(30)
               xcomplemen:= Space(20)
               limpa_tab()
               unlock
               exit
            enddo
            setcursor(1)
         elseif (tk = -2 .AND. ;
               acesso(vet_acess[iif(m_tabelas = 11, 8, m_tabelas)] + ;
               "EXC"))
            if (contr_excl(vet_alias[xxxnome]))
               if (reclock(5))
                  trans_tab()
               else
                  loop
               endif
               @ 24,  0
               if (excluir())
                  delete
                  unlock
                  skip 
                  skip -1
               else
                  unlock
               endif
            endif
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      limpa_tab()
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
procedure ALTERA_NIV

   local Local1:= 9, Local2:= 1, Local3:= 19, Local4:= 41, Local5:= ;
      {"NIVEL + [  ] + CONTATO"}, Local6:= {"CONTATOS"}, Local7, ;
      Local8
   private contato_pr:= RecNo()
   Local7:= SaveScreen(Local1, Local2, Local3, Local4)
   select CONTATOS
   if (!fillock(5))
   else
      set order to 4
      seek xcod_cl
      Local8:= copy_temp({|| contatos->cod_cl = xcod_cl})
      use (Local8) new exclusive
      @ 23,  0
      ms250("Posicione o cursor sobre o Contato principal e tecle <ENTER> para alterar", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      set color to (cor[1])
      Local7:= window(Local1, Local2, Local3, Local4, "Ŀ ", ;
         .T.)
      dbedit(Local1 + 1, Local2 + 1, Local3 - 1, Local4 - 1, Local5, ;
         "alt_nivel", .T., Local6, .T., .T., .T., .T.)
      set color to 
      restscr(Local7)
      select (Local8)
      goto top
      do while (!EOF())
         select CONTATOS
         goto &Local8->RECNO
         replace contatos->nivel with &Local8->NIVEL
         select (Local8)
         skip 
      enddo
      contatos->(dbUnlock())
      @ 24,  0
      select (Local8)
      close
      Local8:= Local8 + ".DBF"
      erase (Local8)
      select CONTATOS
      return
   endif

********************************
procedure GRAVA_TB21

   replace valor_prod with xvalor_pro
   return

********************************
procedure NUC232

   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "VENDEDORES")
   select TAB_VEN
   set order to 1
   goto bottom
   t_ven()
   ini_ven()
   do while (.T.)
      set color to (cor[3])
      xcod_ven:= Space(3)
      @  5, 20 get XCOD_VEN picture "@K 999" valid ;
         localiza(xcod_ven:= strzero(Val(xcod_ven), 3), "TAB_VEN", ;
         1, "M") .AND. !Empty(xcod_ven) when ;
         mens_when("Digite o Codigo do Vendedor ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      trans_ven()
      do while (.T.)
         set color to (cor[3])
         tk:= navega(5, 20, "COD_VEN", "TRANS_VEN", "GET_VEN")
         if (tk = -1)
            if (reclock(5))
               trans_ven()
            else
               loop
            endif
            setcursor(1)
            do while (acesso("NUC232VENALT"))
               get_ven()
               read
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  limpa_ven()
                  exit
               endif
               @ 23,  0
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_ven()
                  unlock
               endif
               ini_ven()
               limpa_ven()
               unlock
               exit
            enddo
            setcursor(1)
         elseif (tk = -2 .AND. acesso("NUC232VENEXC"))
            if (contr_excl("TAB_VEN"))
               if (reclock(5))
                  trans_ven()
               else
                  loop
               endif
               @ 24,  0
               if (excluir())
                  delete
                  unlock
                  skip 
                  skip -1
               else
                  unlock
               endif
            endif
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      limpa_ven()
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
procedure NUC258

   local Local1
   save screen to Local1
   private pg:= 0, virou_sald:= .F., xcod_nosso, xdata_f, xdata_i, ;
      xtela_ext, xsaldo_b:= xsaldo_c:= xtot_c:= xtot_d:= 0
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 9, 31, "ͻȺ ", .T.)
   @  5,  3 say "Codigo do Banco:"
   @  6,  2 to  6, 30
   @  7,  3 say "Inicio periodo :"
   @  8,  3 say "Final  periodo :"
   set color to 
   sinal("RELATORIO", "EXTRATO")
   do while (.T.)
      xcod_nosso:= Space(3)
      xdata_i:= xdata_f:= CToD(Space(8))
      set color to (cor[3])
      @  5, 20 get XCOD_NOSSO picture "@k 999" valid ;
         localiza(stz(@xcod_nosso), "BANCOS", 4, "M") when ;
         mens_when("Digite o Codigo interno do Banco ou tecle <ESC> p/ sair")
      @  7, 20 get XDATA_I picture "@D" valid xdata_i <= Date() when ;
         mens_when("Digite a data inicio do periodo ou tecle <ESC> p/ sair")
      @  8, 20 get XDATA_F picture "@D" valid xdata_f >= xdata_i ;
         when ;
         mens_when("Digite a data final do periodo ou tecle <ESC> p/ sair") ;
         .AND. (xdata_f:= xdata_i) = xdata_f
      read
      set color to 
      if (LastKey() != K_ESC)
         extrato_ba()
      endif
      restore screen from Local1
      exit
   enddo
   return

********************************
procedure NUC233

   private mens1:= ;
      {"Digite o Codigo do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite a Placa do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite o Marca do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite o Modelo do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite a Ano de Fabricacao do Veiculo ou tecle <ESC> p/ sair", ;
      "Digite o Capacidade do Veiculo em Caixas Padrao ou tecle <ESC> p/ sair", ;
      "Digite o Capacidade do Veiculo em Peso ou tecle <ESC> p/ sair", ;
      Nil}
   private xcod_vei, xplaca_vei, xmarca_vei, xmodelo_ve, xanof_vei, ;
      xcapc_vei, xcapp_vei
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "VEICULOS")
   select TAB_VEI
   set order to 1
   goto bottom
   t_vei()
   ini_vei()
   do while (.T.)
      set color to (cor[3])
      xcod_vei:= Space(3)
      @  5, 20 get XCOD_VEI picture "@k 999" valid ;
         localiza(xcod_vei:= strzero(Val(xcod_vei), 3), "TAB_VEI", ;
         1, "M") .AND. !Empty(xcod_vei) when mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      trans_vei()
      do while (.T.)
         set color to (cor[3])
         tk:= navega(5, 20, "COD_VEI", "TRANS_VEI", "GET_VEI")
         if (tk = -1)
            if (reclock(5))
               trans_vei()
            else
               loop
            endif
            setcursor(1)
            do while (acesso("NUC233VEIALT"))
               get_vei()
               read
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  limpa_vei()
                  exit
               endif
               @ 23,  0
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_vei()
                  unlock
               endif
               ini_vei()
               limpa_vei()
               unlock
               exit
            enddo
            setcursor(1)
         elseif (tk = -2 .AND. acesso("NUC233VEIEXC"))
            if (contr_excl("TAB_VEI"))
               if (reclock(5))
                  trans_vei()
               else
                  loop
               endif
               @ 24,  0
               if (excluir())
                  delete
                  unlock
                  skip 
                  skip -1
               else
                  unlock
               endif
            endif
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      limpa_vei()
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
procedure EX_GET21

   set color to (cor[3])
   @ 12, 26 get XHISTORICO picture "@S35" when mens_when(mens1[3])
   @ 14, 26 get XVAL_LANCA picture "@E 9,999,999,999,999.99" when ;
      mens_when(mens1[5])
   @ 16, 26 get XNR_DOC picture "9999999999" when mens_when(mens1[6])
   @ 18, 26 get XD_C_LANCA picture "@!" valid LastKey() = K_UP .OR. ;
      xd_c_lanca $ "DC" .AND. tel_ext3() when mens_when(mens1[4])
   @ 18, 46 get XBLOQUEADO picture "@!" valid LastKey() = K_UP .OR. ;
      xbloqueado $ "SN" when ;
      mens_when(mens1[iif(xd_c_lanca = "C", 7, 8)]) .AND. ;
      iif(Empty(xbloqueado), xbloqueado:= iif(xd_c_lanca = "C", "N", ;
      "S"), xbloqueado) = xbloqueado
   return

********************************
procedure NUC239

   local Local1
   private mens:= {"Codigo do Imposto", "Descricao do Imposto", ;
      "Aliquota do Imposto"}
   private xco_impos, xde_impos, xali_impos
   private xl:= 3, xc:= 0, xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "IMPOSTOS")
   tel_impos()
   do while (.T.)
      ini_impos()
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 27 get XCO_IMPOS picture "@!" when ;
         mens_when(mens[1])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      select IMPOSTOS
      set order to 1
      goto top
      if (LastRec() == 0)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      if (Empty(xco_impos))
         xco_impos:= co_impos
      endif
      seek xco_impos
      if (!Found())
         mensagem("Imposto nao cadastrado. Para continuar tecle <ESC>.", ;
            27)
         loop
      endif
      do while (.T.)
         sinal("CONSULTA", "IMPOSTOS")
         set color to 
         lin_nave()
         tra_impos()
         setcursor(1)
         set color to (cor[3])
         @ xl + 2, xc + 27 get XCO_IMPOS picture "@!"
         @ xl + 4, xc + 27 get XDE_IMPOS
         @ xl + 6, xc + 27 get XALI_IMPOS picture "99.99"
         readkill(.T.)
         getlist:= {}
         setcursor(0)
         set color to 
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            lim_impos()
            @ 23,  0 clear
            exit
         case xtec == -1
            sinal("ALTERA", "IMPOSTOS")
            @ 23,  0 clear
            if (!reclock(5))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            do while (acesso("NUC239IMPALT"))
               setcursor(1)
               set color to (cor[3])
               @ xl + 4, xc + 27 get XDE_IMPOS valid ;
                  !Empty(xde_impos) when mens_when(mens[2])
               @ xl + 6, xc + 27 get XALI_IMPOS picture "99.99" ;
                  valid !Empty(xali_impos) when mens_when(mens[3])
               read
               setcursor(0)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  gra_impos()
                  unlock
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC239IMPEXC")
            sinal("EXCLUI", "IMPOSTOS")
            @ 23,  0 clear
            if (excluir())
               if (!reclock(5))
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  loop
               endif
               delete
               unlock
            endif
            skip 
            skip -1
         endcase
      enddo
      lim_impos()
      @ 23,  0 clear
   enddo
   return

********************************
procedure NUC25321(Arg1)

   do while (!Empty(dt_liq_doc))
      skip Arg1
      if (BOF())
         Arg1:= 1
      elseif (EOF())
         Arg1:= -1
      endif
   enddo
   return

********************************
function DEFPATH

   return __defpath()

********************************
procedure NUC24

   local Local1
   Local1:= {}
   AAdd(Local1, {10, 31, " Codigo Cliente     ", ;
      padc("Consulta pelo Codigo do Cliente", 80)})
   AAdd(Local1, {11, 31, " Nome do Contato    ", ;
      padc("Consulta pelo Nome do Contato", 80)})
   AAdd(Local1, {12, 31, " Data de Nascimento ", ;
      padc("Consulta pela Data de Nascimento do Contato", 80)})
   AAdd(Local1, {13, 31, " Todos Contatos     ", ;
      padc("Consulta Todos os Contatos do arquivo", 80)})
   AAdd(Local1, {14, 31, " Nivel do Contato   ", ;
      padc("Consulta Nivel do Contato", 80)})
   private xtela1
   save screen to xtela1
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Nome do Contato ou tecle <ESC> p/ sair", ;
      "Cargo do Contado na Empresa", ;
      "Setor de trabalho do Contato", ;
      "Telefone Comercial do Setor", ;
      "Telefone residencial do Contato", ;
      "Data de Nascimento do Contato"}
   private xcontato, xdata_nasc, ulttecla, nr, vet, varia, xnivel
   private xcargo, xsetor, xtel_com, xtel_res
   sinal("SUB-MENU", "CONTATOS")
   m_contatos:= 1
   do while (.T.)
      set color to (cor[14])
      window(9, 30, 15, 51, "Ŀ ", .T.)
      m_contatos:= menu_prt(Local1, m_contatos, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_contatos = 1
         nuc241("241")
      case m_contatos = 2
         nuc241("242")
      case m_contatos = 3
         nuc241("243")
      case m_contatos = 4
         nuc241("244")
      case m_contatos = 5
         nuc241("245")
      case m_contatos = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
function NUC25511(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4, Local5:= ;
      savescr(24, 0, 24, 79)
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      empresti->(dbGoto(vet_reg[Arg2]))
      Local4:= savescr(4, 1, 21, 78)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      tel_emp()
      set color to (cor[3])
      trans_emp()
      @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
         !Empty(xnome_emp) when mens_when(mens[1])
      get_emp(.T.)
      if (!Empty(empresti->dt_liqui))
         set color to (cor[12])
         tel_emp2()
         set color to (cor[3])
         get_emp2()
      endif
      disp155()
      readkill(.T.)
      getlist:= {}
      ms250("Pressione qualquer tecla para continuar", 24, 0, ;
         cor[4], cor[5], {0}, "t", 80, "c")
      restscr(Local4)
      Local2:= 2
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local5)
   return Local2

********************************
procedure TEL_EMP2

   set color to (cor[1])
   window(xl + 14, xc + 1, xl + 17, xc + 70, "Ŀ ", .T.)
   @ xl + 15, xc + 3 say "Valor da liquidacao.:"
   @ xl + 16, xc + 3 say "Data  da liquidacao.:"
   set color to 
   return

********************************
function AFILL(Arg1, Arg2, Arg3, Arg4)

   aeval(Arg1, {|_1, _2| Arg1[_2]:= Arg2}, Arg3, Arg4)
   return Arg1

********************************
procedure NUC241

   parameters opcao_cons
   private xcod_cl
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set century on
   sinal("CONSULTA", "CONTATOS")
   select CONTATOS
   do while (.T.)
      do case
      case opcao_cons = "241" .OR. opcao_cons = "245"
         xcod_cl:= Space(5)
         set color to (cor[1])
         window(4, 1, 6, 24, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         set color to 
         set color to (cor[3])
         @  5, 19 get XCod_CL picture "@k 99999" valid ;
            localiza(xcod_cl:= strzero(Val(xcod_cl), 5), "CLIENTES", ;
            1, "M") when ;
            mens_when("Digite o Codigo do Cliente ou tecle <ESC> p/ sair")
         read
      case opcao_cons = "242"
         xcontato:= Space(35)
         set color to (cor[1])
         window(4, 1, 6, 56, "ͻȺ ", .T.)
         @  5,  3 say "Nome do Contato:"
         set color to 
         set color to (cor[3])
         @  5, 20 get XCONTATO picture ;
            "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" valid ;
            !Empty(xcontato) when ;
            mens_when("Digite o Nome do Contato ou tecle <ESC> p/ sair")
         read
      case opcao_cons = "243"
         xdata_nasc:= CToD(Space(8))
         set color to (cor[1])
         window(4, 1, 6, 43, "ͻȺ ", .T.)
         @  5,  3 say "Data de Nascimento Contato:"
         set color to 
         set color to (cor[3])
         @  5, 31 get XDATA_NASC picture "@D" valid ;
            !Empty(xdata_nasc) when ;
            mens_when("Digite a data de nascimento do Contato ou tecle <ESC> p/ sair")
         read
      case opcao_cons = "244"
         goto top
      endcase
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      select CONTATOS
      do case
      case opcao_cons = "241"
         set order to 1
         seek xcod_cl
      case opcao_cons = "242"
         set order to 2
         seek Trim(Upper(xcontato))
      case opcao_cons = "243"
         set order to 3
         seek xdata_nasc
      case opcao_cons = "244"
         set order to 1
         goto top
      case opcao_cons = "245"
         set order to 4
         seek xcod_cl
         if (!Found())
            mensagem("Nenhum Contato localizado para este Cliente. Tecle <ESC> p/ continuar.", ;
               27)
            loop
         endif
         if (acesso("NUC241NIVEL"))
            altera_niv()
         endif
         loop
      endcase
      if (EOF())
         mensagem("Contato nao localizado, Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      t_contatos()
      do while (.T.)
         tk:= navega(5, 22, "Cod_CL", "TRANS_CO", "GET_CO")
         if (tk = -1)
            if (!reclock(5))
               loop
            endif
            trans_co()
            do while (acesso("NUC241ALT"))
               @ 24,  0
               get_co()
               read
               set color to 
               if (LastKey() != K_ESC .AND. updated())
                  @ 23,  0
                  gra()
                  if (gra = "A")
                     loop
                  elseif (gra = "G")
                     grava_co()
                  endif
               endif
               unlock
               exit
            enddo
         elseif (tk = -2 .AND. acesso("NUC241EXC"))
            @ 23,  0 clear to 24, 79
            if (!reclock(5))
               loop
            endif
            trans_co()
            get_co()
            readkill(.T.)
            getlist:= {}
            if (excluir())
               delete
               unlock
               skip 
               skip -1
            endif
            unlock
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
procedure NUC253

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {14, 45, " Altera/Consulta/Exclui   ", ;
      "Consulta, altera e exclui Duplicatas a receber"})
   AAdd(Local2, {15, 45, " Baixa Duplicatas receber ", ;
      "Baixa de Duplicatas a receber"})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "DUPLICATAS")
   Local1:= 1
   do while (.T.)
      set color to (cor[16])
      window(13, 44, 16, 71, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (Local1 = 1)
         if (acesso("NUC2531"))
            nuc2531()
         endif
      elseif (Local1 = 2)
         if (acesso("NUC2532"))
            nuc2532()
         endif
      elseif (Local1 = 0)
         commit
         restore screen from xtela1
         return
      endif
   enddo
   return

********************************
static procedure GET_TB21

   @  9, 22 get XVALOR_PROD picture "@E 999,999,999.999999" valid ;
      !Empty(xvalor_pro) when mens_when(mens1[3][i_n_d_i])
   return

********************************
procedure NUC25

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {10, 31, " Bancos               ", ;
      padc("Consulta pelo Codigo do Cliente", 80)})
   AAdd(Local1, {11, 31, " Movimento Bancario   ", ;
      padc("Consulta pelo Nome do Cliente", 80)})
   AAdd(Local1, {12, 31, " Contas a Receber     ", ;
      padc("Consulta pelo Numero do CGC do Cliente", 80)})
   AAdd(Local1, {13, 31, " Contas a Pagar       ", ;
      padc("Consulta pelo Numero da Insc. Estadual do Cliente", ;
      80)})
   AAdd(Local1, {14, 31, " Emprestimos          ", ;
      padc("Consulta Todos os Clientes do arquivo", 80)})
   AAdd(Local1, {15, 31, " Indices Financeiros  ", ;
      padc("Manutencao de Indices Financeiros", 80)})
   AAdd(Local1, {16, 31, " Moedas               ", ;
      padc("Manutencao de Moedas Indexadoras", 80)})
   AAdd(Local1, {17, 31, " Visualizar Extrato   ", ;
      padc("Visualiza Extrato Bancario por Periodo", 80)})
   AAdd(Local1, {18, 31, " Desbloq. / Compensar ", ;
      padc("Desbloqueia Depositos/Compensa Cheques Emitidos", 80)})
   private xtela1
   save screen to xtela1
   Local2:= Len(Local1)
   sinal("SUB-MENU", "CLIENTES")
   m_clientes:= 1
   do while (.T.)
      restore screen from xtela1
      set color to (cor[14])
      window(9, 30, 10 + Local2, 53, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("NUC251"))
            nuc251()
         endif
      case m_clientes = 2
         if (acesso("NUC252"))
            nuc252()
         endif
      case m_clientes = 3
         if (acesso("NUC253"))
            nuc253()
         endif
      case m_clientes = 4
         if (acesso("NUC254"))
            nuc254()
         endif
      case m_clientes = 5
         if (acesso("NUC255"))
            nuc255()
         endif
      case m_clientes = 6
         if (acesso("NUC256IN"))
            nuc256("IN")
         endif
      case m_clientes = 7
         if (acesso("NUC256MO"))
            nuc256("MO")
         endif
      case m_clientes = 8
         if (acesso("NUC258"))
            nuc258()
         endif
      case m_clientes = 9
         if (acesso("NUC259"))
            nuc259()
         endif
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure TE_EXT22

   set color to (cor[1])
   window(11, 1, 19, 62, "ͻȺ ", .T.)
   @ 12,  3 say "Historico............:"
   @ 14,  3 say "Valor lancamento.....:"
   @ 16,  3 say "Numero do Documento..:"
   if (xd_c_lanca = "D")
      @ 18,  3 say "<D>ebito ou <C>redito:        Compensado.:"
   else
      @ 18,  3 say "<D>ebito ou <C>redito:        Bloqueado..:"
   endif
   set color to 
   return

********************************
procedure DIS_BAIXA1

   localiza(xcod_fo, "FORNECED", 1, "M", "NOME_FO", 7, 25)
   return

********************************
procedure NUCTELAS


********************************
procedure NUC251

   local Local1
   Local1:= {}
   AAdd(Local1, {13, 41, " Codigo do Banco  ", ;
      padc("Consulta pelo Codigo do Banco", 80)})
   AAdd(Local1, {14, 41, " Nome Banco       ", ;
      padc("Consulta pelo Nome do Banco", 80)})
   AAdd(Local1, {15, 41, " Numero da Conta  ", ;
      padc("Consulta pelo Numero da Conta Corrente", 80)})
   AAdd(Local1, {16, 41, " Codigo Interno   ", ;
      padc("Consulta pelo Codigo Interno do Banco", 80)})
   AAdd(Local1, {17, 41, " Todos Bancos     ", ;
      padc("Consulta Todos os Bancos do arquivo", 80)})
   AAdd(Local1, {18, 41, " Atualiza saldos  ", ;
      padc("Atualiza os Saldos dos Bancos", 80)})
   private xtela5
   save screen to xtela5
   private mens1:= ;
      {"Digite o Codigo interno do banco ou tecle <ESC> p/ sair", ;
      "Digite o Numero do banco junto ao BANCO CENTRAL ou tecle <ESC> p/ sair", ;
      "Digite o Nome do banco ou tecle <ESC> p/ sair", ;
      "Digite o Numero da agencia ou tecle <ESC> p/ sair", ;
      "Digite o Nome da agencia ou tecle <ESC> p/ sair", ;
      "Digite o Endereco da agencia ou tecle <ESC> p/ sair", ;
      "Digite a Cidade da agencia ou tecle <ESC> p/ sair", ;
      "Digite o Estado da agencia ou tecle <ESC> p/ sair", ;
      "Digite o CEP da agencia ou tecle <ESC> p/ sair", ;
      "Digite o Numero da conta corrente ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Cheque Especial ou tecle ,<ESC> para sair"}
   private xnr_banco, xnome_bc, xnr_ag, xnome_ag, xend_ag, xcid_ag, ;
      xest_ag, xcep_ag, xnr_conta, xcod_cl, xcod_nosso, xche_esp
   sinal("SUB-MENU", "BANCOS")
   m_bancos:= 1
   do while (.T.)
      set color to (cor[16])
      window(12, 40, 19, 59, "Ŀ ", .T.)
      m_bancos:= menu_prt(Local1, m_bancos, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case m_bancos = 1
         nuc2511("241")
      case m_bancos = 2
         nuc2511("242")
      case m_bancos = 3
         nuc2511("243")
      case m_bancos = 4
         nuc2511("244")
      case m_bancos = 5
         nuc2511("245")
      case m_bancos = 6
         if (acesso("NUC2517"))
            nuc2517()
         endif
      case m_bancos = 0
         commit
         restore screen from xtela5
         return
      endcase
   enddo
   return

********************************
procedure P263_3

   local Local1:= 0, Local2:= temp->(RecNo())
   temp->(dbGoTop())
   DBEval({|| Local1:= Local1 + temp->qt_mp_u * mp_r->ult_p_mp})
   temp->(dbGoto(Local2))
   ms250("Valor total da Materia Prima : " + LTrim(Transform(Local1, ;
      "@E 999,999.999999")), 21, 1, cor[12], Nil, Nil, Nil, 78, "c")
   return

********************************
static function LOAD_PED

   return " " + nr_ped + "    " + DToC(dt_ped) + "   " + nr_nf + ;
      "  " + SubStr(tab_ven->nome_ven, 1, 12) + "  " + ;
      Transform(per_comis, "@E 99.99") + " "

********************************
procedure NUCPROC


********************************
procedure NUC2511

   parameters opcao_cons
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "BANCOS")
   select BANCOS
   do while (.T.)
      do case
      case opcao_cons = "241"
         xnr_banco:= Space(3)
         xnr_ag:= Space(5)
         set color to (cor[1])
         window(4, 1, 6, 24, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Banco...: "
         set color to 
         set color to (cor[3])
         @  5, 20 get XNR_BANCO picture "@K 999" valid ;
            !Empty(xnr_banco) when mens_when(mens1[2])
         read
      case opcao_cons = "242"
         xnome_bc:= Space(20)
         set color to (cor[1])
         window(4, 1, 6, 40, "ͻȺ ", .T.)
         @  5,  3 say "Nome do Banco :"
         set color to 
         set color to (cor[3])
         @  5, 19 get XNOME_BC picture "xxxxxxxxxxxxxxxxxxxx" valid ;
            !Empty(xnome_bc) when mens_when(mens1[3])
         read
      case opcao_cons = "243"
         xnr_conta:= Space(12)
         set color to (cor[1])
         window(4, 1, 6, 33, "ͻȺ ", .T.)
         @  5,  3 say "Numero da Conta:"
         set color to 
         set color to (cor[3])
         @  5, 20 get XNR_CONTA picture "@!" valid !Empty(xnr_conta) ;
            when mens_when(mens1[10])
         read
      case opcao_cons = "244"
         xcod_nosso:= Space(3)
         set color to (cor[1])
         window(4, 1, 6, 23, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Interno: "
         set color to 
         set color to (cor[3])
         @  5, 19 get XCOD_NOSSO picture "@k 999" when ;
            mens_when(mens1[1])
         read
         xcod_nosso:= strzero(Val(xcod_nosso), 3)
      case opcao_cons = "245"
         goto top
      endcase
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela5
         return
      endif
      do case
      case opcao_cons = "241"
         set order to 1
         seek xnr_banco
      case opcao_cons = "242"
         set order to 2
         seek Upper(Trim(xnome_bc))
      case opcao_cons = "243"
         set order to 3
         seek xnr_conta
      case opcao_cons = "244"
         set order to 4
         seek xcod_nosso
      case opcao_cons = "245"
         set order to 1
         goto top
      endcase
      if (EOF())
         mensagem("Registro nao localizado, Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      t_bancos()
      set color to 
      do while (.T.)
         tk:= navega(5, 22, "COD_NOSSO", "trans_bc", "get_bc")
         if (tk = -1)
            if (!reclock(5))
               loop
            endif
            trans_bc()
            do while (acesso("NUC251ALT"))
               @ 24,  0
               get_bc()
               read
               set color to 
               if (LastKey() != K_ESC .AND. updated())
                  @ 23,  0
                  gra()
                  if (gra = "A")
                     loop
                  elseif (gra = "G")
                     grava_bc()
                  endif
               endif
               unlock
               exit
            enddo
         elseif (tk = -2 .AND. acesso("NUC251EXC"))
            @ 23,  0 clear to 24, 79
            if (!reclock(5))
               loop
            endif
            trans_bc()
            get_bc()
            readkill(.T.)
            getlist:= {}
            if (excluir())
               delete
               unlock
               skip 
               skip -1
            endif
            unlock
         elseif (tk = 27)
            exit
         endif
      enddo
      setcursor(1)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
   enddo
   return

********************************
function NUC25541(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4, Local5:= ;
      savescr(24, 0, 24, 79)
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      empresti->(dbGoto(vet_reg[Arg2]))
      if (reclock(5))
         Local4:= savescr(4, 1, 21, 78)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         tel_emp()
         set color to (cor[3])
         trans_emp()
         do while (.T.)
            @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
               !Empty(xnome_emp) when mens_when(mens[1])
            get_emp(.T.)
            readkill(.T.)
            getlist:= {}
            set color to (cor[12])
            tel_emp2()
            if (Empty(xdt_liqui))
               setcursor(1)
               set color to (cor[3])
               get_emp2()
               read
               setcursor(0)
               setcursor(1)
            else
               set color to (cor[3])
               get_emp2()
               readkill(.T.)
               getlist:= {}
               set color to 
               @ 23,  0
               mensagem("Emprestimo ja liquidado, <ESC> p/ continuar", ;
                  27)
            endif
            if (LastKey() != K_ESC)
               @ 23,  0
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_emp2()
                  adel(vet_emp, Arg2)
                  asize(vet_emp, Len(vet_emp) - 1)
                  adel(vet_reg, Arg2)
                  asize(vet_reg, Len(vet_reg) - 1)
               endif
            endif
            exit
         enddo
         restscr(Local4)
      else
         mensagem("Registro nao pode ser alterado. Tecle <ESC> p/ continuar.", ;
            27)
      endif
      Local2:= 2
      unlock
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local5)
   return Local2

********************************
procedure NUC2517

   local Local1, Local2
   Local2:= 0
   select SALDO
   closedata("SALDO")
   if (!netuse("SALDO", Nil, "E", "NEW", 5))
      if (!netuse("SALDO", Nil, "S", "NEW", 5))
         return
      endif
      set index to SALDO01, SALDO02, SALDO03
      return
   else
      zap
      set index to 
      index on COD_NOSSO+dtos(DAT_SALDO) to SALDO01
      index on DAT_SALDO to SALDO02
      index on COD_NOSSO + descend(dtos(DAT_SALDO)) to SALDO03
      closedata("SALDO")
   endif
   if (!netuse("SALDO", Nil, "S", "NEW", 5))
   else
      set index to SALDO01, SALDO02, SALDO03
      set order to 1
      select EXTRATO
      set order to 1
      Local1:= LastRec()
      goto top
      RestScreen(21, 0, 21, 79, SaveScreen(22, 0, 22, 79))
      set color to (cor[1])
      @ 22,  0 clear
      @ 22,  0 to 24, 79 double
      @ 22,  1 say padc(" Atualizando Arquivo de Saldos ", 78, "")
      set color to 
      do while (!EOF())
         saldo_tota:= 0
         xcod_nosso:= extrato->cod_nosso
         atualizou:= .F.
         do while (xcod_nosso = extrato->cod_nosso)
            xdat_lanca:= extrato->dat_lanca
            do while (xdat_lanca = extrato->dat_lanca .AND. ;
                  xcod_nosso = extrato->cod_nosso)
               termometro(23, 2, 76, ++Local2, Local1)
               if (extrato->dat_lanca > CToD("31/07/93") .AND. ;
                     !atualizou)
                  saldo_tota:= Val(SubStr(Str(saldo_tota, 18, 2), 1, ;
                     14)) / 100
                  atualizou:= .T.
               endif
               saldo_tota:= saldo_tota + iif(extrato->d_c_lanca = ;
                  "D", -1, 1) * extrato->val_lanca
               skip 
            enddo
            select SALDO
            if (addrec(10))
               replace saldo->cod_nosso with xcod_nosso
               replace saldo->dat_saldo with xdat_lanca
               replace saldo->val_saldo with saldo_tota
               unlock
            else
               restore screen from xtela5
               return
            endif
            select EXTRATO
         enddo
      enddo
      restore screen from xtela5
      return
   endif

********************************
procedure NUC255

   local Local1
   Local1:= {}
   AAdd(Local1, {14, 46, " Geral    ", ;
      padc("Consulta/Altera/Exclui Emprestimos em Geral", 80)})
   AAdd(Local1, {15, 46, " Abertos  ", ;
      padc("Consulta/Altera/Exclui Emprestimos Abertos", 80)})
   AAdd(Local1, {16, 46, " Fechados ", ;
      padc("Consulta/Altera/Exclui Emprestimos Fechados", 80)})
   AAdd(Local1, {17, 46, " Baixa    ", ;
      padc("Baixa Emprestimos em Aberto", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "CLIENTES")
   m_clientes:= 1
   do while (.T.)
      restore screen from xtela1
      set color to (cor[16])
      window(13, 45, 18, 56, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         nuc2551()
      case m_clientes = 2
         nuc2552()
      case m_clientes = 3
         nuc2553()
      case m_clientes = 4
         if (acesso("NUC2554"))
            nuc2554()
         endif
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure P259_1

   xhistorico:= historico
   xdat_lanca:= dat_lanca
   xd_c_lanca:= d_c_lanca
   xnr_doc:= nr_doc
   xval_lanca:= val_lanca
   xbloqueado:= bloqueado
   return

********************************
procedure NUC252

   local Local1, Local2
   private mens1:= ;
      {"Digite o Codigo interno do Banco ou tecle <ESC> p/ sair", ;
      "Digite a data do lancamento ou tecle <ENTER> p/ acessar todos os registros", ;
      "Historico do lancamento", ;
      "Classificacao Contabil do lancamento (Debito ou Credito)", ;
      "Valor do lancamento", ;
      "Digite o Numero do Documento ou tecle <ESC> p/ sair", ;
      "O documento acima esta Bloqueado (Sim/Nao) ?             Tecle <ESC> para sair", ;
      "O documento acima ja foi compensado (Sim/Nao) ?          Tecle <ESC> para sair"}
   private xcod_nosso, xdat_lanca, xhistorico, xd_c_lanca, ;
      xval_lanca, xdat_saldo, xval_saldo, xnr_doc, xbloqueado
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("EXTRATO", "BANCARIO")
   do while (.T.)
      te_ext21()
      xcod_nosso:= Space(3)
      xdat_lanca:= CToD(Space(8))
      set color to (cor[3])
      @  5, 13 get XCOD_NOSSO picture "@K 999" valid ;
         localiza(stz(@xcod_nosso), "BANCOS", 4, "M", ;
         "NOME_BAN+[  ]+NR_AGENCIA+[  ]+NR_CONTA", 5, 17) when ;
         mens_when(mens1[1])
      @  7, 13 get XDAT_LANCA when mens_when(mens1[2])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      select EXTRATO
      set order to 1
      if (Empty(xdat_lanca))
         seek xcod_nosso
      else
         seek xcod_nosso + DToS(xdat_lanca)
      endif
      if (EOF())
         @ 23,  0 clear
         tone(800, 5)
         ms250("Atencao! Chave de pesquisa nao encontrada, verificar. Tecle <ESC> p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      if (Empty(xdat_lanca))
         arq_temp:= copy_temp({|| extrato->cod_nosso = xcod_nosso})
      else
         arq_temp:= copy_temp({|| extrato->cod_nosso + ;
            DToS(extrato->dat_lanca) = xcod_nosso + DToS(xdat_lanca)})
      endif
      use (arq_temp) alias EDITANDO new exclusive
      set color to (cor[1])
      window(11, 1, 18, 77, "ͻȺ ", .T.)
      Local1:= {"MONTA_DB()"}
      Local2:= ;
         {"HISTORICO                               DATA    CRED/DEB            VALOR"}
      setcursor(1)
      set color to 
      @ 23,  0
      ms250("[F2] Altera                     [F3] Exclui                          [ESC] Sai", ;
         24, 0, cor[1], cor[2], Nil, Nil, 80, "C")
      set color to (cor[1])
      dbedit(12, 3, 17, 75, Local1, "alt_ext", .T., Local2)
      set color to 
      @ 24,  0 clear
      select EDITANDO
      close
      arq_temp:= arq_temp + ".dbf"
      erase (arq_temp)
   enddo

********************************
function MONTA_DB

   return SubStr(historico, 1, 35) + "  " + DToC(dat_lanca) + "  " ;
      + iif(d_c_lanca = "D", "Debito ", "Credito") + "  " + ;
      Transform(val_lanca, "@E 999,999,999.99")

********************************
function LOAD_EMP

   return " " + SubStr(empresti->nome_emp, 1, 28) + "   " + ;
      empresti->tipo_oper + "    " + DToC(empresti->dt_oper) + ;
      "  " + DToC(empresti->dt_pr_liq) + "  " + ;
      Transform(val_oper, "@E 9,999,999.99") + " "

********************************
procedure JOGA_255

   keyboard Chr(255)
   return

********************************
function ALT_EXT

   local Local1, Local2
   Local1:= LastKey()
   if (Local1 == 27)
      return 0
   endif
   if (Local1 == -1)
      Local2:= SaveScreen(9, 0, 24, 79)
      do while (acesso("NUC252ALT"))
         xhistorico:= historico
         xdat_lanca:= dat_lanca
         xd_c_lanca:= d_c_lanca
         xnr_doc:= nr_doc
         xval_lanca:= val_lanca
         xbloqueado:= bloqueado
         xyval_lanc:= iif(xd_c_lanca = "D", 1, -1) * xval_lanca
         set color to (cor[12])
         @ 11,  1 clear to 21, 78
         set color to 
         te_ext22()
         setcursor(1)
         @ 24,  0
         ex_get21()
         read
         set color to 
         if (LastKey() == K_ESC)
            RestScreen(9, 0, 24, 79, Local2)
            exit
         endif
         @ 23,  0 clear
         gra()
         do while (gra = "A")
            ex_get21()
            read
            set color to 
            @ 23,  0 clear
            gra()
         enddo
         setcursor(0)
         if (gra = "G")
            select SALDO
            if (!fillock(5))
               RestScreen(9, 0, 24, 79, Local2)
               exit
            else
               select EXTRATO
               goto editando->recno
               if (!reclock(5))
                  saldo->(dbUnlock())
                  RestScreen(9, 0, 24, 79, Local2)
                  exit
               endif
            endif
            select SALDO
            set order to 1
            seek xcod_nosso + DToS(xdat_lanca)
            xxval_lanc:= iif(xd_c_lanca = "D", -1, 1) * xval_lanca
            if (xdat_lanca > data_virad - 1)
               DBEval({|| field->val_saldo:= val_saldo + xxval_lanc ;
                  + xyval_lanc}, Nil, {|| xcod_nosso = cod_nosso}, ;
                  Nil, Nil, .T.)
            else
               DBEval({|| field->val_saldo:= val_saldo + xxval_lanc ;
                  + xyval_lanc}, Nil, {|| xcod_nosso = cod_nosso ;
                  .AND. saldo->dat_saldo < data_virad}, Nil, Nil, .T.)
               xval_real:= conv_moeda(xxval_lanc, valor_vira)
               yval_real:= conv_moeda(xyval_lanc, valor_vira)
               DBEval({|| field->val_saldo:= val_saldo + xval_real + ;
                  yval_real}, Nil, {|| xcod_nosso = cod_nosso}, Nil, ;
                  Nil, .T.)
            endif
            select EXTRATO
            goto editando->recno
            replace extrato->cod_nosso with xcod_nosso
            replace extrato->dat_lanca with xdat_lanca
            replace extrato->historico with xhistorico
            replace extrato->d_c_lanca with xd_c_lanca
            replace extrato->bloqueado with xbloqueado
            replace extrato->val_lanca with xval_lanca
            replace extrato->nr_doc with xnr_doc
            extrato->(dbUnlock())
            saldo->(dbUnlock())
            select EDITANDO
            replace editando->historico with xhistorico
            replace editando->d_c_lanca with xd_c_lanca
            replace editando->val_lanca with xval_lanca
         endif
         RestScreen(9, 0, 24, 79, Local2)
         exit
      enddo
   endif
   if (Local1 = -2 .AND. acesso("NUC252EXC"))
      Local2:= SaveScreen(9, 0, 24, 79)
      select SALDO
      if (!fillock(5))
         RestScreen(9, 0, 24, 79, Local2)
         return 1
      else
         select EXTRATO
         goto editando->recno
         if (!reclock(5))
            saldo->(dbUnlock())
            RestScreen(9, 0, 24, 79, Local2)
            return 1
         endif
      endif
      xhistorico:= historico
      xdat_lanca:= dat_lanca
      xd_c_lanca:= d_c_lanca
      xnr_doc:= nr_doc
      xval_lanca:= val_lanca
      xbloqueado:= bloqueado
      xyval_lanc:= iif(xd_c_lanca = "D", 1, -1) * xval_lanca
      set color to (cor[12])
      @ 11,  1 clear to 21, 78
      set color to 
      te_ext22()
      setcursor(1)
      ex_get21()
      readkill(.T.)
      getlist:= {}
      set color to 
      @ 23,  0 clear
      if (excluir())
         select EXTRATO
         delete
         select SALDO
         set order to 1
         seek xcod_nosso + DToS(xdat_lanca)
         DBEval({|| field->val_saldo:= val_saldo + xyval_lanc}, Nil, ;
            {|| xcod_nosso = cod_nosso}, Nil, Nil, .T.)
         select EDITANDO
         delete
         skip 
         skip -1
      endif
      RestScreen(9, 0, 24, 79, Local2)
      extrato->(dbUnlock())
      saldo->(dbUnlock())
   endif
   return 1

********************************
procedure TE_EXT21

   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   set color to (cor[1])
   window(4, 1, 8, 60, "ͻȺ ", .T.)
   @  5,  3 say "Codigo..:"
   @  7,  3 say "Data....:"
   set color to 
   return

********************************
procedure DISP_ITEM

   localiza(xco_mp, "MP_R", 1, "M", "DE_MP", 14, 25)
   return

********************************
procedure FUNC0046


********************************
procedure FUNC0010


********************************
procedure NUC2531

   local Local1:= 1, Local2:= {}
   private xtela2, xtela_2
   save screen to xtela2
   AAdd(Local2, {15, 51, " Numero do Documento ", ;
      "Consulta pelo Numero do Documento"})
   AAdd(Local2, {16, 51, " Codigo do Cliente   ", ;
      "Consulta pelo Codigo do Cliente"})
   AAdd(Local2, {17, 51, " Data de Vencimento  ", ;
      "Consulta pela Data de Nascimento"})
   private xcod_cl, xnr_doc_re, xdt_emi_do, xdt_ven_do, xrefer_cr, ;
      xban_car, xdt_liq_do, xval_doc, xval_liq, xval_jur, xcod_moe
   private mens1:= ;
      {"Digite o Numero do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite a Data da Emissao do Documento ou tecle <ESC> p/ sair", ;
      "Digite a Data do Vencimento do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Documento ou tecle <ESC> p/ sair", ;
      "Digite a Data de Liquidacao do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Juros na data da liquidacao ou tecle <ESC> p/ sair", ;
      "Digite o Valor recebido na data da liquidacao ou tecle <ESC> p/ sair", ;
      "Digite a Moeda do documento ou tecle <ESC> p/ sair", ;
      "Digite a Referencia ou tecle <ESC> p/ sair", ;
      "Digite (B)anco ou (C)arteira ou tecle <ESC> p/ sair"}
   sinal("SUB-MENU", "CONSULTA")
   do while (.T.)
      set color to (cor[14])
      window(14, 50, 18, 72, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case Local1 = 1
         nuc25311()
      case Local1 = 2
         @ 23,  0 clear
         do while (.T.)
            xcod_cl:= Space(5)
            set color to (cor[12])
            @  4,  1 clear to 21, 78
            set color to (cor[1])
            window(4, 1, 6, 29, "ͻȺ ", .T.)
            @  5,  3 say "Codigo do Cliente..: "
            set color to 
            setcursor(1)
            set color to (cor[3])
            @  5, 24 get XCod_CL picture "99999" valid ;
               fcod_cl(stz(@xcod_cl), Nil, .F.) when ;
               mens_when("Digite o Codigo do Clinte ou <ESC> " + ;
               "p/ abortar.")
            read
            setcursor(0)
            if (LastKey() == K_ESC)
               exit
            endif
            if (xcx2)
               xalias:= "CONT_RER"
            else
               xalias:= "CONT_REF"
            endif
            select (xalias)
            set order to 1
            seek xcod_cl
            if (!Found())
               mensagem("Documento nao foi encontrado. Tecle <ESC> para sair.", ;
                  27)
               loop
            endif
            nuc25312(xcx2, xalias)
         enddo
      case Local1 = 3
         @ 23,  0 clear
         do while (.T.)
            xdt_ven_do:= CToD(Space(8))
            set color to (cor[12])
            @  4,  1 clear to 21, 78
            set color to (cor[1])
            window(4, 1, 6, 35, "ͻȺ ", .T.)
            @  5,  3 say "Data de Vencimento.:"
            set color to 
            setcursor(1)
            set color to (cor[3])
            @  5, 24 get XDT_VEN_DOC picture "@D" valid ;
               !Empty(xdt_ven_do) when ;
               mens_when("Digite a data de Vencimento ou <ESC> p/ " ;
               + "abortar.")
            read
            setcursor(0)
            if (LastKey() == K_ESC)
               exit
            endif
            if (xcx2)
               xalias:= "CONT_RER"
            else
               xalias:= "CONT_REF"
            endif
            select (xalias)
            set order to 3
            seek descend(DToS(xdt_ven_do))
            if (!Found())
               mensagem("Documento nao foi encontrado. Tecle <ESC> p/ sair.", ;
                  27)
               loop
            endif
            nuc25313(xcx2, xalias)
         enddo
      case Local1 = 0
         restore screen from xtela1
         return
      endcase
      restore screen from xtela2
   enddo
   return

********************************
static function CALC_05

   set color to 
   @ 23,  0 clear
   tone(1800, 3)
   ms250("Calculando o custo da Materia Prima no Produto Acabado", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
   formula->(dbSetOrder(1))
   mp_r->(dbSetOrder(1))
   select PROD_ACA
   prod_aca->(dbSetOrder(1))
   prod_aca->(dbGoTop())
   do while (!prod_aca->(EOF()))
      formula->(dbSeek(prod_aca->co_prod))
      xval_mp:= 0
      do while (formula->co_prod = prod_aca->co_prod)
         mp_r->(dbSeek(formula->co_mp))
         xval_mp:= xval_mp + formula->qt_mp_u * mp_r->ult_p_mp
         formula->(dbSkip())
      enddo
      replace prod_aca->val_mp with xval_mp
      prod_aca->(dbSkip())
   enddo
   return .T.

********************************
procedure DIS_VEND1

   localiza(xcod_cl, "CLIENTES", 1, "M", "NOME_CL", 7, 26)
   localiza(xco_cpag, "TAB_CPA", 1, "M", "DESCRICAO", 9, 25)
   localiza(xco_ven, "TAB_VEN", 1, "M", "NOME_VEN", 10, 25)
   return

********************************
function DBREINDEX

   return ordListRebuild()

********************************
procedure NUC25311

   local Local1
   Local1:= setcursor()
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 14, 74, "ͻȺ ", .T.)
   set color to 
   tel_cre()
   xsalva_cre:= savescr(14, 1, 15, 75)
   do while (.T.)
      sinal("CONSULTA", "DOCUMENTOS")
      tel_cre()
      ini_cre()
      set color to (cor[3])
      setcursor(1)
      @  5, 24 get XNR_DOC_RE picture iif(xcx2, "@K 9999999", ;
         "@K 9999999") valid !Empty(stz(@xnr_doc_re, "L")) when ;
         mens_when(mens1[2])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela2
         setcursor(Local1)
         return
      endif
      if (xcx2)
         xalias:= "CONT_RER"
         xnr_doc_re:= SubStr(xnr_doc_re, 1, 7)
      else
         xalias:= "CONT_REF"
      endif
      select (xalias)
      set order to 2
      if (Empty(xnr_doc_re))
         goto top
         xnr_doc_re:= nr_doc_re
      endif
      seek descend(xnr_doc_re)
      if (!Found())
         mensagem("Registro nao foi encontrado. Tecle <ESC> p/ continuar.", ;
            27)
         l_tela27()
         loop
      endif
      do while (.T.)
         sinal("CONSULTA", "DOCUMENTOS")
         set color to 
         lin_nave()
         select (xalias)
         tran_cre()
         select (xalias)
         l_tela27()
         tel_cre()
         restscr(xsalva_cre)
         fcod_cl(xcod_cl, 8)
         set color to (cor[3])
         @  5, 24 get XNR_DOC_RE when mens_when(mens1[2])
         get_cre()
         if (!Empty(xdt_liq_do))
            set color to (cor[1])
            xtela_2:= window(15, 1, 19, 74, "ͻȺ ", .T.)
            tel_cre2()
            set color to (cor[3])
            get_cre2()
         endif
         readkill(.T.)
         getlist:= {}
         set color to 
         xtec:= InKey(0)
         do case
         case xtec == 3
            skip -1
            if (BOF())
               mensagem("Fim do arquivo", 1)
               skip 
            endif
         case xtec == 18
            skip 
            if (EOF())
               mensagem("Inicio do Arquivo", 1)
               skip -1
            endif
         case xtec == 27
            l_tela27()
            iif(xtela_2 != Nil, restscr(xtela_2), "")
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC2531ALT")
            sinal("ALTERA", "DOCUMENTO")
            @ 23,  0 clear
            select CONT_RER
            set order to 2
            if (!reclock(5))
               loop
            endif
            tran_cre()
            select CONT_REF
            set order to 2
            seek descend(xnr_doc_re)
            if (Found())
               if (!reclock(5))
                  select CONT_RER
                  unlock
                  loop
               endif
            endif
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               get_cre()
               if (!Empty(xdt_liq_do))
                  tel_cre2()
                  set color to (cor[3])
                  get_cre2()
               endif
               read
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               set color to 
               setcursor(0)
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  select CONT_RER
                  grav_rer()
                  unlock
                  select CONT_REF
                  set order to 2
                  seek descend(xnr_doc_re)
                  if (Found())
                     grav_ref()
                     unlock
                  endif
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC2531EXC")
            sinal("EXCLUI", "DOCUMENTO")
            @ 23,  0 clear
            if (excluir())
               select CONT_RER
               set order to 2
               if (!reclock(5))
                  loop
               endif
               tran_cre()
               select CONT_REF
               set order to 2
               seek descend(xnr_doc_re)
               if (Found())
                  if (!reclock(5))
                     select CONT_RER
                     unlock
                     loop
                  endif
               endif
               select CONT_RER
               delete
               unlock
               select CONT_REF
               set order to 2
               seek descend(xnr_doc_re)
               if (Found())
                  delete
                  unlock
               endif
               select (xalias)
               skip 
               skip -1
            endif
         endcase
         iif(xtela_2 != Nil, restscr(xtela_2), "")
         @ 23,  0 clear
      enddo
   enddo
   return

********************************
procedure NUC254

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {14, 45, " Altera/Consulta/Exclui   ", ;
      padc("Consulta, altera e exclui Contas a pagar", 80)})
   AAdd(Local2, {15, 45, " Baixa Duplicatas a pagar ", ;
      padc("Liquidacao de Contas a pagar em aberto", 80)})
   private xtela4
   save screen to xtela4
   sinal("SUB-MENU", "DUPLICATAS")
   Local1:= 1
   do while (.T.)
      restore screen from xtela4
      set color to (cor[16])
      window(13, 44, 16, 71, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (Local1 = 1)
         nuc2541()
      elseif (Local1 = 2)
         if (acesso("NUC2542"))
            nuc2542()
         endif
      elseif (Local1 = 0)
         commit
         restore screen from xtela4
         return
      endif
   enddo
   return

********************************
function NUC27222

   return " " + temp->nr_ped + "  " + DToC(temp->dt_ped) + "  " + ;
      temp->nome_ven + "  " + Transform(temp->valor_ped, ;
      "@E 99,999,999.99") + "  "

********************************
procedure NUC25312(Arg1, Arg2)

   local Local1
   Local1:= setcursor()
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 14, 74, "ͻȺ ", .T.)
   set color to 
   tel_cre()
   xsalva_cre:= savescr(14, 1, 15, 75)
   do while (.T.)
      sinal("CONSULTA", "DOCUMENTOS")
      tel_cre()
      lin_nave()
      select (Arg2)
      tran_cre()
      tel_cre()
      select (Arg2)
      set order to 1
      fcod_cl(xcod_cl, 8)
      set color to (cor[3])
      @  5, 24 get XNR_DOC_RE when mens_when(mens1[2])
      get_cre()
      if (!Empty(xdt_liq_do))
         set color to (cor[1])
         xtela_2:= window(15, 1, 19, 74, "ͻȺ ", .T.)
         tel_cre2()
         set color to (cor[3])
         get_cre2()
      endif
      readkill(.T.)
      getlist:= {}
      set color to 
      xtec:= InKey(0)
      do case
      case xtec == 18
         skip -1
         if (BOF())
            mensagem("Inicio do Arquivo", 1)
         endif
      case xtec == 3
         skip 
         if (EOF())
            mensagem("Fim do arquivo", 1)
            skip -1
         endif
      case xtec == 27
         iif(xtela_2 != Nil, restscr(xtela_2), "")
         @ 23,  0 clear
         return
      case xtec = -1 .AND. acesso("NUC2531ALT")
         sinal("ALTERA", "DOCUMENTO")
         @ 23,  0 clear
         select CONT_RER
         set order to 2
         if (!reclock(5))
            loop
         endif
         tran_cre()
         select CONT_REF
         set order to 2
         seek descend(xnr_doc_re)
         if (Found())
            if (!reclock(5))
               select CONT_RER
               unlock
               loop
            endif
         endif
         do while (.T.)
            setcursor(1)
            set color to (cor[3])
            get_cre()
            if (!Empty(xdt_liq_do))
               tel_cre2()
               set color to (cor[3])
               get_cre2()
            endif
            read
            if (LastKey() = K_ESC .OR. !updated())
               exit
            endif
            set color to 
            setcursor(0)
            @ 23,  0 clear
            gra()
            if (gra = "A")
               loop
            elseif (gra = "G")
               select CONT_RER
               set order to 2
               grav_rer()
               unlock
               select CONT_REF
               set order to 2
               seek descend(xnr_doc_re)
               if (Found())
                  grav_ref()
                  unlock
               endif
            endif
            exit
         enddo
      case xtec = -2 .AND. acesso("NUC2531EXC")
         sinal("EXCLUI", "DOCUMENTO")
         @ 23,  0 clear
         if (excluir())
            select CONT_RER
            set order to 2
            if (!reclock(5))
               loop
            endif
            tran_cre()
            select CONT_REF
            set order to 2
            seek descend(xnr_doc_re)
            if (Found())
               if (!reclock(5))
                  select CONT_RER
                  unlock
                  loop
               endif
            endif
            select CONT_RER
            set order to 2
            delete
            unlock
            select CONT_REF
            set order to 2
            seek descend(xnr_doc_re)
            if (Found())
               delete
               unlock
            endif
            select (Arg2)
            skip 
            skip -1
         endif
      endcase
      iif(xtela_2 != Nil, restscr(xtela_2), "")
      @ 23,  0 clear
   enddo
   return

********************************
procedure GET_EMP2

   @ xl + 15, xc + 25 get XVAL_LIQUI picture "@E 999,999,999.99" ;
      valid !Empty(xval_liqui) when mens_when(mens[10])
   @ xl + 16, xc + 25 get XDT_LIQUI picture "@D" valid xdt_liqui >= ;
      xdt_oper .AND. xdt_liqui <= Date() when mens_when(mens[11])
   return

********************************
function READFORMAT(Arg1)

   local Local1
   Local1:= Static21
   if (PCount() > 0)
      Static21:= Arg1
   endif
   return Local1

********************************
procedure NUC25313(Arg1, Arg2)

   local Local1, Local2, Local3
   Local2:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 14, 74, "ͻȺ ", .T.)
   set color to 
   tel_cre()
   xsalva_cre:= savescr(14, 1, 15, 75)
   do while (.T.)
      sinal("CONSULTA", "DOCUMENTOS")
      tel_cre()
      lin_nave()
      select (Arg2)
      tran_cre()
      tel_cre()
      select (Arg2)
      fcod_cl(xcod_cl, 8)
      set color to (cor[3])
      @  5, 24 get XNR_DOC_RE when mens_when(mens1[2])
      get_cre()
      if (!Empty(xdt_liq_do))
         set color to (cor[1])
         xtela_2:= window(15, 1, 19, 74, "ͻȺ ", .T.)
         tel_cre2()
         set color to (cor[3])
         get_cre2()
      endif
      readkill(.T.)
      getlist:= {}
      set color to 
      xtec:= InKey(0)
      do case
      case xtec == 18
         skip -1
         if (BOF())
            mensagem("Inicio do Arquivo", 1)
         endif
      case xtec == 3
         skip 
         if (EOF())
            mensagem("Fim do arquivo", 1)
            skip -1
         endif
      case xtec == 27
         iif(xtela_2 != Nil, restscr(xtela_2), "")
         @ 23,  0 clear
         return
      case xtec = -1 .AND. acesso("NUC2531ALT")
         sinal("ALTERA", "DOCUMENTO")
         @ 23,  0 clear
         select CONT_RER
         set order to 2
         if (!reclock(5))
            loop
         endif
         tran_cre()
         select CONT_REF
         set order to 2
         seek descend(xnr_doc_re)
         if (Found())
            if (!reclock(5))
               select CONT_RER
               unlock
               loop
            endif
         endif
         do while (.T.)
            setcursor(1)
            set color to (cor[3])
            get_cre()
            if (!Empty(xdt_liq_do))
               tel_cre2()
               set color to (cor[3])
               get_cre2()
            endif
            read
            if (LastKey() = K_ESC .OR. !updated())
               exit
            endif
            set color to 
            setcursor(0)
            @ 23,  0 clear
            gra()
            if (gra = "A")
               loop
            elseif (gra = "G")
               select CONT_RER
               set order to 2
               grav_rer()
               unlock
               select CONT_REF
               set order to 2
               seek descend(xnr_doc_re)
               if (Found())
                  grav_ref()
                  unlock
               endif
            endif
            exit
         enddo
      case xtec = -2 .AND. acesso("NUC2531EXC")
         sinal("EXCLUI", "DOCUMENTO")
         @ 23,  0 clear
         if (excluir())
            select CONT_RER
            set order to 2
            if (!reclock(5))
               loop
            endif
            tran_cre()
            select CONT_REF
            set order to 2
            seek descend(xnr_doc_re)
            if (Found())
               if (!reclock(5))
                  select CONT_RER
                  unlock
                  loop
               endif
            endif
            select CONT_RER
            set order to 2
            delete
            unlock
            select CONT_REF
            set order to 2
            seek descend(xnr_doc_re)
            if (Found())
               delete
               unlock
            endif
            select (Arg2)
            skip 
            skip -1
         endif
      endcase
      iif(xtela_2 != Nil, restscr(xtela_2), "")
   enddo
   return

********************************
procedure T_TABELA22

   window(4, 1, 10, 58, "ͻȺ ", .T.)
   @  5,  3 say "Codigo ..........:"
   @  7,  3 say "Data ............: "
   @  9,  3 say "Valor............: "
   return

********************************
procedure LIM_BAIXA1

   set color to (cor[1])
   @  5, 20 clear to  8, 69
   set color to 
   return

********************************
function __GETSETSU(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[2]:= Arg1
   endif
   return qself()[2]

********************************
procedure NUC2532

   local Local1:= savescr(0, 0, 24, 79), Local2:= setcursor(), Local3
   private xcod_cl, xnr_doc_re, xdt_emi_do, xdt_ven_do, xrefer_cr, ;
      xban_car, xdt_liq_do, xval_doc, xval_liq, xval_jur, xcod_moe
   private mens1:= ;
      {"Digite o Numero do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite a Data da Emissao do Documento ou tecle <ESC> p/ sair", ;
      "Digite a Data do Vencimento do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Documento ou tecle <ESC> p/ sair", ;
      "Digite a Data de Liquidacao do Documento ou tecle <ESC> p/ sair", ;
      "Digite o Valor do Juros na data da liquidacao ou tecle <ESC> p/ sair", ;
      "Digite o Valor recebido na data da liquidacao ou tecle <ESC> p/ sair", ;
      "Digite a Moeda do documento ou tecle <ESC> p/ sair", ;
      "Digite a Referencia ou tecle <ESC> p/ sair", ;
      "Digite (B)anco ou (C)arteira ou tecle <ESC> p/ sair"}
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 14, 74, "ͻȺ ", .T.)
   set color to 
   tel_cre()
   xsalva_cre:= savescr(14, 1, 15, 75)
   do while (.T.)
      sinal("LIQUIDA", "DUPLICATA")
      tel_cre()
      ini_cre()
      set color to (cor[3])
      setcursor(1)
      @  5, 24 get XNR_DOC_RE picture iif(xcx2, "@K 9999999", ;
         "@K 9999999") valid !Empty(stz(@xnr_doc_re, "L")) when ;
         mens_when(mens1[2])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restscr(Local1)
         setcursor(Local2)
         return
      endif
      if (xcx2)
         xalias:= "CONT_RER"
         xnr_doc_re:= SubStr(xnr_doc_re, 1, 7)
      else
         xalias:= "CONT_REF"
      endif
      select (xalias)
      set order to 2
      seek descend(xnr_doc_re)
      if (!Found())
         mensagem("Registro nao foi encontrado. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      if (!Empty(dt_liq_doc))
         mensagem("Documento ja liquidado. Tecle [ESC] p/ continuar.", ;
            27)
         loop
      endif
      select (xalias)
      ms250("[ENTER] Baixa   [PgUp] Reg. Anterior   [PgDn] Reg. Posterior   [ESC] Cancela", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      xl24:= savescr(24, 0, 24, 79)
      do while (.T.)
         tran_cre()
         set color to (cor[3])
         set color to (cor[3])
         @  5, 24 get XNR_DOC_RE when mens_when(mens1[2])
         get_cre()
         readkill(.T.)
         getlist:= {}
         set color to 
         restscr(xl24)
         tk:= InKey(0)
         do case
         case tk == 18
            skip -1
            nuc25321(-1)
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case tk == 3
            skip 
            nuc25321(1)
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case tk == 27
            exit
         case tk = 13 .AND. Empty(xdt_liq_do)
            exit
         endcase
      enddo
      if (LastKey() == K_ESC)
         loop
      endif
      select CONT_RER
      set order to 2
      if (!reclock(5))
         loop
      endif
      tran_cre()
      select CONT_REF
      set order to 2
      seek descend(xnr_doc_re)
      if (Found())
         if (!reclock(5))
            select CONT_RER
            unlock
            loop
         endif
      endif
      select (xalias)
      tel_cre()
      fcod_cl(xcod_cl, 8)
      set color to (cor[3])
      @  5, 24 get XNR_DOC_RE when mens_when(mens1[2])
      get_cre()
      readkill(.T.)
      getlist:= {}
      set color to (cor[1])
      window(15, 1, 19, 74, "ͻȺ ", .T.)
      tel_cre2()
      do while (.T.)
         set color to (cor[3])
         setcursor(1)
         get_cre2()
         read
         setcursor(0)
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0 clear
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            select CONT_RER
            set order to 2
            grav_rer()
            unlock
            select CONT_REF
            set order to 2
            seek descend(xnr_doc_re)
            if (Found())
               grav_ref()
               unlock
            endif
         endif
         exit
      enddo
      l_tela27()
      restscr(xsalva_cre)
      set color to (cor[12])
      @ 16,  1 clear to 20, 75
      set color to 
   enddo
   return

********************************
static procedure CALC_02

   tone(1800, 3)
   ms250("Calculando o valor gasto com Materia Prima no mes anterior", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
   producao->(dbSetOrder(1))
   xmes_prod:= CToD("01/" + add_ma(xmes_ano, -1))
   xval_mp_me:= 0
   prod_aca->(dbGoTop())
   do while (!prod_aca->(EOF()))
      xval_mp_me:= xval_mp_me + prod_aca->pd_mensal * prod_aca->val_mp
      prod_aca->(dbSkip())
   enddo
   return

********************************
procedure LIM_BAIXA2

   set color to (cor[12])
   @ 12,  1 clear to 17, 71
   set color to 
   return

********************************
procedure NUC2541

   local Local1:= 1, Local2:= {}
   private xtela2
   save screen to xtela2
   AAdd(Local2, {15, 51, " Codigo e Nr.Duplicata ", ;
      "Consulta pelo Codigo e Numero da Duplicata"})
   AAdd(Local2, {16, 51, " Nr. da Duplicata      ", ;
      "Consulta pelo Numero da Duplicata"})
   AAdd(Local2, {17, 51, " Data de Vencimento    ", ;
      "Consulta pela Data de Vencimento"})
   private xcod_fo, xnr_doc_cp, xrefer_cp, xdt_ven_cp, xdt_rec_cp, ;
      xval_cp
   private xval_icm_c, xdt_liq_do, xval_acres, xval_liqui, xnr_cheq, ;
      xcod_moe
   private xtipo_doc, xnr_cc
   private linha22:= savescr(22, 0, 22, 79)
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou <ESC> p/ sair", ;
      "Digite o Numero do Documento ou <ESC> p/ sair", ;
      "Digite a Data de Recebimento do Documento. <ESC> p/ sair", ;
      "Digite a Data do Vencimento do Documento. <ESC> p/ sair", ;
      "Digite o Valor do Documento ou <ESC> p/ sair", ;
      "Digite o Valor do ICMS ou <ESC> p/ sair", ;
      "Digite a Referencia do Documento ou <ESC> p/ sair", ;
      "Digite o Numero do Cheque/Conta Corrente/Banco ou <ESC> p/ sair", ;
      "Digite a Data de Liquidacao do Documento. <ESC> p/ sair", ;
      "Digite o Valor do Acrescimo ou <ESC> p/ sair", ;
      "Digite o Valor do pago ou <ESC> p/ sair", ;
      "Digite a Moeda do documento ou tecle <ESC> p/ sair", ;
      "Digite o Tipo do documento ou tecle <ESC> p/ sair", ;
      "Digite o Nr. do Banco/Nr. da Agencia/Nr. da Conta C. ou tecle <ESC> p/ sair"}
   sinal("SUB-MENU", "CONSULTA")
   do while (.T.)
      set color to (cor[14])
      window(14, 50, 18, 74, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case Local1 = 1
         nuc25411()
      case Local1 = 2
         @ 23,  0 clear
         do while (.T.)
            xnr_doc_cp:= Space(7)
            set color to (cor[12])
            @  4,  1 clear to 21, 78
            set color to (cor[1])
            window(4, 1, 6, 32, "ͻȺ ", .T.)
            @  5,  3 say "Numero documento...:"
            set color to 
            setcursor(1)
            set color to (cor[3])
            @  5, 24 get XNR_DOC_CP picture "@K 9999999" valid ;
               !Empty(xnr_doc_cp) .AND. stz(@xnr_doc_cp, "L") when ;
               mens_when("Digite o Nr. do documento ou <.ESC> " + ;
               "p/ abortar.")
            read
            setcursor(0)
            if (LastKey() == K_ESC)
               exit
            endif
            if (xcx2)
               xalias:= "CONT_PGR"
            else
               xalias:= "CONT_PGF"
            endif
            select (xalias)
            set order to 2
            seek descend(xnr_doc_cp)
            if (!Found())
               mensagem("Documento nao foi encontrado. Tecle <ESC> para sair.", ;
                  27)
               loop
            endif
            nuc25412(xcx2, xalias)
         enddo
      case Local1 = 3
         @ 23,  0 clear
         do while (.T.)
            xdt_ven_cp:= CToD("")
            set color to (cor[12])
            @  4,  1 clear to 21, 78
            set color to (cor[1])
            window(4, 1, 6, 35, "ͻȺ ", .T.)
            @  5,  3 say "Data de Vencimento.:"
            set color to 
            setcursor(1)
            set color to (cor[3])
            @  5, 24 get XDT_VEN_CP picture "@D" valid ;
               !Empty(xdt_ven_cp) when ;
               mens_when("Digite a data de Vencimento ou <.ESC> p/ " ;
               + "abortar.")
            read
            setcursor(0)
            if (LastKey() == K_ESC)
               exit
            endif
            if (xcx2)
               xalias:= "CONT_PGR"
            else
               xalias:= "CONT_PGF"
            endif
            select (xalias)
            set order to 3
            seek descend(DToS(xdt_ven_cp))
            if (!Found())
               mensagem("Documento nao foi encontrado. Tecle <ESC> para sair.", ;
                  27)
               loop
            endif
            nuc25413(xcx2, xalias)
         enddo
      case Local1 = 0
         restore screen from xtela2
         return
      endcase
      restore screen from xtela2
   enddo
   return

********************************
procedure GET_TB22

   @  5, 22 get XNOME_PROD picture "999" valid localiza(xnome_prod, ;
      "TAB_" + iif(xcod_prod = "IN", "IND", "MOE"), 1, "M", ;
      "DESCRICAO", 5, 27) when mens_when(mens1[1][i_n_d_i])
   @  7, 22 get XDATA_PROD valid !Empty(xdata_prod) when ;
      mens_when(mens1[2][i_n_d_i])
   @  9, 22 get XVALOR_PROD picture "@E 999,999,999.999999" valid ;
      !Empty(xvalor_pro) when mens_when(mens1[3][i_n_d_i])
   return

********************************
procedure NUC25411

   local Local1
   Local1:= setcursor()
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 15, 74, "ͻȺ ", .T.)
   set color to 
   tel_cpg()
   xsalva_cpg:= savescr(15, 1, 16, 75)
   do while (.T.)
      sinal("CONSULTA", "DOCUMENTOS")
      tel_cpg()
      ini_cpg()
      set color to (cor[3])
      setcursor(1)
      @  5, 24 get XCOD_FO picture "@k 9999" valid ;
         fcod_fo(stz(@xcod_fo), 5) when mens_when(mens1[1])
      @  6, 24 get XNR_DOC_CP picture "@K 9999999" valid ;
         stz(@xnr_doc_cp, "L") when mens_when(mens1[2])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela2
         setcursor(Local1)
         return
      endif
      if (xcx2)
         xalias:= "CONT_PGR"
      else
         xalias:= "CONT_PGF"
      endif
      select (xalias)
      set order to 1
      goto top
      if (Empty(xnr_doc_cp))
         seek xcod_fo
      else
         seek xcod_fo + descend(xnr_doc_cp)
      endif
      if (!Found())
         mensagem("Registro nao foi encontrado. Tecle <ESC> p/ continuar.", ;
            27)
         l_tela()
         loop
      endif
      do while (.T.)
         sinal("CONSULTA", "DOCUMENTOS")
         set color to 
         lin_nave()
         select (xalias)
         tran_cpg()
         select (xalias)
         l_tela()
         tel_cpg()
         fcod_fo(xcod_fo, 5)
         restscr(xsalva_cpg)
         set color to (cor[3])
         @  5, 24 get XCOD_FO picture "9999" when mens_when(mens1[1])
         @  6, 24 get XNR_DOC_CP picture "9999999" when ;
            mens_when(mens1[2])
         get_cpg()
         if (!Empty(xdt_liq_do))
            set color to (cor[1])
            window(15, 1, 20, 74, "ͻȺ ", .T.)
            tel_cpg2()
            set color to (cor[3])
            get_cpg2()
         endif
         readkill(.T.)
         getlist:= {}
         set color to 
         xdat_ant:= dt_rec_cp
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            l_tela()
            restscr(xsalva_cpg)
            set color to (cor[12])
            @ 17,  1 clear to 21, 76
            set color to 
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC2541ALT")
            sinal("ALTERA", "DOCUMENTO")
            @ 23,  0 clear
            select CONT_PGR
            if (!reclock(5))
               loop
            endif
            tran_cpg()
            select CONT_PGF
            set order to 1
            seek xcod_fo + descend(xnr_doc_cp)
            if (Found())
               if (!reclock(5))
                  select CONT_PGR
                  unlock
                  loop
               endif
            endif
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               get_cpg()
               if (!Empty(xdt_liq_do))
                  tel_cpg2()
                  set color to (cor[3])
                  get_cpg2()
               endif
               read
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               set color to 
               setcursor(0)
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  select CONT_PGR
                  grav_pgr()
                  unlock
                  select CONT_PGF
                  set order to 1
                  seek xcod_fo + descend(xnr_doc_cp)
                  if (Found())
                     grav_pgf()
                     unlock
                  endif
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC2541EXC")
            sinal("EXCLUI", "DOCUMENTO")
            @ 23,  0 clear
            if (excluir())
               select CONT_PGR
               set order to 1
               if (!reclock(5))
                  loop
               endif
               select CONT_PGF
               set order to 1
               seek xcod_fo + descend(xnr_doc_cp)
               if (Found())
                  if (!reclock(5))
                     select CONT_PGR
                     unlock
                     loop
                  endif
               endif
               select CONT_PGR
               delete
               unlock
               select CONT_PGF
               set order to 1
               seek xcod_fo + descend(xnr_doc_cp)
               if (Found())
                  delete
                  unlock
               endif
               select (xalias)
               skip 
               skip -1
            endif
         endcase
         restscr(xsalva_cpg)
         set color to (cor[12])
         @ 17,  1 clear to 21, 76
         restscr(linha22)
         set color to 
         @ 23,  0 clear
      enddo
   enddo
   return

********************************
procedure P259_2

   set color to (cor[1])
   window(9, 1, 19, 62, "ͻȺ ", .T.)
   @ 10,  3 say "Data.................:"
   @ 12,  3 say "Historico............:"
   @ 14,  3 say "Valor lanamento.....:"
   @ 16,  3 say "Numero do Documento..:"
   if (xd_c_lanca = "D")
      @ 18,  3 say "<D>ebito ou <C>redito:        Compensado.:"
   else
      @ 18,  3 say "<D>ebito ou <C>redito:        Bloqueado..:"
   endif
   set color to 
   return

********************************
function P263_1

   return " " + temp->co_mp + "  " + SubStr(mp_r->de_mp, 1, 30) + ;
      "  " + Transform(temp->qt_mp_u, "@E 999,999.999999") + "  " ;
      + Transform(mp_r->ult_p_mp * temp->qt_mp_u, ;
      "@e 999,999.999999") + " "

********************************
procedure INI_RES

   xcod_cl:= Space(5)
   xdt_ini:= xdt_fin:= CToD("")
   xco_ven:= Space(3)
   return

********************************
procedure NUC25412(Arg1, Arg2)

   local Local1
   Local1:= setcursor()
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 15, 74, "ͻȺ ", .T.)
   set color to 
   tel_cpg()
   xsalva_cpg:= savescr(15, 1, 16, 75)
   do while (.T.)
      sinal("CONSULTA", "DOCUMENTOS")
      xcod_fo:= cod_fo
      tel_cpg()
      lin_nave()
      select (Arg2)
      tran_cpg()
      tel_cpg()
      fcod_fo(xcod_fo, 5)
      set color to (cor[3])
      @  5, 24 get XCOD_FO picture "9999" when mens_when(mens1[1])
      @  6, 24 get XNR_DOC_CP picture "9999999" when ;
         mens_when(mens1[2])
      get_cpg()
      if (!Empty(xdt_liq_do))
         set color to (cor[1])
         window(15, 1, 20, 74, "ͻȺ ", .T.)
         tel_cpg2()
         set color to (cor[3])
         get_cpg2()
      endif
      readkill(.T.)
      getlist:= {}
      set color to 
      xdat_ant:= dt_rec_cp
      xtec:= InKey(0)
      do case
      case xtec == 18
         skip -1
         if (BOF())
            mensagem("Inicio do Arquivo", 1)
         endif
      case xtec == 3
         skip 
         if (EOF())
            mensagem("Fim do arquivo", 1)
            skip -1
         endif
      case xtec == 27
         set color to (cor[12])
         @ 15,  1 clear to 21, 75
         set color to 
         @ 23,  0 clear
         return
      case xtec = -1 .AND. acesso("NUC2541ALT")
         sinal("ALTERA", "DOCUMENTO")
         @ 23,  0 clear
         select CONT_PGR
         set order to 1
         if (!reclock(5))
            loop
         endif
         tran_cpg()
         select CONT_PGF
         set order to 1
         seek xcod_fo + descend(xnr_doc_cp)
         if (Found())
            if (!reclock(5))
               select CONT_PGR
               unlock
               loop
            endif
         endif
         do while (.T.)
            setcursor(1)
            set color to (cor[3])
            get_cpg()
            if (!Empty(xdt_liq_do))
               set color to (cor[1])
               window(15, 1, 20, 74, "ͻȺ ", .T.)
               tel_cpg2()
               set color to (cor[3])
               get_cpg2()
            endif
            read
            if (LastKey() = K_ESC .OR. !updated())
               exit
            endif
            set color to 
            setcursor(0)
            @ 23,  0 clear
            gra()
            if (gra = "A")
               loop
            elseif (gra = "G")
               select CONT_PGR
               grav_pgr()
               unlock
               select CONT_PGF
               set order to 1
               seek xcod_fo + descend(xnr_doc_cp)
               if (Found())
                  grav_pgf()
                  unlock
               endif
            endif
            exit
         enddo
      case xtec = -2 .AND. acesso("NUC2541EXC")
         sinal("EXCLUI", "DOCUMENTO")
         @ 23,  0 clear
         if (excluir())
            select CONT_PGR
            set order to 1
            if (!reclock(5))
               loop
            endif
            select CONT_PGF
            set order to 1
            seek xcod_fo + descend(xnr_doc_cp)
            if (Found())
               if (!reclock(5))
                  select CONT_PGR
                  unlock
                  loop
               endif
            endif
            select CONT_PGR
            delete
            unlock
            select CONT_PGF
            set order to 1
            seek xcod_fo + descend(xnr_doc_cp)
            if (Found())
               delete
               unlock
            endif
            select (Arg2)
            skip 
            skip -1
         endif
      endcase
      restscr(xsalva_cpg)
      set color to (cor[12])
      @ 17,  1 clear to 21, 76
      restscr(linha22)
      set color to 
      @ 23,  0 clear
   enddo
   return

********************************
static function LOAD_PED

   return " " + nr_ped + "     " + DToC(dt_ped) + "   " + ;
      DToC(dt_re_ped) + "     " + DToC(dt_em_nf) + "     " + nr_nf ;
      + " "

********************************
procedure NUC25413(Arg1, Arg2)

   local Local1
   Local1:= setcursor()
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 15, 74, "ͻȺ ", .T.)
   set color to 
   tel_cpg()
   xsalva_cpg:= savescr(15, 1, 16, 75)
   do while (.T.)
      sinal("CONSULTA", "DOCUMENTOS")
      xcod_fo:= cod_fo
      tel_cpg()
      lin_nave()
      select (Arg2)
      tran_cpg()
      tel_cpg()
      fcod_fo(xcod_fo, 5)
      set color to (cor[3])
      @  5, 24 get XCOD_FO picture "9999" when mens_when(mens1[1])
      @  6, 24 get XNR_DOC_CP picture "9999999" when ;
         mens_when(mens1[2])
      get_cpg()
      if (!Empty(xdt_liq_do))
         set color to (cor[1])
         window(15, 1, 20, 74, "ͻȺ ", .T.)
         tel_cpg2()
         set color to (cor[3])
         get_cpg2()
      endif
      readkill(.T.)
      getlist:= {}
      set color to 
      xtec:= InKey(0)
      do case
      case xtec == 18
         skip -1
         if (BOF())
            mensagem("Inicio do Arquivo", 1)
         endif
      case xtec == 3
         skip 
         if (EOF())
            mensagem("Fim do arquivo", 1)
            skip -1
         endif
      case xtec == 27
         l_tela()
         restscr(xsalva_cpg)
         set color to (cor[12])
         @ 17,  1 clear to 21, 76
         restscr(linha22)
         set color to 
         @ 23,  0 clear
         return
      case xtec = -1 .AND. acesso("NUC2541ALT")
         sinal("ALTERA", "DOCUMENTO")
         @ 23,  0 clear
         select CONT_PGR
         set order to 1
         if (!reclock(5))
            loop
         endif
         tran_cpg()
         select CONT_PGF
         set order to 1
         seek xcod_fo + descend(xnr_doc_cp)
         if (Found())
            if (!reclock(5))
               select CONT_PGR
               unlock
               loop
            endif
         endif
         do while (.T.)
            setcursor(1)
            set color to (cor[3])
            get_cpg()
            if (!Empty(xdt_liq_do))
               set color to (cor[1])
               window(15, 1, 20, 74, "ͻȺ ", .T.)
               tel_cpg2()
               set color to (cor[3])
               get_cpg2()
            endif
            read
            if (LastKey() = K_ESC .OR. !updated())
               exit
            endif
            set color to 
            setcursor(0)
            @ 23,  0 clear
            gra()
            if (gra = "A")
               loop
            elseif (gra = "G")
               select CONT_PGR
               grav_pgr()
               unlock
               select CONT_PGF
               set order to 1
               seek xcod_fo + descend(xnr_doc_cp)
               if (Found())
                  grav_pgf()
                  unlock
               endif
            endif
            exit
         enddo
      case xtec = -2 .AND. acesso("NUC2541EXC")
         sinal("EXCLUI", "DOCUMENTO")
         @ 23,  0 clear
         if (excluir())
            select CONT_PGR
            set order to 1
            if (!reclock(5))
               loop
            endif
            select CONT_PGF
            set order to 1
            seek xcod_fo + descend(xnr_doc_cp)
            if (Found())
               if (!reclock(5))
                  select CONT_PGR
                  unlock
                  loop
               endif
            endif
            select CONT_PGR
            delete
            unlock
            select CONT_PGF
            set order to 1
            seek xcod_fo + descend(xnr_doc_cp)
            if (Found())
               delete
               unlock
            endif
            select (Arg2)
            skip 
            skip -1
         endif
      endcase
      restscr(xsalva_cpg)
      set color to (cor[12])
      @ 17,  1 clear to 21, 76
      restscr(linha22)
      @ 23,  0 clear
   enddo
   return

********************************
procedure NUC25421(Arg1)

   do while (!Empty(dt_liq_do))
      skip Arg1
      if (BOF())
         Arg1:= 1
      elseif (EOF())
         Arg1:= -1
      endif
   enddo
   return

********************************
procedure FUNC0022


********************************
procedure FUNC0048


********************************
procedure NUC2542

   local Local1:= 1, Local2:= setcursor()
   private xcod_fo, xnr_doc_cp, xrefer_cp, xdt_ven_cp, xdt_rec_cp, ;
      xval_cp
   private xval_icm_c, xdt_liq_do, xval_acres, xval_liqui, xnr_cheq, ;
      xcod_moe
   private xtipo_doc, xnr_cc, xtela
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou <ESC> p/ sair", ;
      "Digite o Numero do Documento ou <ESC> p/ sair", ;
      "Digite a Data de Recebimento do Documento. <ESC> p/ sair", ;
      "Digite a Data do Vencimento do Documento. <ESC> p/ sair", ;
      "Digite o Valor do Documento ou <ESC> p/ sair", ;
      "Digite o Valor do ICMS ou <ESC> p/ sair", ;
      "Digite a Referencia do Documento ou <ESC> p/ sair", ;
      "Digite o Numero do Cheque/Conta Corrente/Banco ou <ESC> p/ sair", ;
      "Digite a Data de Liquidacao do Documento. <ESC> p/ sair", ;
      "Digite o Valor do Acrescimo ou <ESC> p/ sair", ;
      "Digite o Valor do pago ou <ESC> p/ sair", ;
      "Digite a Moeda do documento ou tecle <ESC> p/ sair", ;
      "Digite o Tipo do documento ou tecle <ESC> p/ sair", ;
      "Digite o Nr. do Banco/Nr. da Agencia/Nr. da Conta C. ou tecle <ESC> p/ sair"}
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("LIQUIDA", "DOCUMENTOS")
   set color to (cor[1])
   window(4, 1, 15, 74, "ͻȺ ", .T.)
   xtela:= savescr(4, 0, 22, 79)
   set color to 
   do while (.T.)
      restscr(xtela)
      tel_cpg()
      ini_cpg()
      set color to (cor[3])
      setcursor(1)
      @  5, 24 get XCOD_FO picture "@k 9999" valid ;
         fcod_fo(stz(@xcod_fo), 5) when mens_when(mens1[1])
      @  6, 24 get XNR_DOC_CP picture "@K 9999999" valid ;
         !Empty(xnr_doc_cp) .AND. stz(@xnr_doc_cp, "L") when ;
         mens_when(mens1[2])
      read
      setcursor(0)
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         setcursor(Local2)
         return
      endif
      if (xcx2)
         xalias:= "CONT_PGR"
      else
         xalias:= "CONT_PGF"
      endif
      select (xalias)
      set order to 1
      seek xcod_fo + descend(xnr_doc_cp)
      if (!Found())
         mensagem("Registro nao foi encontrado. Tecle [ESC] p/ continuar.", ;
            27)
         set color to (cor[12])
         @ 16,  1 clear to 21, 75
         set color to 
         @ 23,  0 clear
         l_tela()
         loop
      endif
      if (!Empty(dt_liq_do))
         mensagem("Documento ja liquidado. Tecle [ESC] p/ continuar.", ;
            27)
         l_tela()
         loop
      endif
      ms250("[ENTER] Baixa   [PgUp] Reg. Anterior   [PgDn] Reg. Posterior   [ESC] Cancela", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      xl24:= savescr(24, 0, 24, 79)
      do while (.T.)
         tran_cpg()
         set color to (cor[3])
         @  5, 24 get XCOD_FO picture "@k 9999" when ;
            mens_when(mens1[1])
         @  6, 24 get XNR_DOC_CP picture "@K 9999999" when ;
            mens_when(mens1[2])
         fcod_fo(stz(@xcod_fo), 5)
         get_cpg()
         readkill(.T.)
         getlist:= {}
         set color to 
         restscr(xl24)
         tk:= InKey(0)
         do case
         case tk == 18
            skip -1
            nuc25421(-1)
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case tk == 3
            skip 
            nuc25421(1)
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case tk == 27
            exit
         case tk = 13 .AND. Empty(xdt_liq_do)
            exit
         endcase
      enddo
      if (LastKey() == K_ESC)
         l_tela()
         loop
      endif
      select CONT_PGR
      set order to 1
      if (!reclock(5))
         l_tela()
         loop
      endif
      tran_cpg()
      select CONT_PGF
      set order to 1
      seek xcod_fo + descend(xnr_doc_cp)
      if (Found())
         if (!reclock(5))
            select CONT_PGR
            unlock
            l_tela()
            loop
         endif
      endif
      set color to (cor[3])
      get_cpg()
      readkill(.T.)
      getlist:= {}
      set color to 
      set color to (cor[1])
      window(15, 1, 20, 74, "ͻȺ ", .T.)
      tel_cpg2()
      do while (.T.)
         setcursor(1)
         set color to (cor[3])
         get_cpg2()
         read
         set color to 
         setcursor(0)
         if (LastKey() == K_ESC)
            exit
         endif
         @ 23,  0 clear
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            select CONT_PGR
            grav_pgr()
            unlock
            select CONT_PGF
            set order to 1
            seek xcod_fo + descend(xnr_doc_cp)
            if (Found())
               grav_pgf()
               unlock
            endif
         endif
         exit
      enddo
      l_tela()
      set color to (cor[12])
      @ 16,  1 clear to 21, 75
      set color to 
      @ 23,  0 clear
   enddo
   return

********************************
procedure NUC3191

   nome_rel:= "Relatorio de Clientes por Cidade"
   set device to printer
   setprc(62, 0)
   select CLIENTES
   set order to 8
   seek xest_cl
   do while (clientes->est_cl = xest_cl)
      if (clientes->cid_cl != Trim(xcid_cl))
         skip 
         loop
      endif
      imp_cli319()
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      select CLIENTES
      skip 
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC321

   parameters opcao
   private pg:= 0
   select FORNECED
   if (opcao == 1)
      nome_rel:= "Relatorio de Fornecedores em ordem (Alfabetica)"
      set order to 2
   elseif (opcao == 2)
      nome_rel:= "Relatorio de Fornecedores em ordem (Codigo)"
      set order to 1
   endif
   goto top
   set device to printer
   cabe("321")
   do while (!EOF())
      @ PRow() + 1,  2 say cod_fo
      @ PRow(), 11 say nome_fo
      @ PRow(), 55 say cgc_fo picture "@R 99.999.999/9999-99"
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 60)
         eject
         cabe("321")
      endif
      skip 
   enddo
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure MV_HLP_OFF

   set key K_F1 to help1
   SetKey(K_ALT_UP, Nil)
   SetKey(K_ALT_LEFT, Nil)
   SetKey(K_ALT_RIGHT, Nil)
   SetKey(K_ALT_DOWN, Nil)
   SetKey(K_ALT_PGUP, Nil)
   SetKey(K_ALT_PGDN, Nil)
   SetKey(K_ALT_HOME, Nil)
   SetKey(K_ALT_END, Nil)
   return

********************************
procedure NUC2551

   local Local1
   parameters opc_emp
   private mens:= {"Digite o do Nome Credor/. <ESC> p/ sair", ;
      "Digite a Referencia.", ;
      "Digite o Tipo da Operacao, <C>redito ou <D>ebito", ;
      "Digite a Data da Operacao", "Digite o Valor da Operacao", ;
      "Digite a Moeda da Operacao", ;
      "Digite o Indexador de Correcao da Operacao", ;
      "Digite o Percentual adicional da Operacao", ;
      "Digite a Data Provavel de Liquidacao", ;
      "Digite o Valor da Liquidacao", ;
      "Digite a Data da Liquidacao"}
   private xnome_emp, xref_emp, xtipo_oper, xdt_oper, xval_oper, ;
      xcod_moe, xemp_bp
   private xcod_ind, xperc_acr, xdt_pr_liq, xval_liqui, xdt_liqui, ;
      xval_atu
   private xl:= 3, xc:= 0, xcursor:= setcursor(), vet_emp:= {}, ;
      vet_reg:= {}
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "EMPRESTIMOS")
   select EMPRESTI
   set order to 1
   goto top
   do while (!EOF())
      AAdd(vet_emp, load_emp())
      AAdd(vet_reg, RecNo())
      skip 
   enddo
   set color to (cor[16])
   window(4, 1, 20, 76, "Ŀ ", .T.)
   @  5,  2 say ;
      " Nome                          Oper  Dt Oper.  Dt Liqu.         Valor "
   @  6,  2 say ;
      ""
   ms250("[Enter] Mostra dados completos                     [ESC] Termina ", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   achoice(7, 2, 19, 75, vet_emp, Nil, "NUC25511")
   set color to (cor[1])
   return

********************************
procedure NUC2721

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {15, 52, " Pedido         ", ;
      padc("Consulta/Manutencao por Numero do Pedido do Cliente", ;
      80)})
   AAdd(Local1, {16, 52, " Clientes       ", ;
      padc("Consulta/Manutencao por Cliente", 80)})
   AAdd(Local1, {17, 52, " Codigo Produto ", ;
      padc("Consulta/Manutencao por Codigo do Produto Acabado", ;
      80)})
   save screen to Local2
   sinal("SUB-MENU", "PEDIDOS")
   m_pedidos:= 1
   do while (.T.)
      set color to (cor[14])
      window(14, 51, 18, 68, "Ŀ ", .T.)
      m_pedidos:= menu_prt(Local1, m_pedidos, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_pedidos = 1
         nuc27211()
      case m_pedidos = 2
         nuc27212()
      case m_pedidos = 3
         nuc27213()
      case m_pedidos = 0
         commit
         restore screen from Local2
         return
      endcase
   enddo
   return

********************************
function DIG11N(Arg1)

   local Local1:= 0, Local2:= Len(Arg1), Local3
   for Local3:= 1 to Local2
      Local1:= Local1 + Val(SubStr(Arg1, Local3, 1)) * (Local2 + 2 - ;
         Local3)
   next
   Local3:= 11 - Local1 % 11
   return iif(Local3 < 10, Str(Local3, 1), iif(Local3 = 10, "0", "1"))

********************************
function DBCREATEIN(Arg1, Arg2, Arg3, Arg4, Arg5)

   ordcreate(Arg1, Arg5, Arg2, Arg3, Arg4)
   return Nil

********************************
procedure RDDSYS

   return

********************************
procedure NUC2552

   local Local1
   parameters opc_emp
   private mens:= {"Digite o do Nome Credor/. <ESC> p/ sair", ;
      "Digite a Referencia.", ;
      "Digite o Tipo da Operacao, <C>redito ou <D>ebito", ;
      "Digite a Data da Operacao", "Digite o Valor da Operacao", ;
      "Digite a Moeda da Operacao", ;
      "Digite o Indexador de Correcao da Operacao", ;
      "Digite o Percentual adicional da Operacao", ;
      "Digite a Data Provavel de Liquidacao", ;
      "Digite o Valor da Liquidacao", ;
      "Digite a Data da Liquidacao"}
   private xnome_emp, xref_emp, xtipo_oper, xdt_oper, xval_oper, ;
      xcod_moe, xemp_bp
   private xcod_ind, xperc_acr, xdt_pr_liq, xval_liqui, xdt_liqui, ;
      xval_atu
   private xl:= 3, xc:= 0, xcursor:= setcursor(), vet_emp:= {}, ;
      vet_reg:= {}
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "EMPRESTIMOS")
   select EMPRESTI
   set order to 1
   goto top
   do while (!EOF())
      if (Empty(empresti->dt_liqui))
         AAdd(vet_emp, load_emp())
         AAdd(vet_reg, RecNo())
      endif
      skip 
   enddo
   set color to (cor[16])
   window(4, 1, 20, 76, "Ŀ ", .T.)
   @  5,  2 say ;
      " Nome                          Oper  Dt Oper.  Dt Liqu.         Valor "
   @  6,  2 say ;
      ""
   ms250("[Enter] Altera          [Delete] Exclui          [ESC] Termina ", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   achoice(7, 2, 19, 75, vet_emp, Nil, "NUC25521")
   set color to (cor[1])
   return

********************************
procedure NUC272

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {14, 42, " Pedidos          ", ;
      padc("Consulta Pedidos Abertos/Fechados", 80)})
   AAdd(Local1, {15, 42, " Resumo de Vendas ", ;
      padc("Consulta Resumo de Vendas", 80)})
   save screen to Local2
   sinal("SUB-MENU", "VENDAS")
   m_vendas:= 1
   do while (.T.)
      set color to (cor[16])
      window(13, 41, 16, 60, "Ŀ ", .T.)
      m_vendas:= menu_prt(Local1, m_vendas, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case m_vendas = 1
         if (acesso("NUC2721"))
            nuc2721()
         endif
      case m_vendas = 2
         if (acesso("NUC2722"))
            nuc2722()
         endif
      case m_vendas = 3
      case m_vendas = 0
         commit
         restore screen from Local2
         return
      endcase
   enddo
   return

********************************
function NUC272131(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= savescr(24, 0, 24, ;
      79), Local4
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      Local4:= savescr(4, 1, 21, 78)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      nuc27211(SubStr(vet_ped[Arg2], 2, 6))
      restscr(Local4)
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local3)
   return Local2

********************************
function NUC25521(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4, Local5:= ;
      savescr(24, 0, 24, 79)
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      empresti->(dbGoto(vet_reg[Arg2]))
      if (reclock(5))
         setcursor(1)
         Local4:= savescr(4, 1, 21, 78)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         tel_emp()
         set color to (cor[3])
         trans_emp()
         do while (acesso("NUC2552ALT"))
            get_emp(.T.)
            disp155()
            readkill(.T.)
            getlist:= {}
            @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
               !Empty(xnome_emp) when mens_when(mens[1])
            set color to (cor[3])
            get_emp(.T.)
            read
            set color to 
            if (LastKey() != K_ESC)
               @ 23,  0
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_emp()
                  vet_emp[Arg2]:= load_emp()
               endif
            endif
            setcursor(0)
            exit
         enddo
         restscr(Local4)
      else
         mensagem("Registro nao pode ser alterado. Tecle <ESC> p/ continuar.", ;
            27)
      endif
      Local2:= 2
      unlock
   elseif (Local1 = 7 .AND. acesso("NUC2552EXC"))
      empresti->(dbGoto(vet_reg[Arg2]))
      if (reclock(5))
         Local4:= savescr(4, 1, 21, 78)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         tel_emp()
         set color to (cor[3])
         trans_emp()
         @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
            !Empty(xnome_emp) when mens_when(mens[1])
         get_emp()
         disp155()
         readkill(.T.)
         getlist:= {}
         if (excluir())
            adel(vet_emp, Arg2)
            asize(vet_emp, Len(vet_emp) - 1)
            goto vet_reg[Arg2]
            delete
            adel(vet_reg, Arg2)
            asize(vet_reg, Len(vet_reg) - 1)
         endif
         restscr(Local4)
      else
         mensagem("Registro nao pode ser excluido. Tecle <ESC> p/ continuar.", ;
            27)
      endif
      Local2:= 2
      unlock
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local5)
   return Local2

********************************
procedure LISTA_ITEM

   local Local1
   Local1:= alias()
   private xnr_nf:= nr_nf
   select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
   set order to 1
   seek xnr_ped
   mp_r->(dbSetOrder(1))
   v_itens:= {}
   do while (nr_ped = xnr_ped .AND. !EOF())
      xco_mp:= co_mp
      xval_mp:= Transform(val_mp, "@E 999,999,999.99")
      xqt_pe_mp:= Transform(qt_pe_mp, "@E 999,999.99")
      mp_r->(dbSeek(xco_mp))
      xdesc_mp:= SubStr(mp_r->de_mp, 1, 31)
      AAdd(v_itens, " " + nr_item_pd + "  " + xdesc_mp + "  " + ;
         xqt_pe_mp + "  " + xval_mp + " ")
      skip 
   enddo
   @ 23,  0 say Space(80)
   ms250(" [ENTER] Alterar Item    [DEL] Excluir Item   [F6] Incluir Item    [ESC] Sair  ", ;
      24, 0, cor[1], cor[2], Nil, Nil, 80, "C")
   set color to (cor[19])
   window(12, 1, 20, 70, "ͻȺ ", .T.)
   @ 13,  2 say ;
      "Item  Descricao da Materia Prima        Quantidade   Preco Unitario"
   @ 14,  2 to 14, 69
   xop_itens:= achoice(15, 2, 19, 69, v_itens, Nil, "REC_ITEM2")
   set color to 
   set color to (cor[12])
   @ 12,  1 clear to 21, 77
   set color to 
   select (Local1)
   return

********************************
procedure LIMPA_RES

   set color to (cor[1])
   @  5, 20 clear to 11, 69
   set color to 
   return

********************************
static procedure CONFIG_IMP

   @ PRow(), PCol() + 1 say prt->imp_reset
   @ PRow(), PCol() + 1 say prt->imp_16cpp
   return

********************************
procedure NUC2553

   local Local1
   parameters opc_emp
   private mens:= {"Digite o do Nome Credor/. <ESC> p/ sair", ;
      "Digite a Referencia.", ;
      "Digite o Tipo da Operacao, <C>redito ou <D>ebito", ;
      "Digite a Data da Operacao", "Digite o Valor da Operacao", ;
      "Digite a Moeda da Operacao", ;
      "Digite o Indexador de Correcao da Operacao", ;
      "Digite o Percentual adicional da Operacao", ;
      "Digite a Data Provavel de Liquidacao", ;
      "Digite o Valor da Liquidacao", ;
      "Digite a Data da Liquidacao"}
   private xnome_emp, xref_emp, xtipo_oper, xdt_oper, xval_oper, ;
      xcod_moe, xemp_bp
   private xcod_ind, xperc_acr, xdt_pr_liq, xval_liqui, xdt_liqui, ;
      xval_atu
   private xl:= 3, xc:= 0, xcursor:= setcursor(), vet_emp:= {}, ;
      vet_reg:= {}
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "EMPRESTIMOS")
   select EMPRESTI
   set order to 1
   goto top
   do while (!EOF())
      if (!Empty(empresti->dt_liqui))
         AAdd(vet_emp, load_emp())
         AAdd(vet_reg, RecNo())
      endif
      skip 
   enddo
   set color to (cor[16])
   window(4, 1, 20, 76, "Ŀ ", .T.)
   @  5,  2 say ;
      " Nome                          Oper  Dt Oper.  Dt Liqu.         Valor "
   @  6,  2 say ;
      ""
   ms250("[Enter] Altera          [Delete] Exclui          [ESC] Termina ", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   achoice(7, 2, 19, 75, vet_emp, Nil, "NUC25531")
   set color to (cor[1])
   return

********************************
function REC_ITEM(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4, Local5, ;
      Local6:= SetColor(), Local7:= setcursor(), Local8
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      setcursor(1)
      set color to (cor[3])
      Local5:= SubStr(v_itens[Arg2], 2, 2)
      Local3:= Val(SubStr(v_itens[Arg2], 63, 10))
      Local4:= Val(SubStr(v_itens[Arg2], 50, 10))
      Local8:= Local3
      @ 15 + Arg3, 63 get XVAR1 picture "@E 99999999.99" valid ;
         Local3 <= Local4 when mens_when(mens2[4])
      read
      set color to 
      if (LastKey() != K_ESC)
         v_itens[Arg2]:= SubStr(v_itens[Arg2], 1, 62) + ;
            Transform(Local3, "@E 9999999.99") + " "
         replace ped_mp_r->dt_re_ped with xdt_re_ped
         replace ped_mp_r->dt_em_nf with xdt_em_nf
         replace ped_mp_r->nr_nf with xnr_nf
         it_p_mpr->(dbSetOrder(1))
         it_p_mpr->(dbSeek(xnr_ped + Local5))
         replace it_p_mpr->qt_re_mp with Local3
         if (!xcx2)
            replace ped_mp_f->dt_re_ped with xdt_re_ped
            replace ped_mp_f->dt_em_nf with xdt_em_nf
            replace ped_mp_f->nr_nf with xnr_nf
            it_p_mpf->(dbSetOrder(1))
            it_p_mpf->(dbSeek(xnr_ped + Local5))
            replace it_p_mpf->qt_re_mp with Local3
         endif
         mp_r->(dbSeek(it_p_mpr->co_mp))
         if (xcx2)
            replace mp_r->est_mp_max with mp_r->est_mp_max + Local3
         else
            replace mp_r->est_mp_max with mp_r->est_mp_max + Local3
            replace mp_r->est_mp_at with mp_r->est_mp_at + Local3
         endif
      endif
      setcursor(Local7)
      set color to 
      @ 23,  0 say Space(80)
      aviso(24, ;
         "Use as setas p/ escolher o item e tecle <ENTER> p/ receber o mesmo")
      set color to (Local6)
   endif
   return Local2

********************************
function __CSETWIDT(Arg1)

   if (Arg1 != Nil)
      qself()[2]:= _einstvar(qself(), "WIDTH", Arg1, "N", 1001)
   endif
   return qself()[2]

********************************
function NUC25531(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4, Local5:= ;
      savescr(24, 0, 24, 79)
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      empresti->(dbGoto(vet_reg[Arg2]))
      if (reclock(5))
         Local4:= savescr(4, 1, 21, 78)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         tel_emp()
         set color to (cor[3])
         trans_emp()
         do while (acesso("NUC2552ALT"))
            @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
               !Empty(xnome_emp) when mens_when(mens[1])
            get_emp(.T.)
            disp155()
            readkill(.T.)
            getlist:= {}
            set color to (cor[12])
            tel_emp2()
            set color to (cor[3])
            get_emp2()
            setcursor(1)
            read
            if (LastKey() != K_ESC)
               @ 23,  0
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_emp2()
               endif
            endif
            exit
         enddo
         restscr(Local4)
      else
         mensagem("Registro nao pode ser alterado. Tecle <ESC> p/ continuar.", ;
            27)
      endif
      Local2:= 2
      unlock
   elseif (Local1 = 7 .AND. acesso("NUC2552EXC"))
      empresti->(dbGoto(vet_reg[Arg2]))
      if (reclock(5))
         Local4:= savescr(4, 1, 21, 78)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         tel_emp()
         set color to (cor[3])
         trans_emp()
         @ xl + 2, xc + 25 get XNOME_EMP picture "@!" valid ;
            !Empty(xnome_emp) when mens_when(mens[1])
         get_emp()
         disp155()
         readkill(.T.)
         getlist:= {}
         if (excluir())
            adel(vet_emp, Arg2)
            asize(vet_emp, Len(vet_emp) - 1)
            goto vet_reg[Arg2]
            replace empresti->val_liqui with 0
            replace empresti->dt_liqui with CToD("")
            adel(vet_reg, Arg2)
            asize(vet_reg, Len(vet_reg) - 1)
         endif
         restscr(Local4)
      else
         mensagem("Registro nao pode ser excluido. Tecle <ESC> p/ continuar.", ;
            27)
      endif
      Local2:= 2
      unlock
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local5)
   return Local2

********************************
procedure NUC2711

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {15, 52, " Pedido     ", ;
      padc("Consulta/Manutencao por Pedidos", 80)})
   AAdd(Local1, {16, 52, " Fornecedor ", ;
      padc("Consulta/Manutencao por Fornecedor", 80)})
   AAdd(Local1, {17, 52, " Codigo MP  ", ;
      padc("Consulta/Manutencao por Codigo da Mat. Prima", 80)})
   save screen to Local2
   sinal("SUB-MENU", "PEDIDOS")
   m_pedidos:= 1
   do while (.T.)
      set color to (cor[14])
      window(14, 51, 18, 64, "Ŀ ", .T.)
      m_pedidos:= menu_prt(Local1, m_pedidos, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_pedidos = 1
         nuc27111()
      case m_pedidos = 2
         nuc27112()
      case m_pedidos = 3
         nuc27113()
      case m_pedidos = 0
         commit
         restore screen from Local2
         return
      endcase
   enddo
   return

********************************
procedure GET_MANU

   set color to (cor[3])
   @ 13, 20 get XDT_RE_PED picture "@D"
   @ 14, 20 get XDT_EM_NF picture "@D"
   @ 15, 20 get XNR_NF picture "999999"
   return

********************************
procedure NUC2554

   local Local1
   parameters opc_emp
   private mens:= {"Digite o do Nome Credor/. <ESC> p/ sair", ;
      "Digite a Referencia.", ;
      "Digite o Tipo da Operacao, <C>redito ou <D>ebito", ;
      "Digite a Data da Operacao", "Digite o Valor da Operacao", ;
      "Digite a Moeda da Operacao", ;
      "Digite o Indexador de Correcao da Operacao", ;
      "Digite o Percentual adicional da Operacao", ;
      "Digite a Data Provavel de Liquidacao", ;
      "Digite o Valor da Liquidacao", ;
      "Digite a Data da Liquidacao"}
   private xnome_emp, xref_emp, xtipo_oper, xdt_oper, xval_oper, ;
      xcod_moe, xemp_bp
   private xcod_ind, xperc_acr, xdt_pr_liq, xval_liqui, xdt_liqui, ;
      xval_atu
   private xl:= 3, xc:= 0, xcursor:= setcursor(), vet_emp:= {}, ;
      vet_reg:= {}
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "EMPRESTIMOS")
   select EMPRESTI
   set order to 1
   goto top
   do while (!EOF())
      if (Empty(empresti->dt_liqui))
         AAdd(vet_emp, load_emp())
         AAdd(vet_reg, RecNo())
      endif
      skip 
   enddo
   set color to (cor[16])
   window(4, 1, 20, 76, "Ŀ ", .T.)
   @  5,  2 say ;
      " Nome                          Oper  Dt Oper.  Dt Liqu.         Valor "
   @  6,  2 say ;
      ""
   ms250("[Enter] Baixa Emprestimo em aberto                 [ESC] Termina ", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   achoice(7, 2, 19, 75, vet_emp, Nil, "NUC25541")
   set color to (cor[1])
   return

********************************
procedure MONTA_ITEN

   lim_baixa2()
   select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
   set order to 1
   seek xnr_ped
   v_itens:= {}
   mp_r->(dbSetOrder(1))
   do while (nr_ped = xnr_ped .AND. !EOF())
      xco_mp:= co_mp
      mp_r->(dbSeek(xco_mp))
      xdesc_mp:= mp_r->de_mp
      AAdd(v_itens, " " + nr_item_pd + "  " + xdesc_mp + "  " + ;
         Transform(qt_pe_mp, "@E 9999999.99") + "  " + ;
         Transform(qt_re_mp, "@E 9999999.99") + " ")
      skip 
   enddo
   @ 23,  0 say Space(80)
   aviso(24, ;
      "Use as setas p/escolher o item. Tecle <ENTER> p/receber ou <ESC> p/sair")
   set color to (cor[1])
   window(12, 1, 20, 75, "ͻȺ ", .T.)
   @ 13,  2 say ;
      "Item  Descricao da Materia Prima                 Qt. Pedida   Qt. Receb."
   @ 14,  2 to 14, 74
   set color to (cor[1])
   xop_itens:= achoice(15, 2, 19, 74, v_itens, Nil, "REC_ITEM")
   set color to 
   set color to (cor[12])
   @ 12,  1 clear to 21, 76
   set color to 
   return

********************************
procedure TEL_ITEM3

   set color to (cor[1])
   window(13, 1, 18, 70, "ͻȺ ", .T.)
   @ 14,  3 say "Numero do Item.:"
   @ 15,  3 say "Cod. do Produto:"
   @ 16,  3 say "Qtde Produto...:"
   @ 17,  3 say "Val. unit. Prod:"
   set color to 
   return

********************************
procedure FUNC0312


********************************
procedure NUC256

   local Local1, Local2:= 1, Local3:= {}
   AAdd(Local3, {16, 43, " Codigo        ", ;
      padc("Consulta/Altera/Exclui pelo Codigo", 80)})
   AAdd(Local3, {17, 43, " Codigo e Data ", ;
      padc("Consulta/Altera/Exclui pelo Codigo e Data", 80)})
   parameters xcod_prod
   private i_n_d_i:= iif(xcod_prod = "IN", 1, 2)
   private mens1:= {{"Codigo do Indice Financeiro", ;
      "Codigo da Moeda"}, ;
      {"Data de Referncia do Indice Financeiro", ;
      "Data de Referncia da Moeda"}, ;
      {"Valor do Indice Financeiro na Data Supra em Porcentagen", ;
      "Valor da Moeda na Data Supra em Cruzeiros"}}, sinal:= ;
      {"VALOR_IN", "VALOR_MO"}, xcod_prod, xnome_prod, xdata_prod, ;
      xvalor_pro, m_tabelas
   private apelido, o_p_e_r:= "M", xnome_prod, xdata_prod:= ;
      CToD("  /  /  "), xvalor_pro:= 0, e_x_t_e:= xcod_prod
   save screen to Local1
   sinal("MANUTENCAO", sinal[i_n_d_i])
   select VALOR_TA
   do while (.T.)
      restore screen from Local1
      set color to (cor[16])
      window(15, 42, 18, 58, "Ŀ ", .T.)
      Local2:= menu_prt(Local3, Local2, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0
      do while (.T.)
         xnome_prod:= Space(3)
         if (Local2 = 1)
            set color to (cor[12])
            @  4,  1 clear to  6, 58
            set color to (cor[1])
            window(4, 1, 6, 58, "ͻȺ ", .T.)
            @  5,  3 say "Codigo ..........:" + Space(37)
            set color to (cor[3])
            @  5, 22 get XNOME_PROD picture "@k 999" valid ;
               localiza(stz(@xnome_prod), "TAB_" + iif(xcod_prod = ;
               "IN", "IND", "MOE"), 1, "M", "DESCRICAO", 5, 26) when ;
               mens_when(mens1[1][i_n_d_i])
            read
         elseif (Local2 = 2)
            set color to (cor[12])
            @  4,  1 clear to  8, 58
            set color to (cor[1])
            window(4, 1, 8, 58, "ͻȺ ", .T.)
            @  5,  3 say "Cdigo ..........:"
            @  7,  3 say "Data ............: "
            xdata_prod:= CToD("  /  /  ")
            set color to (cor[3])
            @  5, 22 get XNOME_PROD picture "@!" valid ;
               localiza(stz(@xnome_prod), "TAB_" + iif(xcod_prod = ;
               "IN", "IND", "MOE"), 1, "M", "DESCRICAO", 5, 26) when ;
               mens_when(mens1[1][i_n_d_i])
            @  7, 22 get XDATA_PROD valid !Empty(xdata_prod) when ;
               mens_when(mens1[2][i_n_d_i])
            read
         endif
         if (LastKey() == K_ESC)
            exit
         endif
         select VALOR_TA
         if (Local2 == 1)
            seek xcod_prod + xnome_prod
            if (EOF())
               tone(800, 5)
               ms250("Nenhum valor ja cadastrado p/ este CODIGO, Tecle <ESC> p/ continuar.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
               loop
            endif
         else
            seek xcod_prod + xnome_prod + DToS(xdata_prod)
            if (EOF())
               tone(800, 5)
               ms250("Valor nao cadastrado p/ esta DATA, Tecle <ESC> p/ continuar.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
               loop
            endif
         endif
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to (cor[1])
         t_tabela22()
         do while (.T.)
            tk:= navega(5, 22, Nil, "trans_tb22", "get_tb22", ;
               "cod_prod+nome_prod", xcod_prod + xnome_prod)
            if (tk = -1)
               do while (acesso("NUC256" + xcod_prod + "ALT"))
                  @ 24,  0
                  set color to (cor[3])
                  get_tb21()
                  read
                  set color to 
                  if (LastKey() != K_ESC)
                     @ 23,  0
                     gra()
                     if (gra = "A")
                        loop
                     elseif (gra = "G")
                        grava_tb21()
                     endif
                  endif
                  exit
               enddo
            elseif (tk = -2 .AND. acesso("NUC256" + xcod_prod + ;
                  "EXC"))
               @ 23,  0
               if (excluir())
                  delete
                  skip 
                  skip -1
               endif
            elseif (tk = 27)
               exit
            endif
         enddo
         setcursor(1)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
      enddo
   enddo
   return

********************************
static procedure CALC_04

   tone(1800, 3)
   ms250("Atualizando o valor do Custo do produto acabado", 24, 0, ;
      cor[4], cor[5], Nil, Nil, 80, "c")
   prod_aca->(dbGoTop())
   do while (!prod_aca->(EOF()))
      if (prod_aca->pd_mensal != 0)
         replace prod_aca->val_custo with prod_aca->val_mp + ;
            prod_aca->val_mp / xval_mp_me * xcgf_mensa
      endif
      prod_aca->(dbSkip())
   enddo
   set color to 
   @ 23,  0 clear
   return

********************************
procedure GET_MANU2

   set color to (cor[3])
   @ 16, 20 get XDT_EM_NF picture "@D"
   @ 17, 20 get XNR_NF picture "999999"
   return

********************************
static procedure EXTRATO_BA

   select BANCOS
   set order to 4
   seek xcod_nosso
   xnome_ban:= nome_ban
   select SALDO
   set order to 1
   set softseek on
   seek xcod_nosso + DToS(xdata_i)
   skip -1
   if (BOF() .OR. xcod_nosso != cod_nosso)
      xsaldo_ant:= xsaldo:= 0
      xdata_ant:= xdata_i
   else
      xsaldo_ant:= xsaldo:= val_saldo
      xdata_ant:= dat_saldo
   endif
   select EXTRATO
   set order to 1
   seek xcod_nosso + DToS(xdata_i)
   set softseek off
   xarq_rel:= newfile("TXT")
   set printer to (xarq_rel)
   set device to printer
   @  0,  0 say ""
   @  1,  1 say DToC(xdata_ant) + " Saldo anterior" + Space(39) + ;
      Transform(xsaldo, "@E 999,999,999.99")
   @  2,  0 say " "
   xdat_lanca:= dat_lanca
   xdata_carc:= Space(8)
   xdata_carc:= DToC(dat_lanca)
   do while (dat_lanca >= xdata_i .AND. dat_lanca <= xdata_f .AND. ;
         cod_nosso = xcod_nosso)
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      xdat_lanca:= dat_lanca
      if (d_c_lanca = "D")
         xtot_d:= xtot_d + val_lanca
         xsaldo:= xsaldo - val_lanca
         xsaldo_c:= xsaldo_c + iif(bloqueado = "N", val_lanca, 0)
      else
         xtot_c:= xtot_c + val_lanca
         xsaldo:= xsaldo + val_lanca
         xsaldo_b:= xsaldo_b + iif(bloqueado = "S", val_lanca, 0)
      endif
      @ PRow() + 1,  1 say xdata_carc + " " + SubStr(historico, 1, ;
         25) + " " + nr_doc + " " + d_c_lanca + " " + iif(d_c_lanca ;
         = "C", iif(bloqueado = "S", "BL", "  "), iif(bloqueado = ;
         "N", "NC", "  ")) + " " + Transform(val_lanca, ;
         "@E 9,999,999.99") + "   " + Transform(xsaldo, ;
         "@E 999,999.99")
      if (!Empty(SubStr(historico, 26, 25)))
         @ PRow() + 1,  1 say "         " + SubStr(historico, 26, 25)
      endif
      if (!Empty(SubStr(historico, 51, 20)))
         @ PRow() + 1,  1 say "         " + SubStr(historico, 51, 20)
      endif
      xdata_carc:= Space(8)
      skip 
      if (dat_lanca != xdat_lanca)
         xdata_carc:= DToC(dat_lanca)
         @ PRow() + 1,  0 say " "
      endif
   enddo
   @ PRow() + 2,  1 say "Saldo Anterior em " + DToC(xdata_ant) + ;
      ".....(A) :" + Transform(xsaldo_ant, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Total de Debitos  no Periodo...(B) :" + ;
      Transform(xtot_d, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Total de Creditos no Periodo...(C) :" + ;
      Transform(xtot_c, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Saldo da Conta no Periodo......(D) :" + ;
      Transform(xsaldo, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Valor Bloqueado................(E) :" + ;
      Transform(xsaldo_b, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Valor a Compensar..............(F) :" + ;
      Transform(xsaldo_c, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Saldo no Banco.............(D-E+F) :" + ;
      Transform(xsaldo - xsaldo_b + xsaldo_c, ;
      "@E 9,999,999,999,999.99")
   @ PRow() + 2,  1 say "Saldo Disponivel.............(D-E) :" + ;
      Transform(xsaldo - xsaldo_b, "@E 9,999,999,999,999.99")
   set device to screen
   set printer to (i_m_p_r_ee)
   xrel_txt:= memoread(xarq_rel)
   xtela:= savescr(3, 0, 21, 79)
   set color to (cor[1])
   window(3, 0, 22, 79, "ͻȺ ")
   ms250("Use as teclas de movimentacao para visualizar                    [ESC] Termina", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
   @  4,  1 say ;
      " Data     Lancamento                Nr. Doc.   Db/Cr       Valor        Saldo"
   @  5,  1 say Replicate("-", 78)
   set color to (cor[2])
   memoedit(xrel_txt, 6, 1, 21, 78)
   erase (xarq_rel)
   restscr(xtela)
   return

********************************
procedure MONTA_IT2

   lim_vend2()
   select (iif(xcx2, "ITEM_VER", "ITEM_VEF"))
   set order to 1
   seek xnr_ped
   v_itens:= {}
   mp_r->(dbSetOrder(1))
   do while (nr_ped = xnr_ped .AND. !EOF())
      xco_prod:= co_prod
      mp_r->(dbSeek(xco_prod))
      xdesc_mp:= mp_r->de_mp
      AAdd(v_itens, " " + nr_item_pd + "  " + xdesc_mp + "  " + ;
         Transform(qt_pe_prod, "@E 9999999.99") + "  " + ;
         Transform(qt_en_prod, "@E 9999999.99") + " ")
      skip 
   enddo
   @ 23,  0 say Space(80)
   aviso(24, ;
      "Use as setas p/escolher o item. Tecle <ENTER> p/receber ou <ESC> p/sair")
   set color to (cor[1])
   window(14, 1, 20, 75, "ͻȺ ", .T.)
   @ 15,  2 say ;
      "Item  Descricao da Materia Prima                 Qt. Pedida   Qt. Receb."
   @ 16,  2 to 16, 74
   set color to (cor[1])
   xop_itens:= achoice(17, 2, 19, 74, v_itens, Nil, "REC_ITEM3")
   set color to 
   set color to (cor[12])
   @ 14,  1 clear to 21, 76
   set color to 
   return

********************************
static procedure TIPOS_ETIQ

   save screen to xsub_tela1
   set color to (cor[14])
   window(13, 3, 17, 28, "Ŀ ", .T.)
   tipoform:= menu_prt(opc_s_etq, tipoform, cor[14], ;
      SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
      SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
      SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
      SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
   set color to 
   if (tipoform == 0)
   else
      return
   endif

********************************
function __TSETTOP(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[12]:= _einstvar(qself(), "GOTOPBLOCK", Arg1, "B", 1001)
   endif
   return qself()[12]

********************************
procedure DBFNTX

   return

********************************
procedure NUC259

   local Local1, Local2
   private mens1:= ;
      {"Digite o Codigo interno do Banco ou tecle <ESC> p/ sair", ;
      "Digite a data do lancamento ou tecle <ENTER> p/ acessar todos os registros", ;
      "Historico do lancamento", ;
      "Classificacao Contabil do lancamento (Debito ou Credito)", ;
      "Valor do lancamento", ;
      "Digite o Numero do Documento ou tecle <ESC> p/ sair", ;
      "O documento acima esta Bloqueado (Sim/Nao) ?             Tecle <ESC> para sair", ;
      "O documento acima ja foi compensado (Sim/Nao) ?          Tecle <ESC> para sair"}
   private xcod_nosso, xdat_lanca, xhistorico, xd_c_lanca, ;
      xval_lanca, xdat_saldo, xval_saldo, xnr_doc, xbloqueado, xtecla
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   xcod_nosso:= Space(3)
   xnr_doc:= Space(10)
   sinal("EXTRATO", "BANCARIO")
   do while (.T.)
      set color to (cor[12])
      Scroll(4, 1, 21, 78)
      set color to (cor[1])
      window(4, 1, 8, 62, "ͻȺ ", .T.)
      @  5,  3 say "Codigo..:"
      @  7,  3 say "Nr. Doc.:"
      set color to (cor[3])
      @  5, 13 get XCOD_NOSSO picture "@k 999" valid ;
         localiza(stz(@xcod_nosso), "BANCOS", 4, "M", ;
         "NOME_BAN+[  ]+NR_AGENCIA+[  ]+NR_CONTA", 5, 17) when ;
         mens_when(mens1[1])
      @  7, 13 get XNR_DOC when mens_when(mens1[6])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
         return
      endif
      select EXTRATO
      set order to 2
      seek xcod_nosso + xnr_doc
      if (EOF())
         @ 23,  0 clear
         tone(800, 5)
         ms250("Atencao! Chave de pesquisa nao encontrada, verificar. Tecle <ESC> p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      ms250("[ENTER] Altera   [PGUP] Reg. Anterior   [PGDN] Reg. Posterior   [ESC] Termina", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      l24:= savescr(24, 0, 24, 79)
      p259_2()
      setcursor(0)
      do while (.T.)
         p259_1()
         tel_ext3()
         p259_3()
         readkill(.T.)
         getlist:= {}
         xtecla:= ms250(Nil, Nil, Nil, Nil, Nil, {13, 27, 3, 18}, ;
            80, "c")
         do case
         case xtecla = 27
            setcursor(1)
            exit
         case xtecla = 13
            if (!reclock(5))
               loop
            endif
            xbloqueado:= iif(xd_c_lanca = "C", "N", "S")
            setcursor(1)
            p259_3()
            read
            replace extrato->bloqueado with xbloqueado
            restscr(l24)
            setcursor(0)
         case xtecla = 18
            skip -1
            if (xcod_nosso != extrato->cod_nosso)
               skip 
            endif
         case xtecla = 3
            skip 
            if (xcod_nosso != extrato->cod_nosso)
               skip -1
            endif
         endcase
      enddo
   enddo

********************************
static procedure NUC3672

   if (pg > 0)
      @ PRow() + 1,  0 say linha1
   endif
   cabe("367")
   @ PRow(),  0 say " M "
   @ PRow() + 2,  0 say linha1
   @ PRow() + 1,  0 say linha2
   @ PRow() + 1,  0 say linha3
   @ PRow() + 1,  0 say linha4
   return

********************************
procedure NUC26

   local Local1:= {}, Local2:= {}, Local3, Local4
   AAdd(Local1, {11, 31, " Produto Acabado      ", ;
      padc("Manutecao/Consulta Produto Acabado", 80)})
   AAdd(Local1, {12, 31, " Materia Prima        ", ;
      padc("Manutecao/Consulta Materia Prima", 80)})
   AAdd(Local1, {13, 31, " Formulas de Producao ", ;
      padc("Manutecao/Consulta Formulas de Producao", 80)})
   AAdd(Local1, {14, 31, " Producao Diaria      ", ;
      padc("Manutecao/Consulta Producao Diaria", 80)})
   AAdd(Local1, {15, 31, " Custo G. Fabricacao  ", ;
      padc("Manutecao/Consulta Custo Geral de Fabricacao", 80)})
   AAdd(Local1, {16, 31, " Mov. Materia Prima   ", ;
      padc("Manutecao/Consulta Movimento de Materia Prima", 80)})
   AAdd(Local1, {17, 31, " Controle de Carga    ", ;
      padc("Consulta Carga Emitida", 80)})
   AAdd(Local1, {18, 31, " Est. Materia Prima   ", ;
      padc("Manutencao/Consulta Estoque de Materia Prima", 80)})
   if (xcx2)
      AAdd(Local1, {19, 31, " Calcula Tab. Precos  ", ;
         "Calcula Tabela de Precos dos produtos acabados"})
   endif
   AAdd(Local2, {16, 40, " Numero da Carga ", ;
      padc("Consulta Carga pelo Numero da Carga", 80)})
   AAdd(Local2, {17, 40, " Data da Carga   ", ;
      padc("Consulta Carga pela Data da Carga", 80)})
   AAdd(Local2, {18, 40, " Numero Pedido   ", ;
      padc("Consulta Carga pelo Numero do Pedido", 80)})
   private xtela1
   save screen to xtela1
   m_clientes:= 1
   do while (.T.)
      sinal("SUB-MENU", "CLIENTES")
      set color to (cor[14])
      window(10, 30, 11 + Len(Local1), 53, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("NUC261"))
            nuc261()
         endif
      case m_clientes = 2
         if (acesso("NUC262"))
            nuc262()
         endif
      case m_clientes = 3
         if (acesso("NUC263"))
            nuc263()
         endif
      case m_clientes = 4
         if (acesso("NUC264"))
            nuc264()
         endif
      case m_clientes = 5
         if (acesso("NUC265"))
            nuc265()
         endif
      case m_clientes = 6
         if (acesso("NUC266"))
            nuc266()
         endif
      case m_clientes = 7
         sinal("SUB-MENU", "CARGA")
         Local4:= 1
         save screen to Local3
         do while (acesso("NUC267"))
            set color to (cor[16])
            window(15, 39, 19, 57, "Ŀ ", .T.)
            Local4:= menu_prt(Local2, Local4, cor[16], ;
               SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, ;
               At(",", SubStr(cor[16], At(",", cor[16]) + 1)) - 1), ;
               cor[17], SubStr(SubStr(cor[17], At(",", cor[17]) + ;
               1), 1, At(",", SubStr(cor[17], At(",", cor[17]) + 1)) ;
               - 1), 80)
            set color to 
            do case
            case Local4 = 0
               restore screen from Local3
               exit
            case Local4 = 1
               nuc2671()
            case Local4 = 2
               nuc2672()
            case Local4 = 3
               nuc2673()
            endcase
         enddo
      case m_clientes = 9
         if (acesso("NUC268"))
            nuc268()
         endif
      case m_clientes = 8
         if (acesso("NUC269"))
            nuc269()
         endif
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure NUC2673

   local Local1, Local2, Local3
   Local3:= savescr(3, 0, 22, 79)
   private pg:= 0, vet_est:= {}, vet_ped:= {}, new_vet, vet_item:= {}
   private vet_edita:= {}, vet_lin:= {}, xtotal_cai:= 0, xtravou:= .F.
   private xtotal_pes:= xtotal_val:= 0, yxest_cl:= "", xnr_carga
   sinal("CARGA", "PEDIDO")
   setcursor(1)
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 6, 29, "ͻȺ ", .T.)
   @  5,  3 say "Numero do Pedido: "
   set color to 
   Local1:= savescr(3, 0, 22, 79)
   do while (.T.)
      new_vet:= {}
      vet_est:= {}
      vet_ped:= {}
      vet_item:= {}
      vet_edita:= {}
      vet_lin:= {}
      xtotal_cai:= 0
      xtotal_pes:= 0
      xtotal_val:= 0
      yxest_cl:= ""
      xnr_ped:= Space(6)
      set color to (cor[3])
      @  5, 21 get XNR_PED picture "@K 999999" valid !Empty(xnr_ped) ;
         .AND. localiza(stz(@xnr_ped), "VENDAS_R", 1, "M") when ;
         mens_when("Digite o Numero do Pedido ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restscr(Local3)
         return
      endif
      nuc26711(xnr_ped)
      restscr(Local1)
   enddo

********************************
static function LOAD_PED

   return " " + nr_ped + "     " + DToC(dt_ped) + "   " + nr_nf + ;
      "   " + SubStr(clientes->nome_cl, 1, 17) + "  " + ;
      SubStr(tab_ven->nome_ven, 1, 17) + " "

********************************
function INDEXEXT

   return ordbagext()

********************************
procedure NUC261

   local Local1
   private mens:= {"Codigo do Produto Acabado", ;
      "Descricao do Produto Acabado", ;
      "Codigo da Unidade do Produto Acabado", ;
      "Estoque Atual do Produto Acabado", ;
      "Custo da Materia Prima no Produto Acabado", ;
      "Preco Atual do Produto Acabado", ;
      "Aliquota ICMS do Produto Acabado", ;
      "Aliquota IPI do Produto Acabado", ;
      "Preco de Faturamento do Produto Acabado", ;
      "Preco de Custo do Produto Acabado", ;
      "Capacidade da Caixa Padrao de Transporte", ;
      "Peso por unidade do produto"}
   private xco_prod, xde_prod, xco_unid, xest_atu, xval_mp, xval_prod
   private xali_ipi, xali_icms, xval_fatu, xval_custo, xqtd_padra, ;
      xpeso_prod
   private xl:= 3, xc:= 0, xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "PROD.ACAB.")
   tel_pac()
   do while (.T.)
      ini_pac()
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 25 get xco_prod picture "@k 9999" valid ;
         localiza(stz(@xco_prod), "PROD_ACA", 1, "M") when ;
         mens_when(mens[1])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      select PROD_ACA
      set order to 1
      goto top
      if (LastRec() == 0)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      if (Empty(xco_prod))
         xco_prod:= co_prod
      endif
      seek xco_prod
      do while (.T.)
         sinal("CONSULTA", "PROD.ACAB.")
         set color to 
         lin_nave()
         trans_pac()
         setcursor(1)
         set color to (cor[3])
         @ xl + 2, xc + 25 get xco_prod picture "@k 9999"
         get_pac()
         readkill(.T.)
         getlist:= {}
         disp161()
         setcursor(0)
         set color to 
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            limpa_pac()
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC261ALT")
            sinal("ALTERA", "PROD.ACAB.")
            @ 23,  0 clear
            if (!reclock(5))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               get_pac()
               read
               setcursor(0)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_pac()
                  unlock
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC261EXC")
            sinal("EXCLUI", "PROD.ACAB.")
            @ 23,  0 clear
            if (excluir())
               xfound:= .F.
               formula->(dbSetOrder(1))
               formula->(dbSeek(xco_prod))
               if (formula->(Found()))
                  xfound:= .T.
                  ms250("Existem Formulas para este Produto. Tecle [ESC] para continuar", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               endif
               item_ver->(dbSetOrder(2))
               item_ver->(dbSeek(xco_prod))
               if (item_ver->(Found()))
                  xfound:= .T.
                  ms250("Existem Item de Vendas para este Produto. Tecle[ESC] para continuar", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               endif
               producao->(dbSetOrder(1))
               producao->(dbSeek(xco_prod))
               if (producao->(Found()))
                  xfound:= .T.
                  ms250("Existe Producao para este Produto. Tecle [ESC] para continuar", ;
                     24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               endif
               if (!xfound)
                  if (!reclock(5))
                     mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                        27)
                     loop
                  endif
                  delete
                  unlock
               endif
            endif
            skip 
            skip -1
         endcase
      enddo
      limpa_pac()
      @ 23,  0 clear
   enddo
   return

********************************
static function CALC_01

   set color to 
   @ 23,  0 clear
   tone(1800, 3)
   ms250("Calculando a producao do Mes Anterior de Produto Acabado", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
   producao->(dbSetOrder(1))
   formula->(dbSetOrder(1))
   mp_r->(dbSetOrder(1))
   select PROD_ACA
   prod_aca->(dbSetOrder(1))
   prod_aca->(dbGoTop())
   do while (!prod_aca->(EOF()))
      set softseek on
      producao->(dbSeek(prod_aca->co_prod + "000" + DToS(xmes_prod)))
      set softseek off
      xpd_mensal:= 0
      do while (producao->co_prod = prod_aca->co_prod .AND. ;
            Month(producao->dt_prod) = Month(xmes_prod))
         xpd_mensal:= xpd_mensal + producao->qt_prod
         producao->(dbSkip())
      enddo
      replace prod_aca->pd_mensal with iif(xpd_mensal = 0, 1, ;
         xpd_mensal)
      prod_aca->(dbSkip())
   enddo
   return .T.

********************************
function SB

   return LastKey() == K_UP

********************************
procedure NUC262

   local Local1
   private mens1:= ;
      {"Digite o Codigo da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Descricao da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Unidade ou tecle <ESC> p/ sair", ;
      "Digite o Estoque atual ou tecle <ESC> p/ sair", ;
      "Digite o Estoque minimo ou tecle <ESC> p/ sair", ;
      "Digite o Ultimo preco de compra ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do ICMS ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do IPI ou tecle <ESC> p/ sair", ;
      "Digite o Estoque Real ou tecle <ESC> p/ sair"}
   private xco_mp, xde_mp, xco_unid, xest_mp_at, xest_mp_mi, xult_p_mp
   private xali_ipi, xali_icms, xest_mp_ma
   private xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   tela_mp()
   select MP_R
   set order to 1
   do while (.T.)
      sinal("CONSULTA", "MAT. PRIMA")
      xco_mp:= Space(4)
      ini_mp()
      set color to (cor[3])
      setcursor(1)
      @  5, 20 get XCO_MP picture "@K 9999" valid ;
         localiza(stz(@xco_mp), "MP_R", 1, "M") when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(xcursor)
         return
      endif
      do while (.T.)
         sinal("CONSULTA", "MAT. PRIMA")
         set color to 
         lin_nave()
         trans_mp()
         set color to (cor[3])
         @  5, 20 get XCO_MP picture "9999" when mens_when(mens1[7])
         get_mp()
         readkill(.T.)
         getlist:= {}
         set color to 
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            limpa_mp()
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC262ALT")
            sinal("ALTERA", "MAT. PRIMA")
            @ 23,  0 clear
            if (!reclock(5))
               loop
            endif
            trans_mp()
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               get_mp()
               read
               set color to 
               setcursor(0)
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_mp_r()
                  unlock
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC262EXC")
            sinal("EXCLUI", "MAT. PRIMA")
            @ 23,  0 clear
            if (excluir())
               if (!reclock(5))
                  loop
               endif
               delete
               unlock
               skip 
               skip -1
            endif
         endcase
         @ 23,  0 clear
      enddo
      limpa_mp()
   enddo
   return

********************************
function NUC27225(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3
   if (Local1 == 27)
      Local2:= 0
   endif
   return Local2

********************************
procedure LIM_VEND2

   set color to (cor[12])
   @ 15,  1 clear to 19, 71
   set color to 
   return

********************************
procedure NUC263

   local Local1
   private mens:= {"Codigo do Produto a ser produzido", ;
      "Codigo da Materia Prima utilizada no produto", ;
      "Quantidade da Materia Prima utilizada no produto"}
   private xco_prod, xco_mp, xqt_mp_u, xl:= 3, xc:= 0, xcursor:= ;
      setcursor()
   Local1:= savescr(3, 0, 24, 79)
   sinal("MANUTENC", "FORMULA")
   mp_r->(dbSetOrder(1))
   do while (.T.)
      set color to 
      Scroll(23, 0, 24, 79)
      set color to (cor[12])
      Scroll(4, 1, 21, 78)
      set color to (cor[1])
      window(xl + 1, xc + 1, xl + 3, xc + 76, "Ŀ ", .T.)
      @ xl + 2, xc + 3 say "Codigo do Produto....:"
      xco_prod:= Space(4)
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 27 get xco_prod picture "@k 9999" valid ;
         localiza(stz(@xco_prod), "PROD_ACA", 1, "M", ;
         "DE_PROD+[           ]+CO_UNID", xl + 2, xc + 32) when ;
         mens_when(mens[1])
      read
      set color to (cor[1])
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restscr(Local1)
         return
      endif
      select FORMULA
      set order to 1
      seek Trim(xco_prod)
      if (EOF())
         tone(800, 5)
         ms250("Nao existe formula cadastrada para este produto. Tecle [ESC] p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      xarq_form:= copy_temp({|| xco_prod = formula->co_prod})
      use (xarq_form) alias TEMP new
      if (.T.)
         set relation to
      endif
      set relation to TEMP->co_mp into MP_R
      xvet_campo:= {"P263_1()"}
      xvet_titul:= ;
         {" Cod.   Descricao da Materia Prima       Qtd. Utilizada            Valor "}
      window(7, 1, 18, 76, "Ŀ ", .T.)
      ms250("[ENTER] Altera         [Delete] Exclui         [ESC] Termina", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      p263_3()
      temp->(dbGoTop())
      dbedit(8, 2, 17, 75, xvet_campo, "P263_2", .T., xvet_titul)
      temp->(dbCloseArea())
      erase (xarq_form)
   enddo

********************************
function OPEN_TPREC

   if (!file("TAB_PREC.DBF"))
      dbcreate("TAB_PREC.DBF", {{"mes_ref   ", "C", 5, 0}, ;
         {"co_prod   ", "C", 4, 0}, {"val_mp    ", "N", 12, 2}, ;
         {"val_prod  ", "N", 12, 2}, {"val_custo ", "N", 12, 2}, ;
         {"val_fatu  ", "N", 12, 2}, {"pd_mensal ", "N", 8, 0}, ;
         {"per_frete ", "N", 4, 1}, {"per_lucro ", "N", 4, 1}, ;
         {"per_comiss", "N", 4, 1}})
   endif
   if (!file("TAB_PRE1.NTX") .OR. !file("TAB_PRE2.NTX"))
      if (!netuse("TAB_PREC", Nil, "E", "NEW", 5))
         return .F.
      else
         pack
         index on ma_to_s(MES_REF)+CO_PROD to TAB_PRE1
         index on CO_PROD+ma_to_s(MES_REF) to TAB_PRE2
         closedata("TAB_PREC")
      endif
   endif
   if (!netuse("TAB_PREC", Nil, "S", "NEW", 5))
      return .F.
   endif
   set index to TAB_PRE1, TAB_PRE2
   return .T.

********************************
function P263_2(Arg1, Arg2)

   local Local1:= strzero(LastKey(), 2), Local2:= savescr(Row(), 1, ;
      Row(), 78), Local3:= savescr(23, 0, 24, 79), Local4:= 1
   if (!(Local1 $ "13/27/07") .OR. Arg1 = 0)
      return 1
   endif
   set color to (cor[1])
   setcursor(1)
   if (Local1 = "27")
      Local4:= 0
   elseif (Local1 = "13" .AND. acesso("NUC263ALT"))
      xtela_dbed:= savescr(4, 1, 20, 78)
      @ 23,  0 clear
      formula->(dbGoto(temp->recno))
      trans_fpr()
      Local4:= 3
      if (!formula->(reclock(5)))
         mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
            27)
         Local4:= 1
      else
         set color to (cor[12])
         Scroll(4, 1, 21, 78)
         tel_fpr()
         @  5, 27 get xco_prod picture "@k 9999"
         @  6, 27 get xco_mp picture "@k 9999"
         readkill(.T.)
         getlist:= {}
         localiza(stz(@xco_prod), "PROD_ACA", 1, "M", ;
            "DE_PROD+[ ]+CO_UNID", 5, 32)
         localiza(stz(@xco_mp), "MP_R", 1, "M", "DE_MP+[ ]+CO_UNID", ;
            6, 32)
      endif
      do while (Local4 = 3)
         setcursor(1)
         set color to (cor[3])
         @  7, 27 get xqt_mp_u picture "@E 99,999.999999" valid ;
            xqt_mp_u > 0 when mens_when(mens[3])
         read
         setcursor(1)
         set color to 
         if (LastKey() = K_ESC .OR. !updated())
            exit
         endif
         @ 23,  0 clear
         gra()
         if (gra = "A")
            loop
         elseif (gra = "G")
            grava_fpr()
            replace temp->qt_mp_u with xqt_mp_u
            p263_3()
         endif
         formula->(dbUnlock())
         exit
      enddo
      restscr(xtela_dbed)
      Local4:= 1
   elseif (Local1 = "07" .AND. acesso("NUC263EXC"))
      @ 23,  0 clear
      formula->(dbGoto(temp->recno))
      trans_fpr()
      if (excluir())
         if (!formula->(reclock(5)))
            mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
               27)
            Local4:= 1
         else
            formula->(dbDelete())
            temp->(dbDelete())
            p263_3()
            Local4:= 2
            skip 
            skip -1
         endif
      endif
   endif
   restscr(Local3)
   return Local4

********************************
procedure NUC26722

   local Local1:= savescr(11, 26, 14, 54), Local2:= Space(4), ;
      Local3:= SetColor(), Local4:= Len(vet_lin), Local5, Local6:= ;
      savescr(23, 0, 24, 79)
   setcursor(1)
   set color to (cor[12])
   window(11, 26, 13, 53, "Ŀ ", .T.)
   @ 12, 28 say "Codigo do Produto :" get xco_prod picture "9999" ;
      valid localiza(stz(@Local2), "PROD_ACA", 1, "M") when ;
      mens_when("Digite o codigo para marcar os pedidos que venderam este produto")
   read
   if (LastKey() == K_ESC)
      for Local5:= 1 to Local4
         vet_lin[Local5]:= "  " + SubStr(vet_lin[Local5], 3)
      next
   else
      item_ver->(dbSetOrder(1))
      for Local5:= 1 to Local4
         vet_lin[Local5]:= "  " + SubStr(vet_lin[Local5], 3)
         xnr_ped:= SubStr(vet_lin[Local5], 4, 6)
         item_ver->(dbSeek(xnr_ped))
         do while (item_ver->nr_ped = xnr_ped)
            if (item_ver->co_prod = Local2)
               vet_lin[Local5]:= " " + SubStr(vet_lin[Local5], 3)
               exit
            endif
            item_ver->(dbSkip(1))
         enddo
      next
   endif
   restscr(Local1)
   restscr(Local6)
   set color to (Local3)
   setcursor(0)
   return

********************************
static function LOAD_PED

   return " " + nr_ped + "     " + DToC(dt_ped) + "   " + nr_nf + ;
      "   " + SubStr(forneced->nome_fo, 1, 30) + " "

********************************
procedure NUC264

   local Local1
   private mens:= {"Codigo do Produto Acabado", "Codigo do Setor", ;
      "Data da Producao", "Quantidade Produzida"}
   private xco_prod, xco_set, xdt_prod, xqt_prod, xl:= 3, xc:= 0, ;
      xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRA", "PRODUCAO")
   tel_prd()
   do while (.T.)
      ini_prd()
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 24 get xco_prod picture "@k 9999" valid ;
         localiza(stz(@xco_prod), "PROD_ACA", 1, "M", ;
         "DE_PROD+[ ]+CO_UNID", xl + 2, xc + 29) when ;
         mens_when(mens[1])
      @ xl + 3, xc + 24 get xco_set picture "@k 999" valid ;
         localiza(stz(@xco_set), "TAB_SET", 1, "M", "DESCRICAO", xl ;
         + 3, xc + 29) .OR. sb() when mens_when(mens[2])
      @ xl + 4, xc + 24 get xdt_prod valid !Empty(xdt_prod) .AND. ;
         xdt_prod <= Date() .OR. sb() when mens_when(mens[3])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      select PRODUCAO
      set order to 1
      goto top
      if (LastRec() == 0)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      if (Empty(xco_prod))
         xco_prod:= co_prod
         xco_set:= co_set
         xdt_prod:= dt_prod
      endif
      if (Empty(xdt_prod))
         seek xco_prod
      else
         set softseek on
         seek xco_prod + xco_set + DToS(xdt_prod)
         set softseek off
      endif
      do while (.T.)
         sinal("CONSULTA", "PRODUCAO")
         set color to 
         lin_nave()
         trans_prd()
         setcursor(1)
         set color to (cor[3])
         @ xl + 2, xc + 24 get xco_prod picture "9999" valid ;
            localiza(xco_prod, "PROD_ACA", 1, "M", ;
            "DE_PROD+[ ]+CO_UNID", xl + 2, xc + 29) when ;
            mens_when(mens[1])
         @ xl + 3, xc + 24 get xco_set picture "999" valid ;
            localiza(xco_set, "TAB_SET", 1, "M", "DESCRICAO", xl + ;
            3, xc + 29) .OR. sb() when mens_when(mens[2])
         @ xl + 4, xc + 24 get xdt_prod valid !Empty(xdt_prod) .AND. ;
            xdt_prod <= Date() .OR. sb() when mens_when(mens[3])
         @ xl + 5, xc + 24 get xqt_prod picture "@E999,999.99" valid ;
            xqt_prod > 0 .OR. sb() when mens_when(mens[4])
         keyboard Chr(13) + Chr(13) + Chr(13) + Chr(13)
         read
         setcursor(0)
         set color to 
         lin_nave()
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            limpa_prd()
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC264ALT")
            sinal("ALTERA", "PRODUCAO")
            @ 23,  0 clear
            if (!reclock(5))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            xqt_ant:= producao->qt_prod
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               @ xl + 5, xc + 24 get xqt_prod picture "@E999,999.99" ;
                  valid xqt_prod > 0 .OR. sb() when mens_when(mens[4])
               read
               setcursor(1)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  select PROD_ACA
                  seek xco_prod
                  if (!reclock(5))
                     mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                        27)
                     loop
                  endif
                  select MP_R
                  set order to 1
                  if (!fillock(5))
                     mensagem("Nao foi possivel a gravacao destes dados. [ESC] continua", ;
                        27)
                     loop
                  else
                     select PROD_ACA
                     replace prod_aca->est_atu with ;
                        prod_aca->est_atu + (xqt_prod - xqt_ant)
                     select FORMULA
                     set order to 1
                     seek xco_prod
                     do while (xco_prod = formula->co_prod)
                        mp_r->(dbSeek(formula->co_mp))
                        replace mp_r->est_mp_int with ;
                           mp_r->est_mp_int + formula->qt_mp_u * ;
                           xqt_ant
                        replace mp_r->est_mp_int with ;
                           mp_r->est_mp_int - formula->qt_mp_u * ;
                           xqt_prod
                        skip 
                     enddo
                     select PRODUCAO
                     grava_prd()
                     unlock all
                  endif
               endif
               unlock all
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC264EXC")
            sinal("EXCLUI", "PRODUCAO")
            if (!reclock(5))
               mensagem("Registro nao pode ser excluido. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            @ 23,  0 clear
            if (excluir())
               select PROD_ACA
               seek xco_prod
               if (!reclock(5))
                  mensagem("Nao foi possivel excluir o registro acima. [ESC] continua", ;
                     27)
                  unlock all
                  loop
               endif
               select MP_R
               set order to 1
               if (!fillock(5))
                  mensagem("Nao foi possivel excluir o registro acima. [ESC] continua", ;
                     27)
                  unlock all
                  loop
               else
                  select PROD_ACA
                  replace prod_aca->est_atu with prod_aca->est_atu - ;
                     xqt_prod
                  select FORMULA
                  set order to 1
                  seek xco_prod
                  do while (xco_prod = formula->co_prod)
                     mp_r->(dbSeek(formula->co_mp))
                     replace mp_r->est_mp_int with mp_r->est_mp_int ;
                        + formula->qt_mp_u * producao->qt_prod
                     skip 
                  enddo
                  select PRODUCAO
                  delete
                  unlock all
               endif
               skip 
               skip -1
            endif
            limpa_prd()
            @ 23,  0 clear
         endcase
      enddo
   enddo
   return

********************************
procedure NUC271

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {14, 42, " Pedidos          ", ;
      padc("Consulta Pedidos Abertos/Fechados", 80)})
   AAdd(Local1, {15, 42, " Baixa de Pedidos ", ;
      padc("Baixa de Pedidos em aberto", 80)})
   save screen to Local2
   sinal("SUB-MENU", "COMPRAS")
   m_compras:= 1
   do while (.T.)
      set color to (cor[16])
      window(13, 41, 16, 60, "Ŀ ", .T.)
      m_compras:= menu_prt(Local1, m_compras, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (m_compras = 1)
         if (acesso("NUC2711"))
            nuc2711()
         endif
      elseif (m_compras = 2)
         if (acesso("NUC2712"))
            nuc2712()
         endif
      elseif (m_compras = 0)
         commit
         restore screen from Local2
         return
      endif
   enddo
   return

********************************
procedure NUC265

   local Local1
   private mens:= {"Codigo do custo geral de fabricacao (CGF)", ;
      "Codigo do Setor", "Mes e Ano que ocorreu o custo", ;
      "Valor do custo geral de fabricacao"}
   private xco_custo, xco_set, xmes_ano, xval_custo, xl:= 3, xc:= 0, ;
      xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONUSULTA", "C. G. F.")
   tel_cgf()
   do while (.T.)
      ini_cgf()
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 23 get xco_custo picture "@k 999" valid ;
         localiza(stz(@xco_custo), "TAB_CGF", 1, "M", "DESCRICAO", ;
         xl + 2, xc + 28) when mens_when(mens[1])
      @ xl + 3, xc + 23 get xco_set picture "@k 999" valid ;
         localiza(stz(@xco_set), "TAB_SET", 1, "M", "DESCRICAO", xl ;
         + 3, xc + 28) .OR. sb() when mens_when(mens[2])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      select CUSTO_GF
      set order to 1
      goto top
      if (LastRec() == 0)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      if (Empty(xco_custo))
         xco_custo:= co_custo
         xco_set:= co_set
      endif
      seek xco_custo + xco_set
      do while (.T.)
         sinal("CONSULTA", "C. G. F.")
         set color to 
         lin_nave()
         trans_cgf()
         setcursor(1)
         set color to (cor[3])
         @ xl + 2, xc + 23 get xco_custo picture "999"
         @ xl + 3, xc + 23 get xco_set picture "999"
         @ xl + 4, xc + 23 get xmes_ano picture "99/99"
         @ xl + 5, xc + 23 get xval_custo picture "@E 999,999.99"
         readkill(.T.)
         getlist:= {}
         set color to (cor[1])
         @ xl + 2, xc + 28 clear to xl + 2, xc + 55
         @ xl + 3, xc + 28 clear to xl + 3, xc + 55
         localiza(xco_custo, "TAB_CGF", 1, "M", "DESCRICAO", xl + 2, ;
            xc + 28)
         localiza(xco_set, "TAB_SET", 1, "M", "DESCRICAO", xl + 3, ;
            xc + 28)
         setcursor(0)
         set color to 
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            limpa_prd()
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC266ALT")
            sinal("ALTERA", "C. G. F.")
            @ 23,  0 clear
            if (!reclock(5))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               @ xl + 4, xc + 23 get xmes_ano picture "99/99" valid ;
                  val_ma(xmes_ano) .OR. sb() when mens_when(mens[3])
               @ xl + 5, xc + 23 get xval_custo picture ;
                  "@E 999,999.99" valid xval_custo > 0 when ;
                  mens_when(mens[4])
               read
               setcursor(1)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  grava_cgf()
                  unlock
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC266EXC")
            sinal("EXCLUI", "C. G. F.")
            @ 23,  0 clear
            if (excluir())
               if (!reclock(5))
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  loop
               endif
               delete
               unlock
            endif
            skip 
            skip -1
         endcase
      enddo
      limpa_cgf()
      @ 23,  0 clear
   enddo
   return

********************************
function NUC26721(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3
   if (Local1 = 27)
      Local2:= 0
      loop_achoi:= .F.
   elseif (Local1 = -7)
      Local3:= savescr(3, 0, 24, 79)
      set color to (cor[12])
      @  3,  0 to 22, 79
      set color to 
      nuc27211(SubStr(vet_lin[Arg2], 4, 6), "NUC365")
      restscr(Local3)
      set color to (cor[1])
   elseif (Local1 = -9)
      nuc26722()
      Local2:= 0
   endif
   ms250("Total de caixas : " + alltrim(Transform(xtotal_cai, ;
      "@E 999,999,999.99")) + "     Peso : " + ;
      alltrim(Transform(xtotal_pes, "@E 999,999.99")) + ;
      "     Valor : " + alltrim(Transform(xtotal_val, ;
      "@E 999,999,999.99")), 23, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   return Local2

********************************
procedure LIM_VEND1

   set color to (cor[1])
   @  5, 20 clear to  5, 69
   @  6, 20 clear to  6, 42
   @  6, 60 clear to  6, 69
   @  7, 20 clear to 11, 69
   set color to 
   return

********************************
procedure NUC266

   local Local1
   private mens:= {"Codigo do Materia Prima", "Codigo do Setor", ;
      "Data do Movimento", "Quantidade Movimentada"}
   private xco_mp, xco_set, xdt_mp, xqt_mp, xl:= 3, xc:= 0, ;
      xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "MOV. M.P.")
   tel_mmp()
   do while (.T.)
      ini_mmp()
      limpa_mmp()
      setcursor(1)
      set color to (cor[3])
      @ xl + 2, xc + 24 get xco_MP picture "@K 9999" valid ;
         localiza(stz(@xco_mp), "MP_R", 1, "M", "DE_MP+[ ]+CO_UNID", ;
         xl + 2, xc + 29) when mens_when(mens[1])
      @ xl + 3, xc + 24 get xco_set picture "@K 999" valid ;
         localiza(stz(@xco_set), "TAB_SET", 1, "M", "DESCRICAO", xl ;
         + 3, xc + 29) .OR. sb() when mens_when(mens[2])
      @ xl + 4, xc + 24 get xdt_MP valid !Empty(xdt_mp) .AND. xdt_mp ;
         <= Date() .OR. sb() when mens_when(mens[3])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      select MP_INT
      set order to 1
      goto top
      if (LastRec() == 0)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      if (Empty(xco_mp))
         xco_mp:= co_mp
         xco_set:= co_set
         xdt_mp:= dt_mp
      endif
      if (Empty(xdt_mp))
         seek xco_mp
      else
         set softseek on
         seek xco_mp + xco_set + DToS(xdt_mp)
         set softseek off
      endif
      do while (.T.)
         sinal("CONSULTA", "MOV. M.P.")
         set color to 
         lin_nave()
         trans_mmp()
         setcursor(1)
         set color to (cor[3])
         @ xl + 2, xc + 24 get xco_MP picture "9999" valid ;
            localiza(xco_mp, "MP_R", 1, "M", "DE_MP+[ ]+CO_UNID", xl ;
            + 2, xc + 29) when mens_when(mens[1])
         @ xl + 3, xc + 24 get xco_set picture "999" valid ;
            localiza(xco_set, "TAB_SET", 1, "M", "DESCRICAO", xl + ;
            3, xc + 29) .OR. sb() when mens_when(mens[2])
         @ xl + 4, xc + 24 get xdt_MP valid !Empty(xdt_mp) .AND. ;
            xdt_mp <= Date() .OR. sb() when mens_when(mens[3])
         @ xl + 5, xc + 24 get xqt_MP picture "@E999,999.99" valid ;
            xqt_mp > 0 .OR. sb() when mens_when(mens[4])
         keyboard Chr(13) + Chr(13) + Chr(13) + Chr(13)
         read
         setcursor(0)
         set color to 
         lin_nave()
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            limpa_prd()
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC266ALT")
            sinal("ALTERA", "MOV. M.P.")
            @ 23,  0 clear
            if (!(mp_int->(reclock(5)) .AND. mp_r->(reclock(5))))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               unlock all
               loop
            endif
            xqt_ant:= mp_int->qt_mp
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               @ xl + 5, xc + 24 get xqt_MP picture "@E999,999.99" ;
                  valid xqt_mp > 0 .OR. sb() when mens_when(mens[4])
               read
               setcursor(1)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  replace mp_int->qt_mp with xqt_mp
                  replace mp_r->est_mp_int with mp_r->est_mp_int + ;
                     (xqt_mp - xqt_ant)
                  replace mp_r->est_mp_max with mp_r->est_mp_max - ;
                     (xqt_mp - xqt_ant)
                  unlock all
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC266EXC")
            sinal("EXCLUI", "MOV. M.P.")
            if (!(mp_int->(reclock(5)) .AND. mp_r->(reclock(5))))
               mensagem("Registro nao pode ser excluido. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            @ 23,  0 clear
            if (excluir())
               mp_int->(dbDelete())
               replace mp_r->est_mp_int with mp_r->est_mp_int - xqt_mp
               replace mp_r->est_mp_max with mp_r->est_mp_max + xqt_mp
               skip -1
               skip 
               unlock all
            endif
            limpa_mmp()
            @ 23,  0 clear
         endcase
      enddo
   enddo
   return

********************************
static procedure CALC_03

   tone(1800, 3)
   ms250("Calculando o valor gasto com Custo Geral de Fabricacao no mes anterior", ;
      24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
   xcgf_mensa:= 0
   xmes_prod:= descend(ma_to_s(d_to_ma(xmes_prod)))
   tab_cgf->(dbGoTop())
   do while (!tab_cgf->(EOF()))
      custo_gf->(dbSeek(tab_cgf->codigo + "000" + xmes_prod))
      xcgf_mensa:= xcgf_mensa + custo_gf->val_custo
      tab_cgf->(dbSkip())
   enddo
   return

********************************
function LIMP_LOC

   set color to (cor[1])
   @  5, 30 clear to  5, 69
   set color to 
   return .T.

********************************
procedure NUC268

   private xval_mp, xmes_prod, xval_mp_me, xcgf_mensa, xpd_mensal, ;
      xtela2
   private xmes_ano:= "     "
   do while (.T.)
      if (!open_tprec())
         tone(800, 6)
         if ;
               (ms250("Nao foi possivel abrir arquivo de precos. Deseja tentar novamente (S/N) ? ", ;
               24, 0, cor[6], cor[7], {78, 83}, Nil, 80, "c") == 83)
            loop
         else
            return
         endif
      endif
      exit
   enddo
   xtela2:= savescr(8, 42, 11, 64)
   sinal("RELATORIO", "TAB.PRECOS")
   set color to (cor[3])
   window(8, 42, 10, 60, "ͻȺ ", .T.)
   do while (.T.)
      set color to (cor[3])
      xmes_ano:= Space(5)
      @  9, 44 say "Mes/Ano :" get xmes_ano picture "99/99" valid ;
         val_ma(xmes_ano) when ;
         mens_when("Digite o Mes e Ano para calculo da Tabela " + ;
         "de Precos, ou [ESC] para sair.")
      read
      if (LastKey() == K_ESC)
         closedata("TAB_PREC")
         restscr(xtela2)
         return
      endif
      tab_prec->(dbSeek(ma_to_s(xmes_ano)))
      if (!tab_prec->(EOF()))
         tone(800, 6)
         if (ms250("Tabela referente a " + xmes_ano + ;
               " ja calculada. Calcular novamente (S/N) ? ", ;
               24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") == 78)
            loop
         endif
      endif
      if (!prod_aca->(fillock(5)))
         tone(800, 5)
         ms250("Os arquivos nao estao disponiveis para esta operacao. Tecle [ESC] p/ cancelar.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      xmes_prod:= CToD("01/" + add_ma(xmes_ano, -1))
      calc_05()
      calc_01()
      calc_02()
      calc_03()
      calc_04()
      unlock all
      nuc3671()
   enddo
   set color to 
   @ 23,  0 clear

********************************
procedure NUC3162

   local Local1
   Local1:= .F.
   nome_rel:= "Relatorio de Clientes Dividido por Estado"
   set device to printer
   setprc(62, 0)
   select CLIENTES
   set order to 8
   goto top
   do while (!EOF())
      select CLIENTES
      set order to 8
      xest_cl:= est_cl
      do while (clientes->est_cl = xest_cl)
         imp_cli316()
         select CLIENTES
         skip 
         if (InKey() == K_ESC)
            if (cancel_rel())
               set device to printer
               Local1:= .T.
               exit
            endif
         endif
      enddo
      @ 62,  5 say ""
      if (Local1)
         exit
      endif
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC317A1

   @ 23,  0 clear
   aviso(24, "Aguarde... imprimindo relatorio solicitado.")
   nome_rel:= "Relatorio de Clientes por Vendedor"
   set device to printer
   if (PRow() != 0)
      eject
   endif
   select CLIENTES
   set order to 7
   seek xcod_vend + iif(Empty(xest_cl), "", xest_cl)
   do while (clientes->cod_vend = xcod_vend)
      if (!Empty(xest_cl))
         if (clientes->est_cl != xest_cl)
            clientes->(dbSkip())
            loop
         endif
      endif
      imp_cli317()
      select CLIENTES
      skip 
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
   enddo
   @ PRow(), PCol() + 1 say "  P"
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure CX

   if (niv_oper = "3")
      xcx2:= !xcx2
      insovr(.T.)
   endif

********************************
static procedure NUC3671

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7
   Local3:= {}
   select IMPOSTOS
   Local1:= 0
   DBEval({|| Local1:= Local1 + 1})
   if (file("ALIQUOTA.MEM"))
      restore from ALIQUOTA.MEM additive
   else
      private xali_lucro, xali_comis, xali_frete
      xali_lucro:= xali_frete:= xali_comis:= 0
   endif
   Local5:= 10
   Local6:= 22
   Local2:= savescr(Local5, Local6, Local5 + 7, Local6 + 37)
   set color to (cor[8])
   window(Local5, Local6, Local5 + 6, Local6 + 35, "Ŀ ", .T.)
   @ Local5 + 1, Local6 + 2 say "Percentual de LUCRO......:" get ;
      xAli_lucro picture "@E 99.99"
   @ Local5 + 3, Local6 + 2 say "Percentual de FRETE......:" get ;
      xAli_frete picture "@E 99.99"
   @ Local5 + 5, Local6 + 2 say "Percentual de COMISSAO...:" get ;
      xAli_comissao picture "@E 99.99"
   read
   save all like xAli_* to ALIQUOTA.MEM
   restscr(Local2)
   select IMPOSTOS
   goto top
   linha1:= ;
      "+--------------------------------------------------------------------------------------"
   linha2:= ;
      "| MERCADORIAS                    | UN |  FATURAMENTO  |        CUSTO  |       LUCRO   |"
   linha3:= ;
      "|                                |    |               |               | " ;
      + padl(Transform(xali_lucro, "@E 99.99"), 12) + "  |"
   linha4:= ;
      "|--------------------------------+----+---------------+---------------+---------------+"
   do while (!EOF())
      linha1:= linha1 + Replicate("-", 16)
      linha2:= linha2 + (" " + padl(Trim(impostos->co_impos), 12) + ;
         "  |")
      linha3:= linha3 + (" " + padl(Transform(impostos->ali_impos, ;
         "@E 99.99"), 12) + "  |")
      linha4:= linha4 + "---------------+"
      dbSkip()
   enddo
   linha1:= linha1 + ;
      "------------------------------------------------------------------------------+"
   linha2:= linha2 + ;
      "   SUB. TOTAL  |        FRETE  |   SUB. TOTAL  |     COMISSAO  |        TOTAL |"
   linha3:= linha3 + ("               | " + ;
      padl(Transform(xali_frete, "@E 99.99"), 12) + "  |" + ;
      "               |" + " " + padl(Transform(xali_comis, ;
      "@E 99.99"), 12) + "  |" + "              |")
   linha4:= linha4 + ;
      "---------------+---------------+---------------+---------------+--------------|"
   pg:= 0
   nome_rel:= ;
      "T   A   B   E   L   A       D   E       P   R   E   C   O   S      /      " ;
      + xmes_ano
   tone(1800, 3)
   if ;
         (ms250("Deseja imprimir a tabela que esta sendo calculada (S/N) ? ", ;
         24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "C") == 83)
      set printer to (i_m_p_r_ee)
      tone(1800, 3)
      ms250("Gerando e Imprimindo Tabela de Precos, aguarde por favor.", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
   else
      set printer to lixo.txt
      tone(1800, 3)
      ms250("Gerando Tabela de Precos, aguarde por favor.", 24, 0, ;
         cor[4], cor[5], Nil, Nil, 80, "c")
   endif
   set device to printer
   nuc3672()
   select PROD_ACA
   set order to 2
   goto top
   do while (!EOF())
      if (PRow() > 56)
         nuc3672()
      endif
      @ PRow() + 1,  0 say "|"
      @ PRow(),  2 say prod_aca->de_prod
      @ PRow(), 33 say "|"
      @ PRow(), 35 say prod_aca->co_unid
      @ PRow(), 38 say "|"
      @ PRow(), 40 say prod_aca->val_fatu picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say prod_aca->val_custo picture ;
         "@E 999,999.9999"
      xtotal:= prod_aca->val_custo
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say prod_aca->val_custo * (xali_lucro / ;
         100) picture "@E 999,999.9999"
      xtotal:= xtotal + prod_aca->val_custo * (xali_lucro / 100)
      @ PRow(), PCol() + 2 say "|"
      impostos->(dbGoTop())
      do while (!impostos->(EOF()))
         @ PRow(), PCol() + 1 say prod_aca->val_fatu * ;
            (impostos->ali_impos / 100) picture "@E 999,999.9999"
         xtotal:= xtotal + prod_aca->val_fatu * (impostos->ali_impos ;
            / 100)
         @ PRow(), PCol() + 2 say "|"
         impostos->(dbSkip())
      enddo
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal * (xali_frete / 100) picture ;
         "@E 999,999.9999"
      xtotal:= xtotal + xtotal * (xali_frete / 100)
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal * (xali_comis / 100) picture ;
         "@E 999,999.9999"
      xtotal:= xtotal + xtotal * (xali_comis / 100)
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 1 say "|"
      AAdd(Local3, {prod_aca->co_prod, xtotal})
      prod_aca->(dbSkip())
   enddo
   @ PRow() + 1,  0 say linha1
   eject
   set device to screen
   do while (.T.)
      select TAB_PREC
      set order to 1
      if (!fillock(5))
         tone(880, 5)
         if ;
               (ms250("Nao foi possivel gravar tabela de precos. Deseja tentar novamente (S/N) ? ", ;
               24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") == 83)
            loop
         else
            return
         endif
      endif
      exit
   enddo
   tone(880, 5)
   xatualizar:= ;
      ms250("Deseja atualizar os precos conforme tabela calculada (S/N) ? ", ;
      24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") = 83
   tone(1800, 3)
   ms250("Gravando Tabela de Precos, aguarde por favor.", 24, 0, ;
      cor[4], cor[5], Nil, Nil, 80, "c")
   do while (.T.)
      select PROD_ACA
      set order to 1
      tone(880, 5)
      if (xatualizar .AND. !fillock(5))
         if ;
               (ms250("Nao sera possivel atualizar os precos atuais. Deseja tentar novamente (S/N) ? ", ;
               24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") == 83)
            loop
         else
            xatualizar:= .F.
         endif
      endif
      xmes_str:= ma_to_s(xmes_ano)
      Local7:= Len(Local3)
      for Local4:= 1 to Local7
         prod_aca->(dbSeek(Local3[Local4][1]))
         if (xatualizar)
            replace prod_aca->val_prod with Local3[Local4][2]
         endif
         tab_prec->(dbSeek(xmes_str + prod_aca->co_prod))
         if (tab_prec->(EOF()))
            tab_prec->(dbAppend())
            replace tab_prec->mes_ref with xmes_ano
            replace tab_prec->co_prod with prod_aca->co_prod
         endif
         replace tab_prec->val_prod with Local3[Local4][2]
         replace tab_prec->val_mp with prod_aca->val_mp
         replace tab_prec->val_custo with prod_aca->val_custo
         replace tab_prec->val_fatu with prod_aca->val_fatu
         replace tab_prec->pd_mensal with prod_aca->pd_mensal
         replace tab_prec->per_comiss with xali_comis
         replace tab_prec->per_frete with xali_frete
         replace tab_prec->per_lucro with xali_lucro
      next
      unlock all
      exit
   enddo
   return

********************************
procedure NUC269

   local Local1
   private cco_mp, nqtd_mp, ctipo_mov, cco_set, crefer, ddt_mov_mp
   private mp2:= ;
      {"Digite o Codigo da Materia Prima, ou tecle [ESC] para sair", ;
      "Digite o Codigo do Setor da Materia Prima ", ;
      "Digite a Data de Movimento da Materia Prima", ;
      "Digite a Quantidade de Materia Prima", ;
      "Digite a Referencia da Materia Prima", ;
      "Digite se o Tipo de Movimento e de Entrada ou Saida de Materia Prima"}
   private xcursor:= setcursor()
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "ESTOQUE M. P.")
   set date british
   set century on
   set color to (cor[1])
   tela_mp2()
   mp_r->(dbSetOrder(1))
   do while (.T.)
      ini_mp2()
      set color to (cor[1])
      @  5, 25 clear to 15, 69
      set color to 
      setcursor(1)
      set color to (cor[3])
      @  5, 25 get cCO_MP picture "@k 9999" valid limp_loc() .AND. ;
         localiza(stz(@cco_mp), "MP_R", 1, "M", ;
         "trim(substr(DE_MP,01,30))+[ ]+CO_UNID", 5, 30, cor[2]) ;
         when mens_when(mp2[1])
      @  7, 25 get cCO_SET picture "@k 999" valid ;
         localiza(stz(@cco_set), "TAB_SET", 1, "M", "DESCRICAO", 7, ;
         30, cor[2], Nil, .F.) .OR. sb() when mens_when(mp2[2])
      @  9, 25 get dDT_MOV_MP valid ddt_mov_mp <= Date() .OR. sb() ;
         when mens_when(mp2[3])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      select MOV_MP
      set order to 1
      goto top
      if (LastRec() == 0)
         setcursor(xcursor)
         restore screen from Local1
         return
      endif
      if (Empty(cco_mp))
         cco_mp:= co_mp
         cco_set:= co_set
         ddt_mov_mp:= dt_mov_mp
      endif
      if (Empty(ddt_mov_mp))
         seek cco_mp
      else
         set softseek on
         seek cco_mp + cco_set + DToS(ddt_mov_mp)
         set softseek off
      endif
      if (mov_mp->(EOF()) .OR. mov_mp->co_mp != cco_mp)
         ms250("Nao existe nenhum Movimento de Estoque para esta Materia Prima, tecle [ESC]", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      do while (.T.)
         sinal("CONSULTA", "ESTOQUE M.P.")
         set color to 
         lin_nave()
         trans_mp2()
         cco_mp:= mov_mp->co_mp
         cco_set:= mov_mp->co_set
         set color to 
         setcursor(1)
         set color to (cor[3])
         get_mp2()
         readkill(.T.)
         getlist:= {}
         set color to (cor[1])
         @  5, 30 clear to  7, 69
         set color to 
         mp_r->(dbSetOrder(1))
         localiza(stz(@cco_mp), "MP_R", 1, "M", ;
            "trim(substr(DE_MP,01,30))+[ ]+CO_UNID", 5, 30, cor[2], ;
            Nil, .F.)
         localiza(stz(@cco_set), "TAB_SET", 1, "M", "DESCRICAO", 7, ;
            30, cor[2], Nil, .F.)
         setcursor(0)
         set color to 
         lin_nave()
         xtec:= InKey(0)
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            @ 23,  0 clear
            exit
         case xtec = -1 .AND. acesso("NUC269ALT")
            sinal("ALTERA", "ESTOQUE M.P.")
            @ 23,  0 clear
            do while (acesso("NUC269ALT"))
               setcursor(1)
               set color to (cor[3])
               get_mp2("M")
               read
               setcursor(1)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  mp_r->(dbSeek(cco_mp))
                  if (mp_r->(reclock(5)) .AND. mov_mp->(reclock(5)))
                     if (ctipo_mov = "E")
                        replace mp_r->est_mp_at with mp_r->est_mp_at ;
                           + (nqtd_mp - mov_mp->qtd_mp)
                     else
                        replace mp_r->est_mp_at with mp_r->est_mp_at ;
                           - (nqtd_mp - mov_mp->qtd_mp)
                     endif
                  else
                     mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                        27)
                     unlock all
                     loop
                  endif
                  grava_mp2()
                  unlock all
               endif
               exit
            enddo
         case xtec = -2 .AND. acesso("NUC269EXC")
            sinal("EXCLUI", "ESTOQUE M.P.")
            @ 23,  0 clear
            if (excluir())
               mp_r->(dbSeek(cco_mp))
               if (mp_r->(reclock(5)) .AND. mov_mp->(reclock(5)))
                  if (ctipo_mov = "E")
                     replace mp_r->est_mp_at with mp_r->est_mp_at - ;
                        mov_mp->qtd_mp
                  else
                     replace mp_r->est_mp_at with mp_r->est_mp_at + ;
                        mov_mp->qtd_mp
                  endif
                  mov_mp->(dbDelete())
                  skip -1
                  skip 
                  if (EOF())
                     skip -1
                  endif
                  unlock all
               else
                  mensagem("Registro nao pode ser excluido. P/ sair tecle <ESC>.", ;
                     27)
                  loop
               endif
            endif
            set color to (cor[1])
            @  5, 30 clear to 15, 69
            set color to 
            @ 23,  0 clear
         endcase
      enddo
   enddo
   return

********************************
procedure NUC317A

   local Local1
   save screen to Local1
   private pg:= 0
   select CLIENTES
   set order to 7
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 7, 63, "ͻȺ ", .T.)
   @  5,  3 say "Vendedor.....: "
   @  6,  3 say "Codigo Estado: "
   set color to 
   sinal("RELATORIO", "VENDEDOR")
   do while (.T.)
      xcod_vend:= Space(3)
      xest_cl:= Space(2)
      set color to (cor[3])
      @  5, 18 get xcod_vend picture "999" valid !Empty(xcod_vend) ;
         .AND. localiza(xcod_vend, "TAB_VEN", 1, "M") when ;
         mens_when("Digite o Codigo do Vendedor ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      set color to (cor[1])
      @  5, 22 say tab_ven->nome_ven
      set color to 
      set color to (cor[3])
      @  6, 18 get XEST_CL picture "@! AA" valid Empty(xest_cl) .OR. ;
         localiza(xest_cl, "TAB_UF", 1, "M") when ;
         mens_when("Digite o Codigo do Estado ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         set color to (cor[1])
         @  5, 18 clear to  6, 60
         set color to 
         loop
      endif
      if (confirme())
         nuc317a1()
      endif
      set color to (cor[1])
      @  5, 18 clear to  6, 60
      set color to 
   enddo

********************************
function HH_TO_HD(Arg1)

   return Val(SubStr(Arg1, 1, 2)) + Val(SubStr(Arg1, 4, 2)) / 60

********************************
procedure NUC26711(Arg1)

   private situacao_c:= .T.
   select VENDAS_R
   if (Arg1 != Nil)
      xnr_carga:= vendas_r->nr_carga
      if (Empty(xnr_carga))
         ms250("Nao existe CARGA para este pedido, tecle [ESC] para continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         return
      endif
   endif
   vendas_r->(dbSetOrder(3))
   vendas_r->(dbSeek(xnr_carga))
   ms250("Pesquisando pedidos da carga, aguarde por favor.", 24, 0, ;
      cor[4], cor[5], Nil, Nil, 80, "c")
   xdt_carga:= dt_carga
   do while (xnr_carga = vendas_r->nr_carga)
      if (!vendas_r->prog_prod)
         situacao_c:= .F.
      endif
      if (!xcx2)
         if (vendas_r->editavel)
            skip 
            loop
         endif
      endif
      AAdd(vet_ped, {vendas_r->nr_ped, 0, clientes->est_cl + ;
         clientes->cid_cl, .T., 0, 0})
      vendas_r->(dbSkip())
   enddo
   vendas_r->(dbSetOrder(1))
   prod_aca->(dbSetOrder(1))
   select ITEM_VER
   item_ver->(dbSetOrder(1))
   xlen_vet_p:= Len(vet_ped)
   for i:= 1 to xlen_vet_p
      xnr_ped:= vet_ped[i][1]
      seek vet_ped[i][1]
      do while (item_ver->nr_ped = vet_ped[i][1])
         prod_aca->(dbSeek(item_ver->co_prod))
         vet_ped[i][2]:= vet_ped[i][2] + item_ver->qt_pe_prod / ;
            iif(prod_aca->qtd_padrao = 0, 9999999999, ;
            prod_aca->qtd_padrao)
         vet_ped[i][5]:= vet_ped[i][5] + item_ver->qt_pe_prod * ;
            prod_aca->peso_prod
         vet_ped[i][6]:= vet_ped[i][6] + item_ver->qt_pe_prod * ;
            item_ver->val_prod
         skip 
      enddo
      vendas_r->(dbSeek(xnr_ped))
      clientes->(dbSeek(vendas_r->cod_cl))
      AAdd(vet_lin, "   " + xnr_ped + " " + clientes->cod_cl + " " + ;
         SubStr(clientes->nome_cl, 1, 34) + " " + ;
         padr(Trim(SubStr(clientes->cid_cl, 1, 15)) + "/" + ;
         clientes->est_cl, 18) + " " + Transform(vet_ped[i][2], ;
         "@E 99999.99"))
      xtotal_cai:= xtotal_cai + vet_ped[i][2]
      xtotal_pes:= xtotal_pes + vet_ped[i][5]
      xtotal_val:= xtotal_val + vet_ped[i][6]
   next
   set color to 
   Scroll(23, 0, 24, 79)
   set color to (cor[2])
   window(3, 0, 21, 79, "Ŀ ")
   @  4,  1 say padc("Relacao de Pedidos do Controle de Carga", 78)
   @  5,  1 say ;
      "   Pedido Codigo/Nome do Cliente                  Cidade/Estado     Qtd Caixa"
   @  6,  1 say Replicate("", 78)
   set color to (cor[1])
   ms250("Situacao da Carga: Carga" + iif(situacao_c, " ", " NAO ") ;
      + "foi Confirmada", 22, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   ms250("Total de caixas : " + alltrim(Transform(xtotal_cai, ;
      "@E 999,999,999.99")) + "     Peso : " + ;
      alltrim(Transform(xtotal_pes, "@E 999,999.99")) + ;
      "     Valor : " + alltrim(Transform(xtotal_val, ;
      "@E 999,999,999.99")), 23, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   ms250("Nr. Carga : " + xnr_carga + "  Data : " + ;
      DToC(xdt_carga) + ;
      "  [F8] Pedido  [F10] Marca Ped.  [ESC] Sair", 24, 0, ;
      cor[4], cor[5], Nil, Nil, 80, "C")
   loop_achoi:= .T.
   do while (loop_achoi)
      achoice(7, 1, 20, 78, vet_lin, Nil, "NUC26721")
   enddo
   set color to 
   Scroll(23, 0, 24, 79)
   return

********************************
function NUC267211(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= SetColor()
   if (Local1 = 27)
      Local2:= 0
      loop_achoi:= .F.
   elseif (Local1 = 13)
      nuc2671(SubStr(xvet_carga[Arg2], 2, 6))
      set color to (Local3)
      Local2:= 0
      loop_achoi:= .T.
   endif
   ms250("Escolha a Carga e tecle [ENTER] para detalhamento", 24, ;
      0, cor[4], cor[5], Nil, Nil, 80, "C")
   return Local2

********************************
function PAR

   parameters nmr
   return iif(Int(nmr / 2) * 2 = nmr, .T., .F.)

********************************
procedure NUC2672

   local Local1, Local2, Local3, Local4, Local5
   Local3:= savescr(3, 0, 22, 79)
   parameters xopcao
   private pg:= 0, vet_est:= {}, vet_ped:= {}, new_vet, vet_item:= {}
   private vet_edita:= {}, vet_lin:= {}, xtotal_cai:= 0, xtravou:= .F.
   private xtotal_pes:= xtotal_val:= 0, yxest_cl:= "", xnr_carga
   private xinicio, xfinal, loop_achoi
   sinal("CONSULTA", "CARGA")
   do while (.T.)
      setcursor(1)
      tela_perio()
      clientes->(dbSetOrder(1))
      select (iif(xcx2, " VENDAS_R", "VENDAS_F"))
      if (.T.)
         set relation to
      endif
      set relation to Cod_CL into CLIENTES
      if (LastKey() == K_ESC)
         restscr(Local3)
         return
      endif
      select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
      set order to 
      private xvet_carga:= {}
      goto top
      ms250("Pesquisando Carga na data acima. Aguarde ou tecle [ESC] para cancelar", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
      xconta:= 0
      Local4:= .F.
      do while (!EOF())
         if (InKey() == K_ESC)
            Local4:= .T.
            exit
         endif
         if (dt_carga >= xinicio .AND. dt_carga <= xfinal)
            AAdd(xvet_carga, " " + nr_carga + "  " + DToC(dt_carga) ;
               + "  " + nr_ped + "  " + SubStr(clientes->nome_cl, ;
               1, 39) + " ")
            xconta++
         endif
         skip 
         if (xconta > 3998)
            ms250("Quantidade de pedidos nao suportados, tecle [ESC] para cancelar", ;
               24, 0, cor[6], cor[7], Nil, Nil, 80, "c")
            Local4:= .T.
            exit
         endif
      enddo
      set relation to
      if (Len(xvet_carga) == 0)
         ms250("Nenhuma carga encontrada neste periodo, tecle [ESC] para sair", ;
            24, 0, cor[6], cor[7], Nil, Nil, 80, "c")
      elseif (!Local4)
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         Scroll(23, 0, 24, 79)
         ms250("Escolha a Carga e tecle [ENTER] para detalhamento", ;
            24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
         Local1:= savescr(3, 0, 22, 79)
         set color to (cor[2])
         Local5:= Len(xvet_carga) + 7
         Local5:= iif(Local5 > 21, 20, Local5)
         window(4, 1, Local5, 73, "Ŀ ", .T.)
         @  5,  3 say "Carga   Dt. Carga  Nr.Ped.  Nome do Cliente"
         @  6,  2 say Replicate("", 71)
         loop_achoi:= .T.
         set color to (cor[1])
         do while (loop_achoi)
            achoice(7, 2, Local5 - 1, 72, xvet_carga, Nil, ;
               "NUC267211")
         enddo
         set color to 
         restscr(Local1)
      endif
   enddo

********************************
procedure NUC27

   local Local1
   Local1:= {}
   AAdd(Local1, {12, 33, " Compras    ", ;
      padc("Consulta Compras de Materia Prima", 80)})
   AAdd(Local1, {13, 33, " Vendas     ", ;
      padc("Consulta Vendas de Produtos", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "COMERCIAL")
   m_clientes:= 1
   do while (.T.)
      set color to (cor[14])
      window(11, 32, 14, 46, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("NUC271"))
            nuc271()
         endif
      case m_clientes = 2
         if (acesso("NUC272"))
            nuc272()
         endif
      case m_clientes = 3
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
function READVAR(Arg1)

   local Local1
   Local1:= Static12
   if (ISCHARACTER(Arg1))
      Static12:= Arg1
   endif
   return Local1

********************************
procedure NUC27111

   local Local1, Local2
   Local2:= setcursor()
   parameters xxpedido
   private mens1:= ;
      {"Digite o Numero do Pedido Anterior ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite a Data do Pedido ou tecle <ESC> p/ sair"}
   private mens2:= ;
      {"Digite a Data do Recebimento da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Data da Emissao da Nota Fiscal ou tecle <ESC> p/ sair", ;
      "Digite o Numero da  da Nota Fiscal ou tecle <ESC> p/ sair"}
   private mens3:= ;
      {"Digite o Codigo da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade Pedida da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite o Preco Unitario da Materia Prima ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do ICMS ou tecle <ESC> p/ sair", ;
      "Digite a Aliquota do IPI ou tecle <ESC> p/ sair"}
   private xnr_ped_o, xnr_ped, xcod_fo, xdt_ped, xdt_re_ped, ;
      xdt_em_nf, xnr_nf
   private xnr_item_p, xco_mp, xqt_pe_mp, xqt_re_mp, xval_mp, ;
      xper_icms
   private xper_ipi, v_itens
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "PEDIDO")
   tel_baixa1()
   xxinicio:= .T.
   do while (.T.)
      if (xxpedido = Nil)
         xnr_ped:= 0
         set color to (cor[3])
         setcursor(1)
         @  5, 20 get XNR_PED picture "999999" when ;
            mens_when(mens1[1])
         read
         if (LastKey() == K_ESC)
            set color to 
            setcursor(0)
            restore screen from Local1
            setcursor(Local2)
            return
         endif
         xnr_ped:= strzero(xnr_ped, 6)
         set color to (cor[3])
         @  5, 20 get XNR_PED picture "999999" when ;
            mens_when(mens1[1])
         readkill(.T.)
         getlist:= {}
         set color to 
         setcursor(0)
      else
         xnr_ped:= xxpedido
         if (xxinicio)
            xxinicio:= .F.
         else
            return
         endif
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      if (Empty(xnr_ped))
         goto top
         xnr_ped:= nr_ped
      else
         set order to 1
         seek xnr_ped
         if (!Found())
            mensagem("Pedido nao encontrado, favor verificar. Tecle <ESC> p/ continuar.", ;
               27)
            loop
         endif
      endif
      setcursor(0)
      do while (.T.)
         @ 23,  0 clear to 24, 79
         set color to (cor[9])
         @ 24,  0 say "      Anterior "
         @ 24, 16 say "      Proximo "
         @ 24, 31 say "    Alterar "
         @ 24, 44 say "    Excluir "
         @ 24, 57 say "    Itens  "
         @ 24, 69 say "     Sair  "
         set color to (cor[10])
         @ 24,  1 say "PgUp"
         @ 24, 17 say "PgDn"
         @ 24, 32 say "F2"
         @ 24, 45 say "F3"
         @ 24, 58 say "F4"
         @ 24, 70 say "Esc"
         set color to 
         xnr_ped:= nr_ped
         set color to (cor[3])
         @  5, 20 get XNR_PED picture "999999"
         readkill(.T.)
         getlist:= {}
         set color to 
         trans_ped()
         get_baixa1()
         readkill(.T.)
         getlist:= {}
         dis_baixa1()
         set color to 
         if (!Empty(nr_nf))
            tel_baixa2()
            get_manu()
            readkill(.T.)
            getlist:= {}
            set color to 
         else
            lim_baixa2()
         endif
         xtec:= InKey(0)
         if (xcx2)
            if (!ped_mp_r->editavel .AND. (xtec = -1 .OR. xtec = -2))
               ms250("Registro nao EDITAVEL no modo corrente. Tecle [ESC] para continuar.", ;
                  24, 0, cor[6], cor[7], {3}, "T", 80, "C")
               loop
            endif
         endif
         do case
         case xtec == 18
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec == 3
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            @ 23,  0 clear
            lim_baixa1()
            if (!Empty(nr_nf))
               lim_baixa2()
            endif
            exit
         case xtec == -1
            if (!Empty(nr_nf))
               xsalva_are:= alias()
               nuc2712(xnr_ped)
               select (xsalva_are)
               setcursor(1)
               loop
            endif
            @ 23,  0 clear
            xalias:= alias()
            select PED_MP_R
            if (xalias != "PED_MP_R")
               set order to 1
               seek xnr_ped
            endif
            if (!reclock(5))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            if (!xcx2)
               select PED_MP_F
               xalias:= alias()
               if (xalias != "PED_MP_F")
                  set order to 1
                  seek xnr_ped
               endif
               if (!reclock(5))
                  mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                     27)
                  ped_mp_r->(dbUnlock())
                  loop
               endif
            endif
            do while (acesso("NUC2711ALT"))
               setcursor(1)
               set color to (cor[3])
               get_ped()
               read
               setcursor(0)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  select PED_MP_R
                  grav_ped_r()
                  if (!xcx2)
                     select PED_MP_F
                     grav_ped_f()
                  endif
               endif
               exit
            enddo
            ped_mp_r->(dbUnlock())
            if (!xcx2)
               ped_mp_f->(dbUnlock())
            endif
         case xtec = -2 .AND. acesso("NUC2711EXC")
            @ 23,  0 clear
            if (excluir())
               xalias:= alias()
               select PED_MP_R
               if (xalias != "PED_MP_R")
                  set order to 1
                  seek xnr_ped
               endif
               if (!reclock(5))
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  loop
               endif
               if (!xcx2)
                  xalias:= alias()
                  select PED_MP_F
                  if (xalias != "PED_MP_F")
                     set order to 1
                     seek xnr_ped
                  endif
                  if (!reclock(5))
                     mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                        27)
                     select PED_MP_R
                     unlock
                     loop
                  endif
               endif
               select IT_P_MPR
               if (fillock(5))
                  if (!xcx2)
                     select IT_P_MPF
                     if (!fillock(5))
                        mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                           27)
                        it_p_mpr->(dbUnlock())
                        ped_mp_r->(dbUnlock())
                        if (!xcx2)
                           ped_mp_f->(dbUnlock())
                        endif
                        loop
                     endif
                  endif
               else
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  loop
               endif
               select MP_R
               set order to 1
               if (!fillock(5))
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  if (!xcx2)
                     ped_mp_f->(dbUnlock())
                     it_p_mpf->(dbUnlock())
                  endif
                  it_p_mpr->(dbUnlock())
                  ped_mp_r->(dbUnlock())
                  select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
                  loop
               endif
               select PED_MP_R
               delete
               ped_mp_r->(dbUnlock())
               select IT_P_MPR
               set order to 1
               do while (nr_ped = xnr_ped .AND. !EOF())
                  mp_r->(dbSeek(it_p_mpr->co_mp))
                  replace mp_r->est_mp_max with mp_r->est_mp_max - ;
                     it_p_mpr->qt_re_mp
                  if (!xcx2)
                     replace mp_r->est_mp_at with mp_r->est_mp_at - ;
                        it_p_mpr->qt_re_mp
                  endif
                  delete
                  skip 
               enddo
               it_p_mpr->(dbUnlock())
               mp_r->(dbUnlock())
               if (!xcx2)
                  select PED_MP_F
                  delete
                  ped_mp_f->(dbUnlock())
                  select IT_P_MPF
                  set order to 1
                  do while (nr_ped = xnr_ped .AND. !EOF())
                     delete
                     skip 
                  enddo
                  it_p_mpf->(dbUnlock())
               endif
               select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
            endif
            skip 
            skip -1
         case xtec == -3
            tone(850, 2)
            lista_item()
         endcase
      enddo
   enddo
   return

********************************
procedure TELA_ITEM2

   set color to (cor[1])
   window(12, 1, 19, 70, "ͻȺ ", .T.)
   @ 13,  3 say "Numero do Item.:"
   @ 14,  3 say "Codigo da M.P. :"
   @ 15,  3 say "Quantidade M.P.:"
   @ 16,  3 say "Val. unit. M.P.:"
   @ 17,  3 say "Aliquota ICMS..:"
   @ 18,  3 say "Aliquota IPI...:"
   set color to 
   return

********************************
static procedure ETIQ_TEMP

   replace etiq_cl->cod_cl with clientes->cod_cl
   replace etiq_cl->nome_cl with clientes->nome_cl
   replace etiq_cl->end_cl with clientes->end_cl
   replace etiq_cl->bairro_cl with clientes->bairro_cl
   replace etiq_cl->cid_cl with clientes->cid_cl
   replace etiq_cl->est_cl with clientes->est_cl
   replace etiq_cl->cep_cl with clientes->cep_cl
   return

********************************
function REC_ITEM2(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4:= ;
      SetColor(), Local5:= setcursor(), Local6
   Local3:= SubStr(v_itens[Arg2], 2, 2)
   do case
   case Local1 = 27
      Local2:= 0
   case xcx2 .AND. !ped_mp_r->editavel
      ms250("Registro nao EDITAVEL no modo corrente. Tecle [ESC] para continuar.", ;
         24, 0, cor[6], cor[7], {3}, "T", 80, "C")
   case !Empty(xnr_nf)
      ms250("Pedido FECHADO, nao poder ser alterado. Tecle [ESC] para continuar.", ;
         24, 0, cor[6], cor[7], {3}, "T", 80, "C")
   case Local1 = 7 .AND. acesso("NUC2711ITEEXC")
      if (Len(v_itens) == 1)
         set color to 
         @ 23,  0
         mensagem("Item nao pode ser excluido, favor excluir o pedido, tecle <esc>", ;
            27)
      elseif (excluir())
         select IT_P_MPR
         set order to 1
         seek xnr_ped + Local3
         if (fillock(5))
            select MP_R
            mp_r->(dbSeek(it_p_mpr->co_mp))
            if (reclock(5))
               if (!xcx2)
                  select IT_P_MPF
                  set order to 1
                  seek xnr_ped + Local3
                  if (fillock(5))
                     replace mp_r->est_mp_at with mp_r->est_mp_at - ;
                        it_p_mpr->qt_re_mp
                     replace mp_r->est_mp_max with mp_r->est_mp_max ;
                        - it_p_mpr->qt_re_mp
                     delete
                     seek xnr_ped
                     for ind:= 1 to Len(v_itens) - 1
                        replace it_p_mpf->nr_item_pd with ;
                           strzero(ind, 2)
                        skip 
                     next
                     select IT_P_MPR
                     delete
                     seek xnr_ped
                     adel(v_itens, Arg2)
                     asize(v_itens, Len(v_itens) - 1)
                     len_itens:= Len(v_itens)
                     for ind:= 1 to len_itens
                        replace it_p_mpr->nr_item_pd with ;
                           strzero(ind, 2)
                        xco_mp:= co_mp
                        xval_mp:= Transform(val_mp, ;
                           "@E 999,999,999.99")
                        xqt_pe_mp:= Transform(qt_pe_mp, ;
                           "@E 999,999.99")
                        mp_r->(dbSeek(xco_mp))
                        xdesc_mp:= SubStr(mp_r->de_mp, 1, 31)
                        v_itens[ind]:= " " + nr_item_pd + "  " + ;
                           xdesc_mp + "  " + xqt_pe_mp + "  " + ;
                           xval_mp + " "
                        skip 
                     next
                  endif
               else
                  select IT_P_MPR
                  replace mp_r->est_mp_max with mp_r->est_mp_max - ;
                     it_p_mpr->qt_re_mp
                  delete
                  seek xnr_ped
                  adel(v_itens, Arg2)
                  asize(v_itens, Len(v_itens) - 1)
                  len_itens:= Len(v_itens)
                  for ind:= 1 to len_itens
                     replace it_p_mpr->nr_item_pd with strzero(ind, 2)
                     xco_mp:= co_mp
                     xval_mp:= Transform(val_mp, "@E 999,999,999.99")
                     xqt_pe_mp:= Transform(qt_pe_mp, "@E 999,999.99")
                     mp_r->(dbSeek(xco_mp))
                     xdesc_mp:= SubStr(mp_r->de_mp, 1, 31)
                     v_itens[ind]:= " " + nr_item_pd + "  " + ;
                        xdesc_mp + "  " + xqt_pe_mp + "  " + ;
                        xval_mp + " "
                     skip 
                  next
               endif
            endif
         endif
         it_p_mpr->(dbUnlock())
         mp_r->(dbUnlock())
         it_p_mpf->(dbUnlock())
      endif
   case Local1 = -5 .AND. acesso("NUC2711ITEINC")
      save screen to Local6
      set color to (cor[12])
      @ 12,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      ini_item()
      tela_item2()
      setcursor(1)
      set color to (cor[3])
      xnr_item_p:= strzero(Len(v_itens) + 1, 2)
      @ 13, 20 get XNR_ITEM_P
      readkill(.T.)
      getlist:= {}
      set color to 
      get_item2()
      read
      set color to 
      setcursor(0)
      if (LastKey() != K_ESC)
         if (confirme())
            xok:= .T.
            select IT_P_MPR
            if (!addrec(5))
               xok:= .F.
            endif
            select MP_R
            seek xco_mp
            if (!reclock(5))
               xok:= .F.
            endif
            if (!xcx2 .AND. xok)
               select IT_P_MPF
               if (!addrec(5))
                  xok:= .F.
                  select IT_P_MPR
                  delete
                  unlock
                  xok:= .F.
               endif
            endif
            if (xok)
               select IT_P_MPR
               grav_it_r()
               replace mp_r->est_mp_max with mp_r->est_mp_max + ;
                  it_p_mpr->qt_re_mp
               if (!xcx2)
                  select IT_P_MPF
                  grav_it_f()
               endif
               unlock all
               mp_r->(dbSetOrder(1))
               mp_r->(dbSeek(xco_mp))
               xval_mp:= Transform(val_mp, "@E 999,999,999.99")
               xqt_pe_mp:= Transform(qt_pe_mp, "@E 999,999.99")
               xdesc_mp:= SubStr(mp_r->de_mp, 1, 31)
               AAdd(v_itens, " " + nr_item_pd + "  " + xdesc_mp + ;
                  "  " + xqt_pe_mp + "  " + xval_mp + " ")
            endif
         endif
      endif
      restore screen from Local6
   case Local1 = 13 .AND. acesso("NUC2711ITEALT")
      save screen to Local6
      set color to (cor[12])
      @ 12,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      Local3:= SubStr(v_itens[Arg2], 2, 2)
      select IT_P_MPR
      seek xnr_ped + Local3
      xteste:= .F.
      if (reclock(5))
         xteste:= .T.
         if (!xcx2)
            select IT_P_MPF
            seek xnr_ped + Local3
            if (!reclock(5))
               xteste:= .F.
            endif
         endif
      endif
      if (xteste)
         areacorren:= alias()
         select MP_R
         seek it_p_mpr->co_mp
         if (!reclock(5))
            xteste:= .F.
         endif
         select (areacorren)
      endif
      yqt_re_mp:= it_p_mpr->qt_re_mp
      if (xteste)
         trans_it()
         setcursor(1)
         tela_item2()
         set color to (cor[3])
         @ 13, 20 get XVAR1 picture "99"
         @ 14, 20 get XCO_MP
         readkill(.T.)
         getlist:= {}
         disp_item()
         setcursor(1)
         get_item2(.T.)
         read
         setcursor(0)
         set color to 
         if (LastKey() != K_ESC)
            if (confirme())
               grav_it_r()
               select IT_P_MPR
               if (!xcx2)
                  select IT_P_MPF
                  grav_it_f()
               endif
               replace mp_r->est_mp_max with mp_r->est_mp_max + ;
                  (it_p_mpr->qt_re_mp - yqt_re_mp)
               if (!xcx2)
                  replace mp_r->est_mp_at with mp_r->est_mp_at + ;
                     (it_p_mpr->qt_re_mp - yqt_re_mp)
               endif
               xval_mp:= Transform(val_mp, "@E 999,999,999.99")
               xqt_pe_mp:= Transform(qt_pe_mp, "@E 999,999.99")
               xdesc_mp:= SubStr(mp_r->de_mp, 1, 31)
               v_itens[Arg2]:= " " + nr_item_pd + "  " + xdesc_mp + ;
                  "  " + xqt_pe_mp + "  " + xval_mp + " "
            endif
         endif
      endif
      restore screen from Local6
      setcursor(Local5)
      set color to 
      unlock all
   endcase
   set color to (Local4)
   ms250(" [ENTER] Alterar Item    [DEL] Excluir Item   [F6] Incluir Item    [ESC] Sair  ", ;
      24, 0, cor[1], cor[2], Nil, Nil, 80, "C")
   return Local2

********************************
procedure GET_ITEM2(Arg1)

   set color to (cor[3])
   if (Arg1 = Nil)
      @ 14, 20 get XCO_MP picture "9999" valid localiza(xco_mp, ;
         "MP_R", 1, "M", "DE_MP", 14, 25) .AND. mp_pedida() when ;
         mens_when(mens3[1])
   endif
   @ 15, 20 get XQT_PE_MP picture "@E 99,999,999.999999" valid ;
      !Empty(xqt_pe_mp) .OR. sb() when mens_when(mens3[2])
   @ 16, 20 get XVAL_MP picture "@E 99,999,999.999999" valid ;
      !Empty(xval_mp) .OR. sb() when mens_when(mens3[3])
   @ 17, 20 get XPER_ICMS picture "@E 999,999.99" when ;
      mens_when(mens3[4]) .AND. iif(xper_icms = 0, (xper_icms:= ;
      ali_mp("ICMS")) = xper_icms, .T.)
   @ 18, 20 get XPER_IPI picture "@E 999,999.99" when ;
      mens_when(mens3[5]) .AND. iif(xper_ipi = 0, (xper_ipi:= ;
      ali_mp("IPI")) = xper_ipi, .T.)
   return

********************************
procedure NUC27112

   local Local1, Local2
   Local2:= setcursor(1)
   parameters xopcao
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Codigo da Materia Prima ou tecle <ESC> p/ sair"}
   private xnr_ped, xcod_fo, xco_mp, vet_ped:= {}
   save screen to Local1
   sinal("CONSULTA", "PEDIDO")
   do while (.T.)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      set color to (cor[1])
      window(4, 1, 6, 70, "Ŀ ", .T.)
      xcod_fo:= "    "
      @  5,  3 say "Fornecedor.....:"
      @  5, 20 get XCOD_FO picture "@K 9999" valid !Empty(xcod_fo) ;
         .AND. localiza(stz(@xcod_fo), "FORNECED", 1, "M", ;
         "NOME_FO", 5, 25) when mens_when(mens1[1])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      set order to 2
      seek xcod_fo
      if (EOF())
         ms250("Nao existe PEDIDO para este fornecedor. Tecle [ESC] p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      vet_ped:= {}
      do while (xcod_fo = cod_fo)
         AAdd(vet_ped, load_ped())
         skip 
      enddo
      set color to (cor[16])
      window(7, 1, 20, 70, "Ŀ ", .T.)
      @  8,  2 say ;
         " Nr. Ped.  Dt. Pedido  Dt. Rec.  Dt. Emissao NF  Nr. NF "
      @  9,  2 say Replicate("", 68)
      ms250("[Enter] Mostra Pedido Completo                     [ESC] Termina ", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      achoice(10, 2, 19, 69, vet_ped, Nil, "NUC271121")
      set color to (cor[1])
      setcursor(1)
   enddo
   return

********************************
function NUC271121(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= savescr(24, 0, 24, ;
      79), Local4
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      Local4:= savescr(4, 1, 21, 78)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      nuc27111(SubStr(vet_ped[Arg2], 2, 6))
      restscr(Local4)
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local3)
   return Local2

********************************
procedure TEL_BAIXA2

   set color to (cor[1])
   window(12, 1, 16, 70, "ͻȺ ", .T.)
   @ 13,  3 say "Recebimento NF.:"
   @ 14,  3 say "Emissao da NF..:"
   @ 15,  3 say "Numero da NF...:"
   set color to 
   return

********************************
procedure GET_BAIXA1

   set color to (cor[3])
   @  6, 20 get XNR_PED_O picture "999999"
   @  7, 20 get XCOD_FO picture "9999"
   @  8, 20 get XDT_PED picture "@D"
   return

********************************
function NUC271221(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= savescr(24, 0, 24, ;
      79), Local4
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      Local4:= savescr(4, 1, 21, 78)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      nuc27211(SubStr(vet_ped[Arg2], 2, 6))
      restscr(Local4)
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local3)
   return Local2

********************************
procedure FUNC0001


********************************
procedure NUC27113

   local Local1, Local2
   Local2:= setcursor(1)
   parameters xopcao
   private mens1:= ;
      {"Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite o Codigo da Materia Prima ou tecle <ESC> p/ sair"}
   private xnr_ped, xcod_fo, xco_mp, vet_ped:= {}
   save screen to Local1
   sinal("CONSULTA", "PEDIDO")
   do while (.T.)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      set color to (cor[1])
      window(4, 1, 6, 70, "Ŀ ", .T.)
      xco_mp:= "    "
      @  5,  3 say "Materia Prima..:"
      @  5, 20 get XCO_MP picture "@k 9999" valid !Empty(xco_mp) ;
         .AND. localiza(stz(@xco_mp), "MP_R", 1, "M", "DE_MP", 5, ;
         25) when mens_when(mens1[2])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      set order to 1
      select FORNECED
      set order to 1
      select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
      set order to 2
      seek xco_mp
      if (EOF())
         ms250("Nao existe PEDIDO para esta Materia Prima. Tecle [ESC] p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      vet_ped:= {}
      do while (xco_mp = co_mp)
         xnr_ped:= nr_ped
         select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
         seek xnr_ped
         xcod_fo:= cod_fo
         select FORNECED
         seek xcod_fo
         select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
         AAdd(vet_ped, load_ped())
         select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
         skip 
      enddo
      set color to (cor[16])
      window(7, 1, 20, 70, "Ŀ ", .T.)
      @  8,  2 say " Nr. Ped.  Dt. Pedido  Nr. NF   Fornecedor "
      @  9,  2 say Replicate("", 68)
      ms250("[Enter] Mostra Pedido Completo                     [ESC] Termina ", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      achoice(10, 2, 19, 69, vet_ped, Nil, "NUC271131")
      set color to (cor[1])
      setcursor(1)
   enddo
   return

********************************
function NUC271131(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= savescr(24, 0, 24, ;
      79), Local4
   set color to (cor[1])
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      Local4:= savescr(4, 1, 21, 78)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      nuc27111(SubStr(vet_ped[Arg2], 2, 6))
      restscr(Local4)
   endif
   set color to (cor[16])
   setcursor(0)
   restscr(Local3)
   return Local2

********************************
procedure TEL_BAIXA1

   set color to (cor[1])
   window(4, 1, 9, 70, "ͻȺ ", .T.)
   @  5,  3 say "Num. do pedido.:"
   @  6,  3 say "Pedido anterior:"
   @  7,  3 say "Fornecedor.....:"
   @  8,  3 say "Data do pedido.:"
   set color to 
   return

********************************
procedure TEL_VEND2

   set color to (cor[1])
   window(15, 1, 18, 70, "ͻȺ ", .T.)
   @ 16,  3 say "Emissao da NF..:"
   @ 17,  3 say "Numero da NF...:"
   set color to 
   return

********************************
procedure NUC2712

   local Local1, Local2
   Local2:= setcursor()
   parameters xxnr_ped
   private mens1:= ;
      {"Digite o Numero do Pedido ou tecle <ESC> p/ sair"}
   private mens2:= ;
      {"Digite a Data do Recebimento da Mercadoria ou tecle <ESC> p/ sair", ;
      "Digite a Data da Emissao da Nota Fiscal ou tecle <ESC> p/ sair", ;
      "Digite o Numero da  da Nota Fiscal ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade recebida da Materia Prima ou tecle <ESC> p/ sair"}
   private xnr_ped_o, xnr_ped, xcod_fo, xdt_ped, xdt_re_ped, ;
      xdt_em_nf, xnr_nf
   private xnr_item_p, xco_mp, xqt_pe_mp, xqt_re_mp, xval_mp, ;
      xper_icms
   private xper_ipi
   private v_itens
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("BAIXA", "PEDIDO")
   tel_baixa1()
   ini_ped()
   xinicio:= .T.
   do while (xinicio)
      xnr_ped:= Space(6)
      set color to (cor[3])
      setcursor(1)
      if (xxnr_ped != Nil)
         xnr_ped:= xxnr_ped
         xinicio:= .F.
         @  5, 20 get XNR_PED picture "999999"
         readkill(.T.)
         getlist:= {}
      else
         @  5, 20 get XNR_PED picture "999999" valid !Empty(xnr_ped) ;
            when mens_when(mens1[1])
         read
      endif
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select PED_MP_R
      set order to 1
      seek xnr_ped
      if (!Found())
         mensagem("Pedido nao encontrado, favor verificar. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      if (!reclock(5))
         mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      if (!xcx2)
         select PED_MP_F
         set order to 1
         seek xnr_ped
         if (Found())
            if (!reclock(5))
               mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
                  27)
               unlock all
               loop
            endif
         else
            mensagem("Pedido nao encontrado, favor verificar.. Tecle <ESC> p/ continuar.", ;
               27)
            unlock all
            loop
         endif
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      if (!Empty(nr_nf) .AND. xxnr_ped = Nil)
         trans_ped()
         get_baixa1()
         readkill(.T.)
         getlist:= {}
         dis_baixa1()
         set color to 
         tel_baixa2()
         setcursor(1)
         get_baixa2()
         readkill(.T.)
         getlist:= {}
         set color to 
         mensagem("Pedido ja foi baixado. Tecle <ESC> p/ continuar.", ;
            27)
         lim_baixa1()
         lim_baixa2()
         loop
      endif
      select IT_P_MPR
      if (fillock(5))
         if (!xcx2)
            select IT_P_MPF
            if (!fillock(5))
               mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
                  27)
               unlock all
               loop
            endif
         endif
      else
         mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      select MP_R
      set order to 1
      if (!fillock(5))
         mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
            27)
         unlock all
         loop
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      trans_ped()
      get_baixa1()
      readkill(.T.)
      getlist:= {}
      dis_baixa1()
      set color to 
      tel_baixa2()
      setcursor(1)
      get_baixa2()
      read
      set color to 
      if (LastKey() == K_ESC)
         lim_baixa1()
         lim_baixa2()
         loop
      endif
      if (confirme())
         monta_iten()
      endif
      lim_baixa1()
      lim_baixa2()
      unlock all
   enddo
   return

********************************
procedure GET_BAIXA2

   set color to (cor[3])
   @ 13, 20 get XDT_RE_PED picture "@D" valid xdt_re_ped >= xdt_ped ;
      .AND. xdt_re_ped <= Date() when mens_when(mens2[1])
   @ 14, 20 get XDT_EM_NF picture "@D" valid xdt_em_nf >= xdt_ped ;
      .AND. xdt_em_nf <= Date() .OR. sb() when mens_when(mens2[2])
   @ 15, 20 get XNR_NF picture "999999" valid !Empty(xnr_nf) .OR. ;
      sb() when mens_when(mens2[3])
   return

********************************
procedure GET_ITEM3(Arg1)

   set color to (cor[3])
   if (Arg1 = Nil)
      @ 15, 20 get XCO_PROD picture "9999" valid localiza(xco_prod:= ;
         strzero(Val(xco_prod), 4), "PROD_ACA", 1, "M", "DE_PROD", ;
         15, 25) .AND. prod_pedi() when mens_when(mens3[1])
   endif
   @ 16, 20 get XQT_PE_PRO picture "@E 999,999.99" valid ;
      !Empty(xqt_pe_pro) .OR. sb() when mens_when(mens3[2])
   @ 17, 20 get XVAL_PROD picture "@E 999,999.99" when ;
      mens_when(mens3[3])
   return

********************************
procedure __SETFORMA(Arg1)

   Static21:= iif(ISBLOCK(Arg1), Arg1, Nil)
   return

********************************
procedure NUC27211

   local Local1, Local2
   Local2:= setcursor()
   parameters xxpedido, xprog_pai
   xprog_pai:= iif(xprog_pai = Nil, " ", xprog_pai)
   private mens1:= ;
      {"Digite o Numero do Pedido Anterior ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Fornecedor ou tecle <ESC> p/ sair", ;
      "Digite a Data do Pedido ou tecle <ESC> p/ sair", ;
      "Digite o Codigo da Condicao de Pagamento ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite o Percentual de Comissao do Vendedor ou tecle <ESC> p/ sair"}
   private mens2:= ;
      {"Digite a Data da Emissao da Nota Fiscal ou tecle <ESC> p/ sair", ;
      "Digite o Numero da  da Nota Fiscal ou tecle <ESC> p/ sair"}
   private mens3:= ;
      {"Digite o Codigo do Produto ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade Pedida do Produto ou tecle <ESC> p/ sair", ;
      "Digite o Valor Unitario do Produto ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade de Brinde ou tecle <ESC> p/ sair"}
   private xnr_ped_o, xnr_ped, xcod_cl, xdt_ped, xdt_em_nf, xnr_nf
   private xco_cpag, xco_ven, xper_comis, xnr_item_p, xco_prod, ;
      xqt_pe_pro
   private xqt_en_pro, xval_prod, xal_icms, xal_ipi
   private v_itens, xval_pedid, xnr_carga
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CONSULTA", "PEDIDO")
   tel_vend1()
   xxinicio:= .T.
   do while (.T.)
      if (xxpedido = Nil)
         xnr_ped:= 0
         set color to (cor[3])
         setcursor(1)
         @  5, 20 get XNR_PED picture "999999" when ;
            mens_when(mens1[1])
         read
         if (LastKey() == K_ESC)
            set color to 
            restore screen from Local1
            setcursor(Local2)
            return
         endif
         xnr_ped:= strzero(xnr_ped, 6)
         @  5, 20 get XNR_PED picture "999999" when ;
            mens_when(mens1[1])
         readkill(.T.)
         getlist:= {}
         set color to 
         setcursor(0)
      else
         xnr_ped:= xxpedido
         if (xxinicio)
            xxinicio:= .F.
         else
            return
         endif
      endif
      select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
      if (Empty(xnr_ped))
         goto top
         xnr_ped:= nr_ped
      else
         set order to 1
         seek xnr_ped
         if (!Found())
            mensagem("Pedido nao encontrado, favor verificar. Tecle <ESC> p/ continuar.", ;
               27)
            loop
         endif
      endif
      setcursor(0)
      do while (.T.)
         @ 23,  0 clear to 24, 79
         if (xprog_pai != "NUC365")
            set color to (cor[9])
            @ 24,  0 say "      Anterior "
            @ 24, 16 say "      Proximo "
            @ 24, 31 say "    Alterar "
            @ 24, 44 say "    Excluir "
            @ 24, 57 say "    Itens  "
            @ 24, 69 say "     Sair  "
            set color to (cor[10])
            @ 24,  1 say "PgUp"
            @ 24, 17 say "PgDn"
            @ 24, 32 say "F2"
            @ 24, 45 say "F3"
            @ 24, 58 say "F4"
            @ 24, 70 say "Esc"
            set color to 
         else
            ms250("[F4] Mostra Itens do Pedido                                    [ESC] Retorna", ;
               24, 0, cor[9], cor[10], Nil, Nil, 80, "c")
         endif
         xnr_ped:= nr_ped
         set color to (cor[3])
         @  5, 20 get XNR_PED picture "999999"
         readkill(.T.)
         getlist:= {}
         set color to 
         @  5, 28 say iif(prog_prod, "Pedido baixado", ;
            "Pedido aberto ") color cor[2]
         trans_vend()
         get_vend1()
         readkill(.T.)
         getlist:= {}
         select (iif(xcx2, "ITEM_VER", "ITEM_VEF"))
         set order to 1
         seek xnr_ped
         xval_pedid:= 0
         do while (nr_ped = xnr_ped .AND. !EOF())
            xval_pedid:= xval_pedid + qt_pe_prod * val_prod
            dbSkip()
         enddo
         select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
         set color to (cor[1])
         @ 11, 37 say "Valor do Pedido : "
         set color to (cor[3])
         @  6, 60 get xnr_carga picture "999999"
         @ 11, 55 get xval_pedido picture "@EB 999,999,999.99"
         readkill(.T.)
         getlist:= {}
         set color to 
         dis_vend1()
         set color to 
         if (!Empty(nr_nf))
            tel_vend2()
            get_manu2()
            readkill(.T.)
            getlist:= {}
            set color to 
         else
            lim_vend2()
         endif
         xtec:= InKey(0)
         do case
         case xtec = 18 .AND. xprog_pai != "NUC365"
            skip -1
            if (BOF())
               mensagem("Inicio do Arquivo", 1)
            endif
         case xtec = 3 .AND. xprog_pai != "NUC365"
            skip 
            if (EOF())
               mensagem("Fim do arquivo", 1)
               skip -1
            endif
         case xtec == 27
            @ 23,  0 clear
            lim_vend1()
            if (!Empty(nr_nf))
               lim_vend2()
            endif
            exit
         case xtec = -1 .AND. xprog_pai != "NUC365" .AND. ;
               acesso("NUC2721ALT")
            @ 23,  0 clear
            xalias:= alias()
            select VENDAS_R
            set order to 1
            seek xnr_ped
            if (xcx2 .AND. !vendas_r->editavel)
               ms250("Registro nao pode ser alterado neste MODO. Tecle [ESC]", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               loop
            endif
            if (!reclock(5))
               mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                  27)
               loop
            endif
            if (!xcx2)
               select VENDAS_F
               set order to 1
               seek xnr_ped
               if (!reclock(5))
                  mensagem("Registro nao pode ser alterado. P/ sair tecle <ESC>.", ;
                     27)
                  select VENDAS_R
                  unlock
                  loop
               endif
            endif
            do while (.T.)
               setcursor(1)
               set color to (cor[3])
               get_vend()
               read
               setcursor(0)
               set color to 
               if (LastKey() = K_ESC .OR. !updated())
                  exit
               endif
               @ 23,  0 clear
               gra()
               if (gra = "A")
                  loop
               elseif (gra = "G")
                  select VENDAS_R
                  gra_vend_r()
                  unlock
                  if (!xcx2)
                     select VENDAS_F
                     gra_vend_f()
                     unlock
                  endif
               endif
               select (xalias)
               exit
            enddo
         case xtec = -2 .AND. xprog_pai != "NUC365" .AND. ;
               acesso("NUC2721EXC")
            @ 23,  0 clear
            if (xcx2 .AND. !vendas_r->editavel)
               ms250("Registro nao pode ser excluido neste MODO. Tecle [ESC]", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               loop
            endif
            if (excluir())
               xalias:= alias()
               select VENDAS_R
               set order to 1
               seek xnr_ped
               if (!reclock(5))
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  unlock all
                  loop
               endif
               if (!xcx2)
                  select VENDAS_F
                  set order to 1
                  seek xnr_ped
                  if (!reclock(5))
                     mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                        27)
                     select VENDAS_R
                     unlock all
                     loop
                  endif
               endif
               select ITEM_VER
               if (fillock(5))
                  if (!xcx2)
                     select ITEM_VEF
                     if (!fillock(5))
                        mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                           27)
                        select ITEM_VER
                        unlock all
                        loop
                     endif
                  endif
               else
                  mensagem("Nao foi possivel excluir registro. [ESC] p/ sair.", ;
                     27)
                  unlock all
                  loop
               endif
               select VENDAS_R
               delete
               select ITEM_VER
               set order to 1
               seek xnr_ped
               do while (nr_ped = xnr_ped .AND. !EOF())
                  delete
                  skip 
               enddo
               if (!xcx2)
                  select VENDAS_F
                  delete
                  select ITEM_VEF
                  set order to 1
                  seek xnr_ped
                  do while (nr_ped = xnr_ped .AND. !EOF())
                     delete
                     skip 
                  enddo
               endif
               select (xalias)
            endif
            unlock all
            skip 
            skip -1
         case xtec == -3
            lista_it2()
         endcase
      enddo
   enddo
   return

********************************
procedure EXC_ESTOQ(Arg1, Arg2, Arg3)

   select (Arg1)
   set order to 1
   seek DToS(Arg2)
   DBEval({|| field->qtde:= qtde - Arg3}, Nil, Nil, Nil, Nil, .T.)
   return

********************************
procedure INC_ESTOQ(Arg1, Arg2, Arg3)

   select (Arg1)
   set order to 1
   seek DToS(Arg2)
   DBEval({|| field->qtde:= qtde + Arg3}, Nil, Nil, Nil, Nil, .T.)
   return

********************************
function REC_IT2(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4:= ;
      SetColor(), Local5:= setcursor(), Local6, Local7:= savescr(24, ;
      0, 24, 79)
   Local3:= SubStr(v_itens[Arg2], 2, 2)
   begin sequence
      do case
      case Local1 = 27
         Local2:= 0
      case Local1 = 7 .AND. xprog_pai != "NUC365"
         if (Len(v_itens) == 1)
            set color to 
            @ 23,  0
            mensagem("Item nao pode ser excluido, favor excluir o pedido, tecle <esc>", ;
               27)
         else
            if (xcx2 .AND. !vendas_r->editavel)
               ms250("Registro nao pode ser excluido neste MODO. Tecle [ESC]", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               break
            endif
            if (excluir())
               select ITEM_VER
               set order to 1
               dbSeek(xnr_ped + Local3, iif(.F., .T., Nil))
               if (fillock(5))
                  if (!xcx2)
                     select ITEM_VEF
                     set order to 1
                     dbSeek(xnr_ped + Local3, iif(.F., .T., Nil))
                     if (fillock(5))
                        delete
                        dbSeek(xnr_ped, iif(.F., .T., Nil))
                        for ind:= 1 to Len(v_itens) - 1
                           replace item_vef->nr_item_pd with ;
                              strzero(ind, 2)
                           skip 
                        next
                        select ITEM_VER
                        delete
                        dbSeek(xnr_ped, iif(.F., .T., Nil))
                        for ind:= 1 to Len(v_itens) - 1
                           replace item_ver->nr_item_pd with ;
                              strzero(ind, 2)
                           skip 
                        next
                        unlock
                        select ITEM_VEF
                        unlock
                        adel(v_itens, Arg2)
                        asize(v_itens, Len(v_itens) - 1)
                        for ind:= 1 to Len(v_itens)
                           v_itens[ind]:= " " + strzero(ind, 2) + ;
                              "  " + SubStr(v_itens[ind], 7, 30) + ;
                              "  " + SubStr(v_itens[ind], 40, 10) + ;
                              "  " + SubStr(v_itens[ind], 53, 14) + ;
                              " "
                        next
                     endif
                  else
                     select ITEM_VER
                     delete
                     dbSeek(xnr_ped, iif(.F., .T., Nil))
                     for ind:= 1 to Len(v_itens) - 1
                        replace item_ver->nr_item_pd with ;
                           strzero(ind, 2)
                        skip 
                     next
                     unlock
                     adel(v_itens, Arg2)
                     asize(v_itens, Len(v_itens) - 1)
                     for ind:= 1 to Len(v_itens)
                        v_itens[ind]:= " " + strzero(ind, 2) + "  " ;
                           + SubStr(v_itens[ind], 7, 30) + "  " + ;
                           SubStr(v_itens[ind], 40, 10) + "  " + ;
                           SubStr(v_itens[ind], 53, 14) + " "
                     next
                  endif
               endif
            endif
         endif
      case Local1 = -5 .AND. xprog_pai != "NUC365"
         if (xcx2 .AND. !vendas_r->editavel)
            ms250("ITEM nao pode ser adicionado neste MODO. Tecle [ESC]", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
            break
         endif
         save screen to Local6
         restscr(xtela_ven)
         ini_i_ven()
         tel_item3()
         setcursor(1)
         set color to (cor[3])
         xnr_item_p:= strzero(Len(v_itens) + 1, 2)
         @ 14, 20 get XNR_ITEM_PD
         readkill(.T.)
         getlist:= {}
         set color to 
         get_item3()
         read
         set color to 
         setcursor(0)
         if (LastKey() != K_ESC)
            if (confirme())
               xok:= .T.
               select ITEM_VER
               if (!addrec(5))
                  xok:= .F.
               endif
               if (!xcx2 .AND. xok)
                  select ITEM_VEF
                  if (!addrec(5))
                     xok:= .F.
                     select ITEM_VER
                     delete
                     unlock
                     xok:= .F.
                  endif
               endif
               if (xok)
                  select ITEM_VER
                  gra_itve_r()
                  unlock
                  if (!xcx2)
                     select ITEM_VEF
                     gra_itve_f()
                     unlock
                  endif
                  prod_aca->(dbSetOrder(1))
                  prod_aca->(dbSeek(xco_prod))
                  xdesc_mp:= prod_aca->de_prod
                  AAdd(v_itens, " " + nr_item_pd + "  " + xdesc_mp ;
                     + "  " + Transform(xqt_pe_pro, ;
                     "@E 999,999.99") + "  " + Transform(xval_prod, ;
                     "@E 999,999,999.99") + " ")
               endif
            endif
         endif
         restore screen from Local6
      case Local1 = 13 .AND. xprog_pai != "NUC365"
         if (xcx2 .AND. !vendas_r->editavel)
            ms250("Registro nao pode ser alterado neste MODO. Tecle [ESC]", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
            break
         endif
         save screen to Local6
         set color to (cor[12])
         @ 13,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         Local3:= SubStr(v_itens[Arg2], 2, 2)
         select ITEM_VER
         set order to 1
         seek xnr_ped + Local3
         xteste:= .F.
         if (reclock(5))
            xteste:= .T.
            if (!xcx2)
               select ITEM_VEF
               set order to 1
               seek xnr_ped + Local3
               if (!reclock(5))
                  xteste:= .F.
               endif
            endif
         endif
         if (xteste)
            tra_i_rf()
            setcursor(1)
            tel_item3()
            set color to (cor[3])
            @ 14, 20 get XVAR1 picture "99"
            @ 15, 20 get XCO_PROD picture "9999"
            localiza(xco_prod, "PROD_ACA", 1, "M", "DE_PROD", 15, 25)
            readkill(.T.)
            getlist:= {}
            disp_it3()
            setcursor(1)
            get_item3(.T.)
            read
            setcursor(0)
            set color to 
            if (LastKey() != K_ESC)
               if (confirme())
                  v_itens[Arg2]:= " " + strzero(Arg2, 2) + "  " + ;
                     SubStr(v_itens[Arg2], 7, 30) + "  " + ;
                     Transform(xqt_pe_pro, "@E 999,999.99") + "  " ;
                     + Transform(xval_prod, "@E 999,999,999.99") + " "
                  select ITEM_VER
                  gra_itve_r()
                  if (!xcx2)
                     select ITEM_VEF
                     gra_itve_f()
                  endif
               endif
            endif
         endif
         restore screen from Local6
         setcursor(Local5)
         set color to 
      endcase
   end sequence
   set color to (Local4)
   restscr(Local7)
   return Local2

********************************
procedure NUC3161A

   nome_rel:= ;
      "Relatorio de Clientes Dividido por Estado (Resumido/Individual)"
   set device to printer
   select CLIENTES
   set order to 8
   seek xest_cl
   do while (xest_cl = clientes->est_cl)
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 55 .OR. PRow() = 0)
         cabe("312")
         tab_uf->(dbSetOrder(1))
         tab_uf->(dbSeek(clientes->est_cl))
         @ PRow() + 1,  3 say "Estado:  E" + Trim(tab_uf->nome_uf) + ;
            " " + "F"
         @ PRow() + 2,  3 say ;
            "Codigo  Nome                                       Endereco                                       Bairro                      Cidade"
         @ PRow() + 1,  3 say Replicate("-", 150)
      endif
      @ PRow() + 1,  4 say clientes->cod_cl
      @ PRow(), 11 say clientes->nome_cl
      @ PRow(), 54 say clientes->end_cl
      @ PRow(), 101 say clientes->bairro_cl
      @ PRow(), 129 say clientes->cid_cl
      skip 
   enddo
   @ PRow(), PCol() + 1 say "  P"
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC45

   if (!acesso("NUC45"))
   else
      sinal("CONFIGURA", "IMPRESSORA")
      set color to 
      @ 23,  0 clear
      aviso(24, ;
         "Escolha a Impressora e  tecle <ENTER> p/ confirmar")
      select PRT
      dbCloseArea("PRT")
      _resultado:= print(9, 45, _resultado)
      filemem:= config[8] + "PRINT.MEM"
      save all like _RESULTADO to (filemem)
      return
   endif

********************************
procedure NUC27212

   local Local1, Local2
   Local2:= setcursor()
   parameters xopcao
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Produto Acabado ou tecle <ESC> p/ sair"}
   private xnr_ped, xcod_cl, xco_prod, vet_ped:= {}
   save screen to Local1
   sinal("CONSULTA", "PEDIDO")
   do while (.T.)
      setcursor(1)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      set color to (cor[1])
      window(4, 1, 6, 70, "Ŀ ", .T.)
      xcod_cl:= "     "
      @  5,  3 say "Cliente........:"
      @  5, 20 get XCod_CL picture "@K 99999" valid !Empty(xcod_cl) ;
         .AND. localiza(stz(@xcod_cl), "CLIENTES", 1, "M", ;
         "NOME_CL", 5, 26) when mens_when(mens1[1])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select TAB_VEN
      set order to 1
      select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
      set order to 2
      seek xcod_cl
      if (EOF())
         ms250("Nao existe PEDIDO para este cliente. Tecle [ESC] p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      vet_ped:= {}
      do while (xcod_cl = cod_cl)
         xco_ven:= co_ven
         tab_ven->(dbSeek(xco_ven))
         AAdd(vet_ped, load_ped())
         skip 
      enddo
      set color to (cor[16])
      window(7, 1, 20, 70, "Ŀ ", .T.)
      @  8,  2 say ;
         " Nr. Ped  Dt. Pedido  Nr. NF  Vendedor      Comissao"
      @  9,  2 say Replicate("", 68)
      ms250("[Enter] Mostra Pedido Completo                     [ESC] Termina ", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      achoice(10, 2, 19, 69, vet_ped, Nil, "NUC271221")
      set color to (cor[1])
      setcursor(1)
   enddo
   return

********************************
function REC_ITEM3(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4, Local5, ;
      Local6:= SetColor(), Local7:= setcursor()
   if (Local1 = 27)
      Local2:= 0
   elseif (Local1 = 13)
      setcursor(1)
      set color to (cor[3])
      Local5:= SubStr(v_itens[Arg2], 2, 2)
      Local3:= Val(SubStr(v_itens[Arg2], 63, 10))
      Local4:= Val(SubStr(v_itens[Arg2], 50, 10))
      @ 17 + Arg3, 64 get XVAR1 picture "@E 9999999.99" valid Local3 ;
         <= Local4 when mens_when(mens2[3])
      read
      set color to 
      if (LastKey() != K_ESC)
         v_itens[Arg2]:= SubStr(v_itens[Arg2], 1, 62) + ;
            Transform(Local3, "@E 9999999.99") + " "
         replace vendas_r->dt_em_nf with xdt_em_nf
         replace vendas_r->nr_nf with xnr_nf
         replace vendas_r->prog_prod with .T.
         replace vendas_r->nr_carga with "******"
         replace vendas_r->dt_carga with xdt_em_nf
         item_ver->(dbSetOrder(1))
         item_ver->(dbSeek(xnr_ped + Local5))
         replace item_ver->qt_en_prod with Local3
         if (!xcx2)
            replace vendas_f->dt_em_nf with xdt_em_nf
            replace vendas_f->nr_nf with xnr_nf
            replace vendas_f->prog_prod with .T.
            replace vendas_f->nr_carga with "******"
            replace vendas_f->dt_carga with xdt_em_nf
            item_vef->(dbSetOrder(1))
            item_vef->(dbSeek(xnr_ped + Local5))
            replace item_vef->qt_en_prod with Local3
         endif
      endif
      setcursor(Local7)
      set color to 
      @ 23,  0 say Space(80)
      aviso(24, ;
         "Use as setas p/ escolher o item e tecle <ENTER> p/ receber o mesmo")
      set color to (Local6)
   endif
   return Local2

********************************
procedure NUC27213

   local Local1, Local2
   Local2:= setcursor(1)
   parameters xopcao
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Produto Acabado ou tecle <ESC> p/ sair"}
   private xnr_ped, xcod_cl, xco_prod, vet_ped:= {}
   save screen to Local1
   sinal("CONSULTA", "PEDIDO")
   do while (.T.)
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      set color to (cor[1])
      window(4, 1, 6, 70, "Ŀ ", .T.)
      xco_prod:= "    "
      @  5,  3 say "Materia Prima..:"
      @  5, 20 get XCO_PROD picture "@K 9999" valid !Empty(xco_prod) ;
         .AND. localiza(stz(@xco_prod), "PROD_ACA", 1, "M", ;
         "DE_PROD", 5, 25) when mens_when(mens1[2])
      read
      set color to 
      setcursor(0)
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
      set order to 1
      select CLIENTES
      set order to 1
      select TAB_VEN
      set order to 1
      select (iif(xcx2, "ITEM_VER", "ITEM_VEF"))
      set order to 2
      seek xco_prod
      if (EOF())
         ms250("Nao existe PEDIDO para este Produto. Tecle [ESC] p/ continuar", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      vet_ped:= {}
      do while (xco_prod = co_prod)
         xnr_ped:= nr_ped
         select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
         seek xnr_ped
         xcod_cl:= cod_cl
         xcod_ven:= co_ven
         select CLIENTES
         seek xcod_cl
         select TAB_VEN
         seek xcod_ven
         select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
         AAdd(vet_ped, load_ped())
         select (iif(xcx2, "ITEM_VER", "ITEM_VEF"))
         skip 
      enddo
      set color to (cor[16])
      window(7, 1, 20, 70, "Ŀ ", .T.)
      @  8,  2 say ;
         " Nr. Ped.  Dt. Pedido  Nr. NF   Cliente            Vendedor "
      @  9,  2 say Replicate("", 68)
      ms250("[Enter] Mostra Pedido Completo                     [ESC] Termina ", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      achoice(10, 2, 19, 69, vet_ped, Nil, "NUC272131")
      set color to (cor[1])
      setcursor(1)
   enddo
   return

********************************
procedure TEL_VEND1

   set color to (cor[1])
   window(4, 1, 12, 70, "ͻȺ ", .T.)
   @  5,  3 say "Num. do pedido.:"
   @  6,  3 say ;
      "Pedido anterior:                        Numero da Carga: "
   @  7,  3 say "Cliente........:"
   @  8,  3 say "Data do pedido.:"
   @  9,  3 say "Cond. pagamento:"
   @ 10,  3 say "Codigo Vendedor:"
   @ 11,  3 say "Comissao Vend. :"
   set color to 
   return

********************************
procedure ERRO_LOCK

   ms250("Nao foi possivel gravar o registro. Tecle [ESC] para continuar.", ;
      24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
   return

********************************
procedure NUC2722

   local Local1, Local2
   private mens1:= ;
      {"Digite o Codigo do Cliente ou tecle <ESC> p/ sair", ;
      "Digite o Codigo do Vendedor ou tecle <ESC> p/ sair", ;
      "Digite a Data inicial do Periodo ou tecle <ESC> p/ sair", ;
      "Digite a Data Final do Periodo ou tecle <ESC> p/ sair"}
   private xcod_cl, xdt_ini, xdt_fin, xco_ven, xarqd, xarqi
   xarqd:= newfile("DBF")
   xarqi:= newfile("NTX")
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("RESUMO", "VENDAS")
   tela_res()
   setcursor(1)
   do while (.T.)
      set color to (cor[1])
      ini_res()
      limpa_res()
      set color to (cor[3])
      @  5, 20 get XCod_CL picture "@K 99999" valid Empty(xcod_cl) ;
         .OR. localiza(stz(@xcod_cl), "CLIENTES", 1, "M", "NOME_CL", ;
         5, 26) when mens_when(mens1[1])
      @  7, 20 get XCO_VEN picture "@K 999" valid iif(Empty(xcod_cl) ;
         .OR. !Empty(xco_ven), localiza(stz(@xco_ven), "TAB_VEN", 1, ;
         "M", "NOME_VEN", 7, 25), .T.) .OR. sb() when ;
         mens_when(mens1[2])
      @  9, 20 get XDT_INI valid !Empty(xdt_ini) .AND. xdt_ini <= ;
         Date() .OR. sb() when mens_when(mens1[3])
      @ 11, 20 get XDT_FIN picture "@K" valid xdt_fin >= xdt_ini ;
         .OR. sb() when mens_when(mens1[3]) .AND. (xdt_fin:= ;
         xdt_ini) = xdt_ini
      read
      if (LastKey() == K_ESC)
         set color to (cor[1])
         restore screen from Local1
         return
      endif
      select VENDAS_R
      if (!Empty(xco_ven))
         set order to 4
         if (!Empty(xcod_cl))
            seek xco_ven + xcod_cl
            xtesteloop:= "CO_VEN+Cod_CL = XCO_VEN+XCod_CL"
         else
            seek xco_ven
            xtesteloop:= "CO_VEN = XCO_VEN"
         endif
      else
         set order to 2
         seek xcod_cl
         xtesteloop:= "Cod_CL = XCod_CL"
      endif
      dbcreate(xarqd, {{"NR_PED    ", "C", 6, 0}, {"NOME_CL   ", ;
         "C", 35, 0}, {"NOME_VEN  ", "C", 35, 0}, {"DT_PED    ", ;
         "D", 8, 0}, {"VALOR_PED ", "N", 9, 2}})
      use (xarqd) alias temp new
      tab_ven->(dbSetOrder(1))
      clientes->(dbSetOrder(1))
      item_ver->(dbSetOrder(1))
      select VENDAS_R
      xtotal_res:= 0
      do while (&(xtesteloop))
         if (vendas_r->dt_ped < xdt_ini .OR. vendas_r->dt_ped > ;
               xdt_fin .OR. iif(Empty(xco_ven), .F., ;
               vendas_r->co_ven != xco_ven))
            vendas_r->(dbSkip())
            loop
         endif
         clientes->(dbSeek(vendas_r->cod_cl))
         tab_ven->(dbSeek(vendas_r->co_ven))
         item_ver->(dbSeek(vendas_r->nr_ped))
         xvalor_ped:= 0
         do while (item_ver->nr_ped = vendas_r->nr_ped)
            xvalor_ped:= xvalor_ped + (item_ver->qt_pe_prod + ;
               item_ver->al_icms) * item_ver->val_prod
            item_ver->(dbSkip(1))
         enddo
         temp->(dbAppend())
         replace temp->nr_ped with vendas_r->nr_ped
         replace temp->nome_cl with clientes->nome_cl
         replace temp->nome_ven with tab_ven->nome_ven
         replace temp->dt_ped with vendas_r->dt_ped
         replace temp->valor_ped with xvalor_ped
         xtotal_res:= xtotal_res + xvalor_ped
         vendas_r->(dbSkip(1))
      enddo
      if (temp->(LastRec()) == 0)
         tone(850, 2)
         ms250("Nenhum pedido encontrado neste periodo solicitado. Tecle [ESC] para sair", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         temp->(dbCloseArea())
         loop
      endif
      xvet_campo:= {"NUC27221()", "NUC27222()"}
      xvet_titul:= ;
         {"Nr.Ped.  Data      Nome Cliente                                 Valor", ;
         "Nr.Ped.  Data      Nome Vendedor                                Valor"}
      Local2:= savescr(4, 1, 22, 77)
      window(4, 1, 17, 76, "Ŀ ", .T.)
      window(18, 1, 20, 76, "Ŀ ", .T.)
      ms250("Total dos Pedidos Acima : " + Transform(xtotal_res, ;
         "@EB 999,999,999.99"), 19, 2, Nil, Nil, Nil, Nil, 74, "C")
      ms250("[F8] Detalhamento Pedido   [ENTER] Resumo Pedido  [ESC] Sair", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      select TEMP
      temp->(dbGoTop())
      dbedit(5, 2, 16, 75, xvet_campo, "NUC27223", .T., xvet_titul)
      temp->(dbCloseArea())
      restscr(Local2)
   enddo
   return

********************************
function NUC27223(Arg1, Arg2)

   local Local1:= strzero(LastKey(), 2), Local2:= 1, Local3
   if (!(Local1 $ "13/27/-7") .OR. Arg1 = 0)
      return 1
   endif
   if (Local1 = "27")
      Local2:= 0
      xsair:= .T.
   elseif (Local1 = "13")
      nuc27224()
   elseif (Local1 = "-7")
      Local3:= savescr(3, 0, 24, 79)
      nuc27211(temp->nr_ped, "NUC365")
      restscr(Local3)
      set color to (cor[1])
      select TEMP
   endif
   return Local2

********************************
procedure TELA_RES

   set color to (cor[1])
   window(4, 1, 12, 70, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Cliente.:"
   @  7,  3 say "Codigo Vendedor:"
   @  9,  3 say "Data Inicial...:"
   @ 11,  3 say "Data Final.....:"
   set color to 
   return

********************************
function HD_TO_MIN(Arg1)

   return Int(Arg1) * 60 + Val(SubStr(Str(Arg1, 5, 2), 4, 2))

********************************
procedure NUC2723

   local Local1, Local2
   Local2:= setcursor()
   parameters xxnr_ped
   private mens1:= ;
      {"Digite o Numero do Pedido ou tecle <ESC> p/ sair"}
   private mens2:= ;
      {"Digite a Data da Emissao da Nota Fiscal ou tecle <ESC> p/ sair", ;
      "Digite o Numero da  da Nota Fiscal ou tecle <ESC> p/ sair", ;
      "Digite a Quantidade enviada de Materia Prima ou tecle <ESC> p/ sair"}
   private xnr_ped_o, xnr_ped, xcod_cl, xdt_ped, xdt_em_nf, xnr_nf
   private xco_cpag, xco_ven, xper_comis, xnr_item_p, xco_prod, ;
      xqt_pe_pro
   private xqt_en_pro, xval_prod, xal_icms, xal_ipi
   private v_itens
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("BAIXA", "PEDIDO")
   tel_vend1()
   ini_vend()
   xinicio:= .T.
   do while (xinicio)
      xnr_ped:= Space(6)
      set color to (cor[3])
      setcursor(1)
      if (xxnr_ped != Nil)
         xnr_ped:= xxnr_ped
         xinicio:= .F.
         @  5, 20 get XNR_PED picture "999999"
         readkill(.T.)
         getlist:= {}
      else
         xnr_ped:= 0
         @  5, 20 get XNR_PED picture "999999" valid !Empty(xnr_ped) ;
            when mens_when(mens1[1])
         read
         xnr_ped:= strzero(xnr_ped, 6)
         @  5, 20 get XNR_PED picture "999999" when ;
            mens_when(mens1[1])
         readkill(.T.)
         getlist:= {}
      endif
      if (LastKey() == K_ESC)
         restore screen from Local1
         setcursor(Local2)
         return
      endif
      select VENDAS_R
      set order to 1
      seek xnr_ped
      if (!Found())
         mensagem("Pedido nao encontrado, favor verificar. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      if (!reclock(5))
         mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      if (!xcx2)
         select VENDAS_F
         set order to 1
         seek xnr_ped
         if (Found())
            if (!reclock(5))
               mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
                  27)
               select VENDAS_R
               unlock
               loop
            endif
         else
            mensagem("Pedido nao encontrado, favor verificar.. Tecle <ESC> p/ continuar.", ;
               27)
            select VENDAS_R
            unlock
            loop
         endif
      endif
      select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
      if (!Empty(nr_nf) .AND. xxnr_ped = Nil)
         trans_vend()
         get_vend1()
         readkill(.T.)
         getlist:= {}
         dis_vend1()
         set color to 
         tel_vend2()
         setcursor(1)
         get_vend2()
         readkill(.T.)
         getlist:= {}
         set color to 
         mensagem("Pedido ja foi baixado. Tecle <ESC> p/ continuar.", ;
            27)
         lim_vend1()
         lim_vend2()
         loop
      endif
      select ITEM_VER
      if (fillock(5))
         if (!xcx2)
            select ITEM_VEF
            if (!fillock(5))
               mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
                  27)
               select ITEM_VER
               unlock
               loop
            endif
         endif
      else
         mensagem("Nao foi possivel acesso ao registro deste pedido. Tecle <ESC> p/ continuar.", ;
            27)
         loop
      endif
      select (iif(xcx2, "VENDAS_R", "VENDAS_F"))
      trans_vend()
      get_vend1()
      readkill(.T.)
      getlist:= {}
      dis_vend1()
      set color to 
      tel_vend2()
      setcursor(1)
      get_vend2()
      read
      set color to 
      if (LastKey() == K_ESC)
         lim_vend1()
         lim_vend2()
         loop
      endif
      if (confirme())
         monta_it2()
      endif
      lim_vend1()
      lim_vend2()
      select ITEM_VER
      unlock
      select ITEM_VEF
      unlock
   enddo
   return

********************************
procedure GET_VEND1

   set color to (cor[3])
   @  6, 20 get XNR_PED_O picture "999999"
   @  7, 20 get XCod_CL picture "99999"
   @  8, 20 get XDT_PED picture "@D"
   @  9, 20 get XCO_CPAG picture "999"
   @ 10, 20 get XCO_VEN picture "999"
   @ 11, 20 get XPER_COMIS picture "99.99"
   return

********************************
procedure GET_VEND2

   set color to (cor[3])
   @ 16, 20 get XDT_EM_NF picture "@D" valid xdt_em_nf >= xdt_ped ;
      .AND. xdt_em_nf <= Date() .OR. sb() when mens_when(mens2[1])
   @ 17, 20 get XNR_NF picture "999999" valid !Empty(xnr_nf) .OR. ;
      sb() when mens_when(mens2[2])
   return

********************************
function ACH(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2
   tone(2000, 4)
   @ 24,  0 say Arg1
   InKey(0)
   if (Arg1 = 0 .AND. LastKey() != K_ESC)
      Local2:= 0
   elseif (Local1 = 13)
      Local2:= 0
   endif
   return Local2

********************************
static procedure POSTACTIVE(Arg1)

   getactive(Arg1)
   readvar(getreadvar(Arg1))
   showscoreb()
   return

********************************
procedure NUC31

   local Local1, Local2:= {}, Local3:= {}
   AAdd(Local2, {7, 26, " Ordem Nome Cliente      ", ;
      padc("Imprime relatorio por ordem Alfabetica de Clientes", ;
      80)})
   AAdd(Local2, {8, 26, " Ordem Codigo Cliente    ", ;
      padc("Imprime relatorio por ordem de Codigo dos Clientes", ;
      80)})
   AAdd(Local2, {9, 26, " Dados Completo Clientes ", ;
      padc("Imprime relatorio de Dados Completos dos Clientes", ;
      80)})
   AAdd(Local2, {10, 26, " Etiquetas               ", ;
      padc("Imprime Etiquetas com dados dos Clientes", 80)})
   AAdd(Local2, {11, 26, " Estado Individual       ", ;
      padc("Imprime relatorio de clientes por Estado", 80)})
   AAdd(Local2, {12, 26, " Todos os Estados        ", ;
      padc("Imprime relatorio de clientes em todos os Estados", ;
      80)})
   AAdd(Local2, {13, 26, " Vendedores por Estado   ", ;
      padc("Imprime relatorio de clientes por Vendedores", 80)})
   AAdd(Local2, {14, 26, " Estado Resumido         ", ;
      padc("Imprime relatorio de clientes por Estado (Resumido)", ;
      80)})
   AAdd(Local2, {15, 26, " Clientes por Cidade     ", ;
      padc("Imprime relatorio de clientes por Cidade", 80)})
   AAdd(Local3, {12, 13, " Todos Clientes     ", ;
      padc("Etiquetas para todos os Clientes cadastrados", 80)})
   AAdd(Local3, {13, 13, " Cliente Individual ", ;
      padc("Etiquetas individual por Clientes", 80)})
   AAdd(Local3, {14, 13, " Ajustar Formulario ", ;
      padc("Ajusta o formulario na impressora", 80)})
   private opc_s_etq:= {}
   AAdd(opc_s_etq, {14, 4, " Formul rio 01 fileira  ", ;
      padc("Imprime em formulario de uma fileira", 80)})
   AAdd(opc_s_etq, {15, 4, " Formul rio 02 fileiras ", ;
      padc("Imprime em formulario de duas fileiras", 80)})
   AAdd(opc_s_etq, {16, 4, " Formul rio 03 fileiras ", ;
      padc("Imprime em formulario de tres fileiras", 80)})
   private xcod_cl, tipoform:= 1, xsub_tela1
   etiq_stru:= {{"Cod_CL", "C", 5, 0}, {"NOME_CL", "C", 40, 0}, ;
      {"END_CL", "C", 45, 0}, {"BAIRRO_CL", "C", 25, 0}, {"CID_CL", ;
      "C", 25, 0}, {"EST_CL", "C", 2, 0}, {"CEP_CL", "C", 8, 0}}
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "CLIENTES")
   Local1:= 1
   do while (.T.)
      set color to (cor[14])
      window(6, 25, 16, 51, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case Local1 = 0
         restore screen from xtela1
         return
      case Local1 = 1 .OR. Local1 = 2
         linha_23_2:= SaveScreen(23, 0, 24, 79)
         if (LastKey() != K_ESC)
            t_copias:= qt_copias()
            if (t_copias > 0)
               nuc311(Local1)
            endif
         endif
         restore screen from xtela1
      case Local1 = 3
         t_copias:= qt_copias()
         if (t_copias > 0)
            nuc312()
         endif
         restore screen from xtela1
      case Local1 = 5 .OR. Local1 = 6
         nuc316(iif(Local1 = 5, "I", "T"))
         restore screen from xtela1
      case Local1 = 7
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               nuc317a()
            next
         endif
         restore screen from xtela1
      case Local1 = 8
         nuc316a()
         restore screen from xtela1
      case Local1 = 9
         nuc319()
         restore screen from xtela1
      case Local1 = 4
         m_relat2:= 1
         save screen to sub_tela
         do while (.T.)
            set color to (cor[16])
            window(11, 12, 15, 33, "Ŀ ", .T.)
            m_relat2:= menu_prt(Local3, m_relat2, cor[16], ;
               SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, ;
               At(",", SubStr(cor[16], At(",", cor[16]) + 1)) - 1), ;
               cor[17], SubStr(SubStr(cor[17], At(",", cor[17]) + ;
               1), 1, At(",", SubStr(cor[17], At(",", cor[17]) + 1)) ;
               - 1), 80)
            set color to 
            do case
            case m_relat2 = 0
               restore screen from sub_tela
               exit
            case m_relat2 = 1
               select CONTATOS
               set order to 4
               select CLIENTES
               set order to 2
               if (.T.)
                  set relation to
               endif
               set relation to Cod_CL into CONTATOS
               imp_etique()
               set relation to
               set device to screen
            case m_relat2 = 2
               linha23_4:= SaveScreen(23, 0, 24, 79)
               set color to 
               @ 23,  0 clear
               set color to (cor[1])
               xt_cod_cl:= window(18, 12, 20, 35, "ͻȺ ", .T.)
               @ 19, 13 say " Codigo Cliente:"
               set color to 
               xname_arq:= newfile()
               dbcreate(xname_arq, etiq_stru)
               if (netuse(xname_arq, "ETIQ_CL", "E", "NEW", 5, Nil, ;
                     .T.))
                  foi_digita:= .F.
                  do while (.T.)
                     xcod_cl:= Space(5)
                     set color to (cor[3])
                     @ 19, 30 get XCod_CL picture "@k 99999" valid ;
                        localiza(stz(@xcod_cl), "CLIENTES", 1, "M") ;
                        when ;
                        mens_when("Digite o Codigo do Cliente ou tecle <ESC> p/ sair")
                     read
                     set color to 
                     if (LastKey() == K_ESC)
                        RestScreen(23, 0, 24, 79, linha23_4)
                        restscr(xt_cod_cl)
                        exit
                     endif
                     select CLIENTES
                     set order to 1
                     seek xcod_cl
                     select ETIQ_CL
                     append blank
                     etiq_temp()
                     foi_digita:= .T.
                  enddo
                  if (foi_digita)
                     select CONTATOS
                     set order to 4
                     select ETIQ_CL
                     index on NOME_CL to ETIQ_CL
                     set index to ETIQ_CL
                     if (.T.)
                        set relation to
                     endif
                     set relation to ETIQ_CL->Cod_CL into contatos
                     imp_etique()
                     set device to screen
                     set relation to
                  endif
               endif
               select ETIQ_CL
               close
               erase (xname_arq)
            case m_relat2 = 3
               xteste_etq:= SaveScreen(23, 0, 24, 79)
               @ 23,  0 clear
               if (confirme())
                  set device to printer
                  config_imp()
                  @ PRow() + 1,  1 say "TESTE DE AJUSTE DO FORMULARIO"
                  @ PRow() + 1,  1 say "DE ETIQUETAS"
                  @ PRow() + 1,  1 say ;
                     "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
                  @ PRow() + 1,  1 say ;
                     "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
                  @ PRow() + 1,  1 say ;
                     "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
                  @ PRow() + 1,  1 say " "
                  set device to screen
               endif
               RestScreen(23, 0, 24, 79, xteste_etq)
            endcase
            restore screen from sub_tela
         enddo
         restore screen from xtela1
      endcase
   enddo
   return

********************************
procedure NUC312

   private pg:= 0
   select CLIENTES
   set order to 2
   goto top
   nome_rel:= ;
      "Relatorio de dados completos dos Clientes em ordem (Alfabetica)"
   set device to printer
   cabe("312")
   xconta:= 1
   do while (!EOF())
      imp_client()
      select CLIENTES
      skip 
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC3161

   nome_rel:= "Relatorio de Clientes Dividido por Estado (Individual)"
   set device to printer
   setprc(62, 0)
   for i:= 1 to Len(vet_est)
      select CLIENTES
      set order to 8
      seek vet_est[i]
      if (!Found())
         loop
      endif
      do while (clientes->est_cl = vet_est[i])
         imp_cli316()
         select CLIENTES
         skip 
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
      enddo
      @ 62,  5 say ""
   next
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function DBCLEARIND

   return ordListClear()

********************************
static procedure IMP_ETIQUE

   tipos_etiq()
   @ 23,  0 clear
   if (LastKey() = K_ESC .OR. !confirme())
      restore screen from xsub_tela1
   else
      ms250("Emissao de etiquetas em processamento. Tecle <ESC> p/ cancelar", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      totaldereg:= LastRec()
      reg_corren:= 1
      goto top
      set device to printer
      config_imp()
      do while (!EOF())
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         clear typeahead
         regcorrent:= RecNo()
         nome1:= field->nome_cl
         if (tipoform > 1)
            skip 
            nome2:= field->nome_cl
            if (tipoform > 2)
               skip 
               nome3:= field->nome_cl
            else
               nome3:= ""
            endif
         else
            nome2:= ""
            nome3:= ""
         endif
         @ PRow() + 1,  1 say nome1
         @ PRow(), 62 say nome2
         @ PRow(), 122 say nome3
         @ PRow(),  1 say nome1
         @ PRow(), 62 say nome2
         @ PRow(), 122 say nome3
         goto regcorrent
         nome1:= contatos->contato
         if (tipoform > 1)
            skip 
            nome2:= contatos->contato
            if (tipoform > 2)
               skip 
               nome3:= contatos->contato
            else
               nome3:= ""
            endif
         else
            nome2:= ""
            nome3:= ""
         endif
         @ PRow() + 1,  1 say iif(Empty(nome1), "", "Att: " + nome1)
         @ PRow(), 62 say iif(Empty(nome2), "", "Att: " + nome2)
         @ PRow(), 122 say iif(Empty(nome3), "", "Att: " + nome3)
         goto regcorrent
         nome1:= field->end_cl
         if (tipoform > 1)
            skip 
            nome2:= field->end_cl
            if (tipoform > 2)
               skip 
               nome3:= field->end_cl
            else
               nome3:= ""
            endif
         else
            nome2:= ""
            nome3:= ""
         endif
         @ PRow() + 1,  1 say nome1
         @ PRow(), 62 say nome2
         @ PRow(), 122 say nome3
         goto regcorrent
         nome1:= field->bairro_cl
         if (tipoform > 1)
            skip 
            nome2:= field->bairro_cl
            if (tipoform > 2)
               skip 
               nome3:= field->bairro_cl
            else
               nome3:= ""
            endif
         else
            nome2:= ""
            nome3:= ""
         endif
         @ PRow() + 1,  1 say nome1
         @ PRow(), 62 say nome2
         @ PRow(), 122 say nome3
         goto regcorrent
         nome1:= SubStr(field->cep_cl, 1, 5) + "-" + ;
            SubStr(field->cep_cl, 6, 3) + " - " + ;
            Trim(field->cid_cl) + " - " + field->est_cl
         if (tipoform > 1)
            skip 
            nome2:= SubStr(field->cep_cl, 1, 5) + "-" + ;
               SubStr(field->cep_cl, 6, 3) + " - " + ;
               Trim(field->cid_cl) + " - " + field->est_cl
            if (tipoform > 2)
               skip 
               nome3:= SubStr(field->cep_cl, 1, 5) + "-" + ;
                  SubStr(field->cep_cl, 6, 3) + " - " + ;
                  Trim(field->cid_cl) + " - " + field->est_cl
            else
               nome3:= ""
            endif
         else
            nome2:= ""
            nome3:= ""
         endif
         @ PRow() + 1,  1 say nome1
         @ PRow(), 62 say nome2
         @ PRow(), 122 say nome3
         @ PRow() + 1,  0 say "  "
         skip 
      enddo
      @ 24,  0
      restore screen from xsub_tela1
      return
   endif

********************************
procedure NUC311

   parameters opcao
   private pg:= 0
   select CLIENTES
   if (opcao == 1)
      nome_rel:= "Relatorio de Clientes em ordem de (Alfabetica)"
      set order to 2
   elseif (opcao == 2)
      nome_rel:= "Relatorio de Clientes em ordem de (Codigo)"
      set order to 1
   endif
   goto top
   set device to printer
   cabe("311")
   do while (!EOF())
      @ PRow() + 1,  3 say cod_cl
      @ PRow(), 11 say nome_cl
      if (!Empty(cpf_cl))
         @ PRow(), 55 say cpf_cl picture "@R 99.999.999-99"
      else
         @ PRow(), 55 say cgc_cl picture "@R 99.999.999/9999-99"
      endif
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 57)
         cabe("311")
      endif
      skip 
   enddo
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function __TSETBOTT(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[13]:= _einstvar(qself(), "GOBOTTOMBL", Arg1, "B", 1001)
   endif
   return qself()[13]

********************************
procedure IMP_CLIENT

   if (PRow() > 52)
      eject
      cabe("312")
   endif
   @ PRow() + 1,  3 say "Cliente...: (" + cod_cl + ") " + nome_cl
   @ PRow(),  3 say "            (" + cod_cl + ") " + nome_cl
   @ PRow(), 74 say "C.E.P...: "
   @ PRow(), 84 say cep_cl picture "@R 99999-999"
   @ PRow() + 1,  3 say "Endereco..: " + end_cl
   @ PRow(), 74 say iif(!Empty(fone), "Fone....: " + fone + "  R.:" ;
      + ramal_fone + "  ", "") + iif(!Empty(fax), "FAX.....: " + fax ;
      + "  R.:" + ramal_fax, "")
   @ PRow() + 1,  3 say "Bairro....: " + bairro_cl
   if (!Empty(cpf_cl))
      @ PRow(), 74 say "C.P.F...: "
      @ PRow(), 84 say cpf_cl picture "@R 99.999.999-99"
   else
      @ PRow(), 74 say "C.G.C...: "
      if (!Empty(cgc_cl))
         @ PRow(), 84 say cgc_cl picture "@R 99.999.999/9999-99"
      endif
   endif
   @ PRow() + 1,  3 say "Cidade....: " + Trim(cid_cl) + " " + est_cl
   @ PRow(), 74 say "Inc.Est.: " + insc_estc
   tab_ven->(dbSetOrder(1))
   tab_ven->(dbSeek(clientes->cod_vend))
   @ PRow() + 1,  3 say "Vendedor..: (" + cod_vend + ") " + ;
      tab_ven->nome_ven
   tab_ccl->(dbSetOrder(1))
   tab_ccl->(dbSeek(clientes->cod_cond))
   @ PRow(), 74 say "Cond.Cl.: (" + cod_cond + ") " + ;
      tab_ccl->descricao
   xcod_cl:= cod_cl
   select CONTATOS
   set order to 1
   seek xcod_cl
   beginloop:= .T.
   do while (xcod_cl = cod_cl .AND. !EOF())
      if (PRow() > 60 .OR. beginloop)
         if (!beginloop .OR. PRow() > 60)
            cabe("312")
         endif
         beginloop:= .F.
         @ PRow() + 1,  3 say "Contatos..: " + contato + "  " + ;
            cargo + "  " + setor + "  " + tel_com
         skip 
         loop
      endif
      @ PRow() + 1,  3 say "            " + contato + "  " + cargo + ;
         "  " + setor + "  " + tel_com
      skip 
   enddo
   @ PRow() + 1,  0 say " "
   return

********************************
procedure NUC316

   local Local1
   save screen to Local1
   parameters xopcao
   private pg:= 0, vet_est:= {}
   if (xopcao = "I")
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      set color to (cor[1])
      window(4, 1, 6, 21, "ͻȺ ", .T.)
      @  5,  3 say "Codigo Estado: "
      set color to 
      sinal("RELATORIO", "ESTADO")
      do while (.T.)
         xest_cl:= Space(2)
         set color to (cor[3])
         @  5, 18 get XEST_CL picture "@! AA" valid !Empty(xest_cl) ;
            .AND. localiza(xest_cl, "TAB_UF", 1, "M") when ;
            mens_when("Digite o Codigo do Estado ou tecle <ESC> p/ sair")
         read
         set color to 
         if (LastKey() == K_ESC)
            restore screen from Local1
            if (Len(vet_est) > 0)
               exit
            endif
            return
         endif
         if (ascan(vet_est, xest_cl) == 0)
            AAdd(vet_est, xest_cl)
         else
            tone(850, 1)
            loop
         endif
      enddo
      t_copias:= qt_copias()
      if (t_copias > 0)
         for i:= 1 to t_copias
            nuc3161()
         next
      endif
   else
      t_copias:= qt_copias()
      if (t_copias > 0)
         for i:= 1 to t_copias
            nuc3162()
         next
      endif
   endif
   return

********************************
static procedure IMP_ALFA(Arg1, Arg2, Arg3)

   private _i, _var_letra
   do case
   case Arg1 = "/"
      Arg1:= "aa"
   case Arg1 = "-"
      Arg1:= "ab"
   case Arg1 = "."
      Arg1:= "ac"
   case Arg1 = " "
      Arg1:= "ad"
   endcase
   for _i:= 1 to 6
      _var_letra:= Arg1 + Str(_i, 1)
      @ Arg2 + _i - 1, Arg3 say &_var_letra
   next
   return

********************************
procedure IMP_CLI316

   if (PRow() > 55)
      cabe("316A")
      tab_uf->(dbSetOrder(1))
      tab_uf->(dbSeek(clientes->est_cl))
      @ PRow() + 1,  5 say "Estado: " + prt->imp_lenfat + ;
         Trim(tab_uf->nome_uf) + prt->imp_denfat
      @ PRow() + 1,  5 say ""
   endif
   @ PRow() + 1,  3 say "Cliente...: (" + cod_cl + ") " + nome_cl
   @ PRow(),  3 say "            (" + cod_cl + ") " + nome_cl
   @ PRow(), 74 say "C.E.P...: "
   @ PRow(), 84 say cep_cl picture "@R 99999-999"
   @ PRow() + 1,  3 say "Endereco..: " + end_cl
   @ PRow(), 74 say iif(!Empty(fone), "Fone....: " + fone + "  R.:" ;
      + ramal_fone + "  ", "") + iif(!Empty(fax), "FAX.....: " + fax ;
      + "  R.:" + ramal_fax, "")
   @ PRow() + 1,  3 say "Bairro....: " + bairro_cl
   if (!Empty(cpf_cl))
      @ PRow(), 74 say "C.P.F...: "
      @ PRow(), 84 say cpf_cl picture "@R 99.999.999-99"
   else
      @ PRow(), 74 say "C.G.C...: "
      if (!Empty(cgc_cl))
         @ PRow(), 84 say cgc_cl picture "@R 99.999.999/9999-99"
      endif
   endif
   @ PRow() + 1,  3 say "Cidade....: " + Trim(cid_cl) + " " + est_cl
   @ PRow(), 74 say "Inc.Est.: " + insc_estc
   tab_ven->(dbSetOrder(1))
   tab_ven->(dbSeek(clientes->cod_vend))
   @ PRow() + 1,  3 say "Vendedor..: (" + cod_vend + ") " + ;
      tab_ven->nome_ven
   tab_ccl->(dbSetOrder(1))
   tab_ccl->(dbSeek(clientes->cod_cond))
   @ PRow(), 74 say "Cond.Cl.: (" + cod_cond + ") " + ;
      tab_ccl->descricao
   xcod_cl:= cod_cl
   select CONTATOS
   set order to 1
   seek xcod_cl
   beginloop:= .T.
   do while (xcod_cl = cod_cl .AND. !EOF())
      if (PRow() > 60 .OR. beginloop)
         if (!beginloop .OR. PRow() > 60)
            eject
            cabe("316A")
            tab_uf->(dbSetOrder(1))
            tab_uf->(dbSeek(clientes->est_cl))
            @ PRow() + 1,  5 say "Estado: " + prt->imp_lenfat + ;
               Trim(tab_uf->nome_uf) + prt->imp_denfat
            @ PRow() + 1,  5 say ""
         endif
         beginloop:= .F.
         @ PRow() + 1,  3 say "Contatos..: " + contato + "  " + ;
            cargo + "  " + setor + "  " + tel_com
         skip 
         loop
      endif
      @ PRow() + 1,  3 say "            " + contato + "  " + cargo + ;
         "  " + setor + "  " + tel_com
      skip 
   enddo
   @ PRow() + 1,  0 say " "
   return

********************************
procedure NUC316A

   local Local1
   save screen to Local1
   private pg:= 0, xest_cl
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 6, 21, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Estado: "
   set color to 
   sinal("RELATORIO", "ESTADO")
   do while (.T.)
      xest_cl:= Space(2)
      set color to (cor[3])
      @  5, 18 get XEST_CL picture "@! AA" valid !Empty(xest_cl) ;
         .AND. localiza(xest_cl, "TAB_UF", 1, "M") when ;
         mens_when("Digite o Codigo do Estado ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      t_copias:= qt_copias()
      if (t_copias > 0)
         for ind:= 1 to t_copias
            nuc3161a()
         next
      endif
   enddo
   return

********************************
static procedure NUC3672

   if (pg > 0)
      @ PRow() + 1,  0 say linha1
   endif
   cabe("367")
   @ PRow(),  0 say prt->imp_20cpp
   @ PRow() + 2,  0 say linha1
   @ PRow() + 1,  0 say linha2
   @ PRow() + 1,  0 say linha3
   @ PRow() + 1,  0 say linha4
   return

********************************
procedure IMP_CLI317

   if (PRow() > 55 .OR. PRow() = 0)
      cabe("312")
   endif
   @ PRow() + 1,  3 say "Cliente...: (" + cod_cl + ") " + nome_cl
   @ PRow(),  3 say "            (" + cod_cl + ") " + nome_cl
   @ PRow(), 74 say "C.E.P...: "
   @ PRow(), 84 say cep_cl picture "@R 99999-999"
   @ PRow() + 1,  3 say "Endereco..: " + end_cl
   @ PRow(), 74 say iif(!Empty(fone), "Fone....: " + fone + "  R.:" ;
      + ramal_fone + "  ", "") + iif(!Empty(fax), "FAX.....: " + fax ;
      + "  R.:" + ramal_fax, "")
   @ PRow() + 1,  3 say "Bairro....: " + bairro_cl
   if (!Empty(cpf_cl))
      @ PRow(), 74 say "C.P.F...: "
      @ PRow(), 84 say cpf_cl picture "@R 99.999.999-99"
   else
      @ PRow(), 74 say "C.G.C...: "
      if (!Empty(cgc_cl))
         @ PRow(), 84 say cgc_cl picture "@R 99.999.999/9999-99"
      endif
   endif
   @ PRow() + 1,  3 say "Cidade....: " + Trim(cid_cl) + " " + est_cl
   @ PRow(), 74 say "Inc.Est.: " + insc_estc
   tab_ven->(dbSetOrder(1))
   tab_ven->(dbSeek(clientes->cod_vend))
   @ PRow() + 1,  3 say "Vendedor..: (" + cod_vend + ") " + ;
      tab_ven->nome_ven
   tab_ccl->(dbSetOrder(1))
   tab_ccl->(dbSeek(clientes->cod_cond))
   @ PRow(), 74 say "Cond.Cl.: (" + cod_cond + ") " + ;
      tab_ccl->descricao
   xcod_cl:= cod_cl
   select CONTATOS
   set order to 1
   seek xcod_cl
   beginloop:= .T.
   do while (xcod_cl = cod_cl .AND. !EOF())
      if (PRow() > 60 .OR. beginloop)
         if (!beginloop .OR. PRow() > 60)
            cabe("312")
         endif
         beginloop:= .F.
         @ PRow() + 1,  3 say "Contatos..: " + contato + "  " + ;
            cargo + "  " + setor + "  " + tel_com
         skip 
         loop
      endif
      @ PRow() + 1,  3 say "            " + contato + "  " + cargo + ;
         "  " + setor + "  " + tel_com
      skip 
   enddo
   @ PRow() + 1,  0 say " "
   return

********************************
procedure NUC319

   local Local1
   save screen to Local1
   parameters xopcao
   private pg:= 0, vet_est:= {}
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 8, 44, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Estado: "
   @  7,  3 say "Cidade.......: "
   set color to 
   sinal("RELATORIO", "ESTADO")
   do while (.T.)
      xest_cl:= Space(2)
      xcid_cl:= Space(25)
      set color to (cor[3])
      @  5, 18 get XEST_CL picture "@! AA" valid !Empty(xest_cl) ;
         .AND. localiza(xest_cl, "TAB_UF", 1, "M") when ;
         mens_when("Digite o Codigo do Estado ou tecle <ESC> p/ sair")
      @  7, 18 get XCID_CL picture "@!" when ;
         mens_when("Digite a Cidade ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      t_copias:= qt_copias()
      if (t_copias > 0)
         for i:= 1 to t_copias
            nuc3191()
         next
      endif
   enddo
   return

********************************
procedure TERMOMETRO(Arg1, Arg2, Arg3, Arg4, Arg5)

   @ Arg1 + 1, Int((Arg3 - 6) / 2) + Arg2 say " " + strzero(Int(Arg4 ;
      / Arg5 * 100), 3) + "% "
   if (Int((Arg5 + 1) / 2) >= Arg4)
      @ Arg1, Arg2 say Replicate("", Int(Arg3 * (Arg4 / Arg5) * 2))
   else
      @ Arg1, Arg2 say Replicate("", Arg3)
      @ Arg1, Arg2 say Replicate("", Int(Arg3 * (Arg4 / Arg5 - 0.5) ;
         * 2))
   endif
   return

********************************
procedure IMP_CLI319

   if (PRow() > 55)
      cabe("312")
   endif
   @ PRow() + 1,  3 say "Cliente...: (" + cod_cl + ") " + nome_cl
   @ PRow(),  3 say "            (" + cod_cl + ") " + nome_cl
   @ PRow(), 74 say "C.E.P...: "
   @ PRow(), 84 say cep_cl picture "@R 99999-999"
   @ PRow() + 1,  3 say "Endereco..: " + end_cl
   @ PRow(), 74 say iif(!Empty(fone), "Fone....: " + fone + "  R.:" ;
      + ramal_fone + "  ", "") + iif(!Empty(fax), "FAX.....: " + fax ;
      + "  R.:" + ramal_fax, "")
   @ PRow() + 1,  3 say "Bairro....: " + bairro_cl
   if (!Empty(cpf_cl))
      @ PRow(), 74 say "C.P.F...: "
      @ PRow(), 84 say cpf_cl picture "@R 99.999.999-99"
   else
      @ PRow(), 74 say "C.G.C...: "
      if (!Empty(cgc_cl))
         @ PRow(), 84 say cgc_cl picture "@R 99.999.999/9999-99"
      endif
   endif
   @ PRow() + 1,  3 say "Cidade....: " + Trim(cid_cl) + " " + est_cl
   @ PRow(), 74 say "Inc.Est.: " + insc_estc
   tab_ven->(dbSetOrder(1))
   tab_ven->(dbSeek(clientes->cod_vend))
   @ PRow() + 1,  3 say "Vendedor..: (" + cod_vend + ") " + ;
      tab_ven->nome_ven
   tab_ccl->(dbSetOrder(1))
   tab_ccl->(dbSeek(clientes->cod_cond))
   @ PRow(), 74 say "Cond.Cl.: (" + cod_cond + ") " + ;
      tab_ccl->descricao
   xcod_cl:= cod_cl
   select CONTATOS
   set order to 1
   seek xcod_cl
   beginloop:= .T.
   do while (xcod_cl = cod_cl .AND. !EOF())
      if (PRow() > 60 .OR. beginloop)
         if (!beginloop .OR. PRow() > 60)
            eject
            cabe("312")
         endif
         beginloop:= .F.
         @ PRow() + 1,  3 say "Contatos..: " + contato + "  " + ;
            cargo + "  " + setor + "  " + tel_com
         skip 
         loop
      endif
      @ PRow() + 1,  3 say "            " + contato + "  " + cargo + ;
         "  " + setor + "  " + tel_com
      skip 
   enddo
   @ PRow() + 1,  0 say " "
   return

********************************
procedure NUC32

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {8, 51, " Ordem Nome Fornecedor   ", ;
      padc("Imprime relatorio por ordem de Alfabetica de Fornecedores", ;
      80)})
   AAdd(Local2, {9, 51, " Ordem Codigo Fornecedor ", ;
      padc("Imprime relatorio por ordem de Codigo dos Fornecedores", ;
      80)})
   AAdd(Local2, {10, 51, " Dados Completos Fornec. ", ;
      padc("Imprime relatorio com dados completos dos Fornecedores", ;
      80)})
   private tela_qt, nome_rel, xtela1
   save screen to xtela1
   sinal("SUB-MENU", "FORNECED.")
   Local1:= 1
   do while (.T.)
      set color to (cor[14])
      window(7, 50, 11, 76, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      if (Local1 = 0)
         restore screen from xtela1
         return
      elseif (Local1 = 3)
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               nuc322()
            next
         endif
         restore screen from xtela1
      else
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               nuc321(Local1)
            next
         endif
         restore screen from xtela1
      endif
   enddo
   return

********************************
static function DECTOBIN(Arg1)

   return iif(Arg1 > 1, Str(Arg1 % 2, 1) + dectobin(Int(Arg1 / 2)), ;
      Str(Arg1, 1))

********************************
procedure NUC322

   private pg:= 0
   select FORNECED
   set order to 2
   goto top
   nome_rel:= ;
      "Relatorio de dados completos dos Fornecedores em ordem (Alfabetica)"
   set device to printer
   cabe("322")
   xconta:= 1
   do while (!EOF())
      @ PRow() + 1,  3 say "Fornecedor: (" + cod_fo + ") " + nome_fo
      @ PRow(), 74 say "CEP.....: "
      @ PRow(), 84 say cep_fo picture "@R 99999-999"
      @ PRow() + 1,  3 say "Endereco..: " + end_fo
      @ PRow(), 74 say "Fone/Fax: " + iif(!Empty(fone), "[Fone]-" + ;
         fone + " ", "") + iif(!Empty(fax), "[FAX]-" + fax, "")
      xbairro_fo:= Trim(bairro_fo)
      xbairro_fo:= xbairro_fo + iif(!Empty(cid_fo), ;
         iif(!Empty(xbairro_fo), " - ", "") + Trim(cid_fo), "")
      xbairro_fo:= xbairro_fo + iif(!Empty(est_fo), ;
         iif(!Empty(xbairro_fo), " - ", "") + Trim(est_fo), "")
      @ PRow() + 1,  3 say "Complem...: " + xbairro_fo
      @ PRow(), 74 say "CGC.....: "
      @ PRow(), 84 say cgc_fo picture "@R 99.999.999/9999-99"
      @ PRow() + 1,  3 say "Prod. Com.: " + SubStr(pr_fo, 1, 119)
      @ PRow() + 1,  3 say "            " + SubStr(pr_fo, 120)
      @ PRow() + 1,  3 say "Contato...: " + telex
      @ PRow(), 74 say "Ins.Est.: " + insc_estf
      @ PRow() + 1,  3 say Replicate("-", 131)
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      xconta:= xconta + 1
      if (xconta >= 8 .AND. !EOF())
         eject
         cabe("322")
         xconta:= 1
      endif
      skip 
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC33

   local Local1, Local2, Local3:= {}, Local4:= {}
   AAdd(Local4, "NUC331MOE")
   AAdd(Local4, "NUC331IND")
   AAdd(Local4, "NUC331CGF")
   AAdd(Local4, "NUC331CCL")
   AAdd(Local4, "NUC331UNI")
   AAdd(Local4, "NUC331CPA")
   AAdd(Local4, "NUC331TRA")
   AAdd(Local4, "NUC332VEN")
   AAdd(Local4, "NUC331SET")
   AAdd(Local3, {9, 54, " Moedas               ", ;
      padc("Imprime relatorio de Moedas", 80)})
   AAdd(Local3, {10, 54, " Indices de Correcao  ", ;
      padc("Imprime relatorio de Indices de Correcao", 80)})
   AAdd(Local3, {11, 54, " Custo Geral de Fab.  ", ;
      padc("Imprime relatorio de Custo Geral de Fabricacao", 80)})
   AAdd(Local3, {12, 54, " Cond. do Cliente     ", ;
      padc("Imprime relatorio de Cond. de Clientes", 80)})
   AAdd(Local3, {13, 54, " Unidade de Medida    ", ;
      padc("Imprime relatorio de Unidade de Medida", 80)})
   AAdd(Local3, {14, 54, " Cond. de Pagamento   ", ;
      padc("Imprime relatorio de Cond. de Pagamento", 80)})
   AAdd(Local3, {15, 54, " Transportadores      ", ;
      padc("Imprime relatorio de Transportadores", 80)})
   AAdd(Local3, {16, 54, " Vendedores           ", ;
      padc("Imprime relatorio de Vendedores", 80)})
   AAdd(Local3, {17, 54, " Setores              ", ;
      padc("Imprime relatorio de Setores", 80)})
   private tela_qt
   save screen to Local1
   sinal("SUB-MENU", "TABELAS")
   Local2:= 1
   do while (.T.)
      set color to (cor[14])
      window(8, 53, 18, 76, "Ŀ ", .T.)
      Local2:= menu_prt(Local3, Local2, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      if (Local2 = 0)
         restore screen from Local1
         return
      elseif (Local2 = 8)
         if (acesso(Local4[Local2]))
            t_copias:= qt_copias()
            if (t_copias > 0)
               for i:= 1 to t_copias
                  nuc332(Local2)
               next
            endif
            restore screen from Local1
         endif
      elseif (acesso(Local4[Local2]))
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               nuc331(Local2)
            next
         endif
         restore screen from Local1
      endif
   enddo
   return

********************************
procedure NUC342

   private pg:= 0
   select CONTATOS
   set order to 1
   goto top
   set device to printer
   nome_rel:= "Relatorio de Contatos por periodo"
   cabe("352", xinicio, xfinal)
   do while (!EOF())
      if (SubStr(DToS(data_nasc), 5, 4) >= xini_ani .AND. ;
            SubStr(DToS(data_nasc), 5, 4) <= xfin_ani)
         @ PRow() + 1,  3 say cod_cl
         @ PRow(), 12 say contato
         @ PRow(), 52 say data_nasc
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         if (PRow() > 60)
            eject
            cabe("352", xinicio, xfinal)
         endif
      endif
      skip 
   enddo
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC46

   menu_psw("NUC", 12, 51)
   return

********************************
procedure NUC331

   parameters xopcao
   private pg:= 0
   private vet_alias:= {}
   AAdd(vet_alias, {"TAB_MOE", "Moedas"})
   AAdd(vet_alias, {"TAB_IND", "Indices"})
   AAdd(vet_alias, {"TAB_CGF", "Fornecedores"})
   AAdd(vet_alias, {"TAB_CCL", "Condicao do Cliente"})
   AAdd(vet_alias, {"TAB_UNI", "Unidade"})
   AAdd(vet_alias, {"TAB_CPA", "Condicoes de Pagamento"})
   AAdd(vet_alias, {"TAB_TRA", "Transportadores"})
   AAdd(vet_alias, {"TAB_VEN", "Vendedores"})
   AAdd(vet_alias, {"TAB_SET", "Setores"})
   select (vet_alias[xopcao][1])
   set order to 2
   goto top
   set device to printer
   nome_rel:= "Relatorio de Tabela de " + vet_alias[xopcao][2]
   cabe("331")
   do while (!EOF())
      @ PRow() + 1,  2 say codigo
      @ PRow(),  8 say descricao
      @ PRow(), 40 say complement
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 60)
         eject
         cabe("331")
      endif
      skip 
   enddo
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC37211

   select VENDAS_R
   @ PRow() + 1,  2 say prt->imp_lenfat
   @ PRow(),  2 say nr_ped
   @ PRow(), 10 say nr_ped_o
   @ PRow(), 20 say dt_ped
   @ PRow(), 32 say clientes->cod_cl + " " + Trim(clientes->nome_cl) ;
      + " - " + clientes->cid_cl + "   " + clientes->est_cl + ;
      prt->imp_denfat
   @ PRow() + 2,  2 say prt->imp_lenfat + ;
      "Item Descricao do Produto           Qtd. Pedida   Preco Unit.    Preco Total" ;
      + prt->imp_denfat
   select ITEM_VER
   return

********************************
procedure NUC332

   private pg:= 0
   select TAB_VEN
   set order to 1
   goto top
   nome_rel:= ;
      "Relatorio de dados completos dos Vendedores em ordem (Alfabetica)"
   set device to printer
   cabe("332")
   xconta:= 1
   do while (!EOF())
      @ PRow() + 1,  2 say "Vendedores: (" + tab_ven->cod_ven + ") " ;
         + tab_ven->nome_ven
      @ PRow(),  2 say "            (" + tab_ven->cod_ven + ") " + ;
         tab_ven->nome_ven
      @ PRow(), 72 say "CEP.....: "
      @ PRow(), 82 say tab_ven->cep_ven picture "@R 99999-999"
      @ PRow() + 1,  2 say "Endereco..: " + tab_ven->end_ven
      @ PRow(), 72 say "Fone/Fax: " + iif(!Empty(tab_ven->fone), ;
         "[Fone]-" + tab_ven->fone + "  R.:" + tab_ven->ramal_fone + ;
         " ", "") + iif(!Empty(tab_ven->fax), "[FAX]-" + ;
         tab_ven->fax + "  R.:" + tab_ven->ramal_fax, "")
      @ PRow() + 1,  2 say "Bairro....: " + tab_ven->bairro_ven
      @ PRow(), 72 say "CPF.....: "
      @ PRow(), 82 say tab_ven->cpf_ven picture "@R 99.999.999-99" + ;
         prt->imp_10cpp
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      @ PRow() + 1,  2 say Replicate("_", 130) + prt->imp_12cpp
      skip 
      if (PRow() > 54 .AND. !EOF())
         eject
         cabe("332")
      endif
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure ERRO_FILE

   ms250("Nao foi localizado todos os arquivos do sistema. Tecle [ESC] para terminar.", ;
      24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
   set color to 
   closedata("ALL")
   clear screen
   quit

********************************
procedure NUC34

   local Local1, Local2, Local3, Local4
   Local4:= {}
   AAdd(Local4, {11, 51, " Por Clientes (Indiv.)  ", ;
      padc("Imprime relatorio de contato individual por cliente", ;
      80)})
   AAdd(Local4, {12, 51, " Faixa data Aniversario ", ;
      padc("Imprime relatorio pela faixa de aniversario do contato", ;
      80)})
   AAdd(Local4, {13, 51, " Dividido por Clientes  ", ;
      padc("Imprime relatorio de contato divididual por clientes", ;
      80)})
   private tela_qt, xcod_cl, pos, xinicio, xfinal, xini_ani, xfin_ani
   save screen to Local1
   sinal("SUB-MENU", "CONTATOS")
   select CLIENTES
   set order to 1
   select CONTATOS
   set order to 1
   Local2:= 1
   do while (.T.)
      set color to (cor[14])
      window(10, 50, 14, 75, "Ŀ ", .T.)
      Local2:= menu_prt(Local4, Local2, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case Local2 = 1
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 6, 24, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         set color to 
         do while (.T.)
            xcod_cl:= Space(5)
            set color to (cor[3])
            @  5, 19 get XCod_CL picture "99999" valid ;
               localiza(stz(@xcod_cl), "CLIENTES", 1, "M") when ;
               mens_when("Digite o Codigo do Cliente ou tecle <ESC> p/ sair")
            read
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            select CONTATOS
            seek xcod_cl
            if (!Found())
               mensagem("Nao existe contato cadastrado para este Cliente. Tecle <ESC>.", ;
                  27)
               loop
            endif
            pos:= RecNo()
            exit
         enddo
         if (!Empty(xcod_cl))
            t_copias:= qt_copias()
            if (t_copias > 0)
               for i:= 1 to t_copias
                  nuc341()
               next
            endif
         endif
         restore screen from Local1
      case Local2 = 2
         tela_perio()
         if (LastKey() != K_ESC)
            select contatos
            set order to 3
            goto top
            localizou:= .F.
            xini_ani:= SubStr(DToS(xinicio), 5, 4)
            xfin_ani:= SubStr(DToS(xfinal), 5, 4)
            do while (!EOF())
               if (SubStr(DToS(data_nasc), 5, 4) >= xini_ani .AND. ;
                     SubStr(DToS(data_nasc), 5, 4) <= xfin_ani)
                  localizou:= .T.
                  exit
               endif
               skip 
            enddo
            if (!localizou)
               mensagem("Atencao ! Nenhum Contato encontrado neste periodo, Tecle <ESC> p/ continuar.", ;
                  27)
            endif
            if (!Empty(xinicio) .AND. !Empty(xfinal) .AND. localizou)
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     nuc342()
                  next
               endif
            endif
         endif
         restore screen from Local1
      case Local2 = 3
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               nuc343()
            next
         endif
         restore screen from Local1
      case Local2 = 0
         restore screen from Local1
         return
      endcase
   enddo
   return

********************************
function CONV_MOEDA(Arg1, Arg2)

   set decimals to 10
   valor:= Arg1 / Arg2
   valor:= Str(valor, 25, 10)
   valor:= SubStr(valor, 1, 17)
   valor:= SubStr(valor, 1, 14) + SubStr(valor, 16, 2)
   set decimals to 2
   valor:= Val(valor) / 100
   return valor

********************************
procedure FUNC0030


********************************
procedure TELA_PERIO

   set century off
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 8, 27, "ͻȺ ", .T.)
   @  5,  3 say "Data Inicio: "
   @  6,  2 to  6, 26
   @  7,  3 say "Data Final.: "
   xinicio:= xfinal:= CToD(Space(8))
   set color to (cor[3])
   @  5, 16 get XINICIO picture "@D" valid !Empty(xfinal:= xinicio) ;
      when mens_when("Digite " + ;
      "a data de inicio do periodo ou tecle <ESC> " + "p/ sair.")
   @  7, 16 get XFINAL picture "@D" valid xfinal >= xinicio .OR. ;
      !Empty(xfinal) when mens_when("Digite a data " + ;
      "final do periodo ou tecle <ESC> p/ sair.")
   read
   set color to 
   return

********************************
procedure NUC341

   private pg:= 0
   set device to printer
   nome_rel:= "Relatorio de Contatos (Individual por Cliente)"
   select CLIENTES
   set order to 1
   seek xcod_cl
   xnome_cl:= nome_cl
   select CONTATOS
   set order to 1
   goto pos
   cabe("353")
   do while (!EOF())
      if (cod_cl = xcod_cl)
         @ PRow() + 1,  2 say contato
         @ PRow(), 40 say data_nasc
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         if (PRow() > 60)
            eject
            cabe("353")
         endif
      endif
      skip 
   enddo
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function __TCOLUMN(Arg1)

   return qself()[6][Arg1]

********************************
procedure NUC343

   private pg:= 0
   select CLIENTES
   set order to 1
   goto top
   select CONTATOS
   set order to 1
   goto top
   set device to printer
   nome_rel:= "Relatorio de Contatos dividido por Clientes"
   cabe("351")
   do while (!EOF())
      xcod_cl:= cod_cl
      select CLIENTES
      seek xcod_cl
      xnome_cl:= nome_cl
      @ PRow() + 2,  2 say "Cliente: " + prt->imp_lenfat + ;
         Trim(xnome_cl) + " - (" + xcod_cl + ")" + prt->imp_denfat
      @ PRow() + 1,  2 say ""
      select CONTATOS
      do while (cod_cl = xcod_cl .AND. !EOF())
         @ PRow() + 1,  2 say contato
         @ PRow(), 42 say data_nasc
         skip 
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         if (PRow() > 58)
            eject
            cabe("351")
            if (cod_cl = xcod_cl)
               @ PRow() + 2,  2 say "Cliente: " + ptr->imp_lenfat
               @ PRow(), 13 say Trim(xnome_cl) + " - (" + xcod_cl + ;
                  ")" + prt->imp_denfat
               @ PRow() + 1,  2 say ""
            endif
         endif
      enddo
   enddo
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure MV_HLP_ON(Arg1)

   SetKey(K_F1, Nil)
   set key K_ALT_UP to move_help
   set key K_ALT_LEFT to move_help
   set key K_ALT_RIGHT to move_help
   set key K_ALT_DOWN to move_help
   if (Arg1 = Nil)
      set key K_ALT_PGUP to move_help
      set key K_ALT_PGDN to move_help
      set key K_ALT_HOME to move_help
      set key K_ALT_END to move_help
   else
   endif
   return

********************************
procedure NUCIND


********************************
procedure NUC35

   local Local1
   Local1:= {}
   AAdd(Local1, {10, 31, " Bancos               ", ;
      padc("Relacao de Bancos", 80)})
   AAdd(Local1, {11, 31, " Movimento Bancario   ", ;
      padc("Movimento Bancario", 80)})
   AAdd(Local1, {12, 31, " Contas a Receber     ", ;
      padc("Contas a Receber", 80)})
   AAdd(Local1, {13, 31, " Contas a Pagar       ", ;
      padc("Contas a Pagar", 80)})
   AAdd(Local1, {14, 31, " Emprestimos          ", ;
      padc("Emprestimos", 80)})
   AAdd(Local1, {15, 31, " Indices Financeiros  ", ;
      padc("Indices Financeiros", 80)})
   AAdd(Local1, {16, 31, " Moedas               ", ;
      padc("Moedas Indexadoras", 80)})
   AAdd(Local1, {17, 31, " Fluxo de Caixa       ", ;
      padc("Fluxo de Caixa por periodo", 80)})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "CLIENTES")
   m_clientes:= 1
   do while (.T.)
      restore screen from xtela1
      set color to (cor[14])
      window(9, 30, 18, 53, "Ŀ ", .T.)
      m_clientes:= menu_prt(Local1, m_clientes, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_clientes = 1
         if (acesso("erro"))
         endif
      case m_clientes = 2
         if (acesso("NUC352"))
            nuc352()
         endif
      case m_clientes = 3
         if (acesso("NUC353"))
            nuc353()
         endif
      case m_clientes = 4
         if (acesso("NUC354"))
            nuc354()
         endif
      case m_clientes = 5
         if (acesso("NUC355"))
            nuc355()
         endif
      case m_clientes = 6
         if (acesso("erro"))
         endif
      case m_clientes = 7
         if (acesso("erro"))
         endif
      case m_clientes = 8
         if (acesso("NUC358"))
            nuc358()
         endif
      case m_clientes = 0
         commit
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure NUC3921(Arg1)

   private pg:= 0
   select MP_R
   set order to Arg1
   goto top
   nome_rel:= iif(Arg1 = 1, "Ordem de Codigo da Materia Prima", ;
      "Ordem Alfabetica da Materia Prima")
   set device to printer
   cabe("3921")
   do while (!EOF())
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() >= 56)
         eject
         cabe("3921")
      endif
      @ PRow() + 1,  2 say co_mp + "  " + de_mp + "  " + co_unid
      @ PRow(), 54 say est_mp_at picture "99999999.99"
      @ PRow(), 68 say est_mp_mi picture "99999999.99"
      @ PRow(), 82 say ult_p_mp picture "@E 9,999,999.999999"
      if (xcx2)
         @ PRow(), 101 say est_mp_max picture "99999999.99"
      endif
      skip 
   enddo
   @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_10cpp, "")
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function DIG11C(Arg1)

   local Local1:= 0, Local2:= Len(Arg1), Local3
   for Local3:= 1 to Local2
      Local1:= Local1 + Val(SubStr(Arg1, Local3, 1)) * (Local2 + 2 - ;
         Local3)
   next
   Local3:= 11 - Local1 % 11
   return iif(Local3 < 10, Str(Local3, 1), iif(Local3 = 10, "X", "0"))

********************************
function VERERRO

   errorblock({|_1| mostraerro(_1)})
   return Nil

********************************
procedure NUC352

   local Local1
   save screen to Local1
   private pg:= 0, virou_sald:= .F., xcod_nosso, xdata_f, xdata_i, ;
      xtela_ext, xsaldo_b:= xsaldo_c:= xtot_c:= xtot_d:= 0
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 9, 31, "ͻȺ ", .T.)
   @  5,  3 say "Codigo do Banco:"
   @  6,  2 to  6, 30
   @  7,  3 say "Inicio periodo :"
   @  8,  3 say "Final  periodo :"
   set color to 
   sinal("RELATORIO", "EXTRATO")
   do while (.T.)
      xcod_nosso:= Space(3)
      xdata_i:= xdata_f:= CToD(Space(8))
      set color to (cor[3])
      @  5, 20 get XCOD_NOSSO picture "999" valid ;
         localiza(stz(@xcod_nosso), "BANCOS", 4, "M") when ;
         mens_when("Digite o Codigo interno do Banco ou tecle <ESC> p/ sair")
      @  7, 20 get XDATA_I picture "@D" valid xdata_i <= Date() when ;
         mens_when("Digite a data inicio do periodo ou tecle <ESC> p/ sair")
      @  8, 20 get XDATA_F picture "@D" valid xdata_f >= xdata_i ;
         when ;
         mens_when("Digite a data final do periodo ou tecle <ESC> p/ sair") ;
         .AND. (xdata_f:= xdata_i) = xdata_f
      read
      set color to 
      if (LastKey() != K_ESC)
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               extrato_ba()
            next
         endif
      endif
      restore screen from Local1
      exit
   enddo
   return

********************************
init procedure SDFINIT

   rddregiste("SDF", 2)
   return

********************************
static procedure EXTRATO_BA

   select BANCOS
   set order to 4
   seek xcod_nosso
   xnome_ban:= nome_ban
   select SALDO
   set order to 1
   set softseek on
   seek xcod_nosso + DToS(xdata_i)
   skip -1
   if (BOF() .OR. xcod_nosso != cod_nosso)
      xsaldo_ant:= xsaldo:= 0
      xdata_ant:= xdata_i
   else
      xsaldo_ant:= xsaldo:= val_saldo
      xdata_ant:= dat_saldo
   endif
   select EXTRATO
   set order to 1
   seek xcod_nosso + DToS(xdata_i)
   set softseek off
   set device to printer
   nome_rel:= "Extrato Bancario"
   cabe("34", xdata_i, xdata_f)
   @ PRow() + 1,  2 say DToC(xdata_ant) + "  Saldo anterior" + ;
      Space(51) + Transform(xsaldo, "@E 9,999,999,999.99")
   @ PRow(),  2 say DToC(xdata_ant) + "  Saldo anterior" + Space(51) ;
      + Transform(xsaldo, "@E 9,999,999,999.99")
   xdat_lanca:= dat_lanca
   xdata_carc:= Space(8)
   xdata_carc:= DToC(dat_lanca)
   do while (dat_lanca >= xdata_i .AND. dat_lanca <= xdata_f .AND. ;
         cod_nosso = xcod_nosso)
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      xdat_lanca:= dat_lanca
      if (d_c_lanca = "D")
         xtot_d:= xtot_d + val_lanca
         xsaldo:= xsaldo - val_lanca
         xsaldo_c:= xsaldo_c + iif(bloqueado = "N", val_lanca, 0)
      else
         xtot_c:= xtot_c + val_lanca
         xsaldo:= xsaldo + val_lanca
         xsaldo_b:= xsaldo_b + iif(bloqueado = "S", val_lanca, 0)
      endif
      if (PRow() >= 60)
         @  0,  0 say prt->imp_10cpp
         cabe("34", xdata_i, xdata_f)
      endif
      @ PRow() + 1,  2 say xdata_carc + " " + SubStr(historico, 1, ;
         35) + " " + nr_doc + " " + d_c_lanca + " " + iif(d_c_lanca ;
         = "C", iif(bloqueado = "S", "BL", "  "), iif(bloqueado = ;
         "N", "NC", "  ")) + " " + Transform(val_lanca, ;
         "@E 99,999,999.99") + "   " + Transform(xsaldo, ;
         "@E 999,999,999.99")
      if (!Empty(SubStr(historico, 36, 35)))
         @ PRow() + 1,  2 say "         " + SubStr(historico, 36, 35)
      endif
      xdata_carc:= Space(8)
      skip 
      if (dat_lanca != xdat_lanca)
         xdata_carc:= DToC(dat_lanca)
         @ PRow() + 1,  0 say " "
      endif
      if (!virou_sald)
         if (xdata_i < data_virad .AND. xdata_f > data_virad - 1)
            if (dat_lanca > data_virad - 1)
               xsaldo:= conv_moeda(xsaldo, valor_vira)
               virou_sald:= .T.
               @ PRow() + 1,  2 say DToC(data_virad - 1) + ;
                  "  ATUALIZACAO MONETARIA              " + ;
                  Space(27) + Transform(xsaldo, ;
                  "@E 9,999,999,999,999.99")
               @ PRow(),  2 say DToC(data_virad - 1) + ;
                  "  ATUALIZACAO MONETARIA              " + ;
                  Space(27) + Transform(xsaldo, ;
                  "@E 9,999,999,999,999.99")
               @ PRow(),  2 say DToC(data_virad - 1) + ;
                  "  ATUALIZACAO MONETARIA              " + ;
                  Space(27) + Transform(xsaldo, ;
                  "@E 9,999,999,999,999.99")
               @ PRow() + 1,  0 say " "
            endif
         endif
      endif
   enddo
   @  0,  0 say prt->imp_10cpp
   cabe("000", xdata_i, xdata_f)
   @ PRow() + 2,  2 say "Saldo Anterior em " + DToC(xdata_ant) + ;
      ".....(A) :" + Transform(xsaldo_ant, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Total de Debitos  no Periodo...(B) :" + ;
      Transform(xtot_d, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Total de Creditos no Periodo...(C) :" + ;
      Transform(xtot_c, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Saldo da Conta no Periodo......(D) :" + ;
      Transform(xsaldo, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Valor Bloqueado................(E) :" + ;
      Transform(xsaldo_b, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Valor a Compensar..............(F) :" + ;
      Transform(xsaldo_c, "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Saldo no Banco.............(D-E+F) :" + ;
      Transform(xsaldo - xsaldo_b + xsaldo_c, ;
      "@E 9,999,999,999,999.99")
   @ PRow() + 2,  2 say "Saldo Disponivel.............(D-E) :" + ;
      Transform(xsaldo - xsaldo_b, "@E 9,999,999,999,999.99")
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function CAD_VALOR(Arg1, Arg2)

   local Local1:= savescr(9, 17, 24, 57), Local2:= SetColor(cor[6]), ;
      Local3:= " ", Local4:= Set(_SET_DEVICE, "SCREEN")
   window(9, 24, 16, 55, "ͻȺ ", .T.)
   set color to (cor[7])
   @ 10, 25 say padc(config[2], 30)
   set color to (cor[6])
   @ 11, 25 say " O valor " + iif(Arg1 = "MO", "da MOEDA ", ;
      "do INDICE") + " necessario"
   if (Arg2 = "C")
      @ 12, 25 say " para o calculo  em andamento "
   else
      @ 12, 25 say " a  emissao  deste  relatorio "
   endif
   @ 13, 25 say " nao  esta cadastrado, deseja "
   @ 14, 25 say " cadastrar neste momento.     "
   @ 15, 25 say "        Sim/Nao ?             "
   set color to (cor[3])
   @ 15, 43 get xopc picture "@!A" valid Local3 $ "SN"
   read
   set color to (Local2)
   restscr(Local1)
   Set(_SET_DEVICE, Local4)
   return iif(LastKey() = K_ESC, "N", Local3)

********************************
init procedure INITHANDL

   local Local1
   Local1:= errorblock({|_1| lockerrhan(_1, Local1)})
   return

********************************
procedure NUC353

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {13, 51, " Abertas por periodo    ", ;
      "Duplicatas abertas por periodo"})
   AAdd(Local2, {14, 51, " Encerradas por periodo ", ;
      "Duplicatas Encerradas por periodo"})
   AAdd(Local2, {15, 51, " Geral por Clientes     ", ;
      "Duplicatas em Geral por Clientes e Periodo"})
   private xtela1
   private xinicio, xfinal, xcod_cl
   save screen to xtela1
   sinal("SUB-MENU", "DUPL. REC.")
   Local1:= 1
   do while (.T.)
      set color to (cor[16])
      window(12, 50, 16, 75, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case Local1 = 1
         tela_perio()
         if (!Empty(xinicio) .AND. !Empty(xfinal))
            t_copias:= qt_copias()
            if (t_copias > 0)
               for i:= 1 to t_copias
                  nuc3531()
               next
            endif
         endif
         restore screen from xtela1
      case Local1 = 2
         tela_perio()
         if (!Empty(xinicio) .AND. !Empty(xfinal))
            t_copias:= qt_copias()
            if (t_copias > 0)
               for i:= 1 to t_copias
                  nuc3532()
               next
            endif
         endif
         restore screen from xtela1
      case Local1 = 3
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 9, 28, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         @  6,  2 to  6, 27
         @  7,  3 say "Inicio........:"
         @  8,  3 say "Final.........:"
         set color to 
         xcod_cl:= Space(5)
         set color to (cor[3])
         @  5, 19 get XCod_CL picture "@k 99999" valid ;
            localiza(stz(@xcod_cl), "CLIENTES", 1, "M") when ;
            mens_when("Digite o Codigo do " + ;
            "Cliente ou tecle <ESC> p/ sair")
         read
         xinicio:= xfinal:= CToD(Space(8))
         if (LastKey() != K_ESC)
            set color to (cor[3])
            @  7, 19 get XINICIO picture "@!" valid !Empty(xinicio) ;
               when mens_when("Digite " + ;
               "a data de inicio do periodo ou tecle <ESC> " + ;
               "p/ sair.")
            @  8, 19 get XFINAL picture "@!" valid xfinal >= xinicio ;
               .OR. !Empty(xfinal) when mens_when("Digite a data " ;
               + "final do periodo ou tecle <ENTER> p/ voltar")
            read
            set color to 
            if (!Empty(xinicio) .AND. !Empty(xfinal))
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     nuc3533()
                  next
               endif
            endif
         endif
         restore screen from xtela1
      case Local1 = 0
         restore screen from xtela1
         exit
      endcase
   enddo
   return

********************************
function FCOD_VEN(Arg1, Arg2)

   if (Arg2 = Nil)
      Arg2:= 13
   endif
   if (Empty(Arg1))
      return .F.
   else
      tab_ven->(dbSetOrder(1))
      tab_ven->(dbSeek(Arg1))
      xnome_ven:= tab_ven->nome_ven
      if (tab_ven->(Found()))
         @ Arg2, 30 say xnome_ven color cor[2]
         return .T.
      else
         mensagem("Codigo nao encontrado. P/ continuar tecle [ESC].", ;
            27)
         Arg1:= Space(3)
         return .F.
      endif
   endif

********************************
procedure NUC3531

   local Local1
   private pg:= xtotal:= xtot_b:= xtot_c:= 0
   set device to printer
   nome_rel:= ;
      "Relatorio de Duplicatas a Receber em Aberto por periodo"
   clientes->(dbSetOrder(1))
   cabe("371", xinicio, xfinal)
   Local1:= iif(xcx2, "CONT_RER", "CONT_REF")
   select (Local1)
   set order to 
   goto top
   arq_t:= newfile()
   copy to (arq_t) for Empty(dt_liq_doc) .AND. dt_ven_doc >= xinicio ;
      .AND. dt_ven_doc <= xfinal
   arq_i:= newfile("ntx")
   use (arq_t) alias temp new
   index on dt_ven_doc to (arq_i)
   xtotal:= 0
   do while (!EOF())
      xstotal:= 0
      do while (temp->dt_ven_doc = xinicio)
         clientes->(dbSeek(temp->cod_cl))
         if (temp->cod_moe != moeda_corr)
            do while (.T.)
               valor_ta->(dbSeek("MO" + temp->cod_moe + ;
                  DToS(temp->dt_ven_doc)))
               if (valor_ta->(EOF()))
                  if (cad_valor("MO", "R") = "S")
                     set device to screen
                     nuc156("MO", temp->cod_moe, temp->dt_ven_doc)
                     set device to printer
                     select TEMP
                     loop
                  else
                     xvalor:= 0
                  endif
               else
                  xvalor:= valor_ta->valor_prod
               endif
               exit
            enddo
         else
            xvalor:= 1
         endif
         @ PRow() + 1,  3 say temp->cod_cl
         @ PRow(), 12 say clientes->nome_cl
         @ PRow(), 56 say temp->nr_doc_re
         @ PRow(), 64 say temp->dt_ven_doc
         xstotal:= xstotal + temp->val_doc * xvalor
         if (temp->ban_car = "B")
            xtot_b:= xtot_b + temp->val_doc * xvalor
         else
            xtot_c:= xtot_c + temp->val_doc * xvalor
         endif
         @ PRow(), 85 say temp->val_doc * xvalor picture ;
            "@E 9,999,999,999.99"
         @ PRow(), 102 say temp->ban_car
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         if (PRow() > 60)
            eject
            cabe("371", xinicio, xfinal)
         endif
         skip 
      enddo
      if (xstotal > 0)
         @ PRow() + 1, 50 say "Total da data .......>>             " ;
            + Transform(xstotal, "@E 9,999,999,999.99")
         @ PRow() + 0, 50 say "Total da data .......>>             " ;
            + Transform(xstotal, "@E 9,999,999,999.99")
         @ PRow() + 0, 50 say "Total da data .......>>             " ;
            + Transform(xstotal, "@E 9,999,999,999.99")
         @ PRow() + 1,  4 say Replicate("_", 127)
      endif
      xtotal:= xtotal + xstotal
      xinicio++
   enddo
   if (PRow() > 59)
      cabe("371", xinicio, xfinal)
   endif
   @ PRow() + 1,  0 say prt->imp_10cpp
   @ PRow() + 1, 20 say "Total em Bancos .....>> " + ;
      Transform(xtot_b, "@E 9,999,999,999.99")
   @ PRow() + 0, 20 say "Total em Bancos .....>> " + ;
      Transform(xtot_b, "@E 9,999,999,999.99")
   @ PRow() + 1, 20 say "Total em Carteira ...>> " + ;
      Transform(xtot_c, "@E 9,999,999,999.99")
   @ PRow() + 0, 20 say "Total em Carteira ...>> " + ;
      Transform(xtot_c, "@E 9,999,999,999.99")
   @ PRow() + 1, 20 say "Total Geral .........>> " + ;
      Transform(xtotal, "@E 9,999,999,999.99")
   @ PRow() + 0, 20 say "Total Geral .........>> " + ;
      Transform(xtotal, "@E 9,999,999,999.99")
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   select TEMP
   close
   erase (arq_t)
   erase (arq_i)
   return

********************************
static procedure NUC3672

   if (pg > 0)
      @ PRow() + 1,  0 say linha1
   endif
   cabe("367")
   @ PRow(),  0 say prt->imp_20cpp
   @ PRow() + 2,  0 say linha1
   @ PRow() + 1,  0 say linha2
   @ PRow() + 1,  0 say linha3
   @ PRow() + 1,  0 say linha4
   return

********************************
procedure FUNC0040


********************************
procedure NUC3532

   local Local1
   private pg:= xtotal:= xtot_b:= xtot_c:= xstotal:= 0, xtotale:= ;
      xtot_be:= xtot_ce:= xstotale:= 0
   set device to printer
   nome_rel:= ;
      "Relatorio de Duplicatas a Receber Encerradas por periodo"
   clientes->(dbSetOrder(1))
   cabe("371", xinicio, xfinal)
   Local1:= iif(xcx2, "CONT_RER", "CONT_REF")
   select (Local1)
   set order to 
   goto top
   arq_t:= newfile()
   copy to (arq_t) for !(Empty(dt_liq_doc) .AND. dt_ven_doc >= ;
      xinicio .AND. dt_ven_doc <= xfinal)
   arq_i:= newfile("ntx")
   use (arq_t) alias temp new
   index on dt_ven_doc to (arq_i)
   xtotal:= 0
   _xinicio:= xinicio
   do while (!EOF())
      xstotale:= 0
      xstotal:= 0
      do while (temp->dt_ven_doc = _xinicio)
         clientes->(dbSeek(temp->cod_cl))
         if (temp->cod_moe != moeda_corr)
            do while (.T.)
               valor_ta->(dbSeek("MO" + temp->cod_moe + ;
                  DToS(temp->dt_ven_doc)))
               if (valor_ta->(EOF()))
                  if (cad_valor("MO", "R") = "S")
                     set device to screen
                     nuc156("MO", temp->cod_moe, temp->dt_ven_doc)
                     set device to printer
                     select TEMP
                     loop
                  else
                     xvalor:= 0
                  endif
               else
                  xvalor:= valor_ta->valor_prod
               endif
               exit
            enddo
         else
            xvalor:= 1
         endif
         @ PRow() + 1,  4 say temp->cod_cl
         @ PRow(), 13 say clientes->nome_cl
         @ PRow(), 57 say temp->nr_doc_re
         @ PRow(), 65 say temp->dt_ven_doc
         @ PRow(), 75 say temp->dt_liq_doc
         xstotal:= xstotal + temp->val_doc * xvalor
         xstotale:= xstotale + temp->val_liq
         if (temp->ban_car = "B")
            xtot_b:= xtot_b + temp->val_doc * xvalor
            xtot_be:= xtot_be + temp->val_liq
         else
            xtot_c:= xtot_c + temp->val_doc * xvalor
            xtot_ce:= xtot_ce + temp->val_liq
         endif
         @ PRow(), 86 say temp->val_doc * xvalor picture ;
            "@E 9,999,999,999.99"
         @ PRow(), 103 say temp->ban_car
         @ PRow(), 115 say temp->val_liq picture "@E 9,999,999,999.99"
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         if (PRow() > 60)
            eject
            cabe("371", xinicio, xfinal)
         endif
         skip 
      enddo
      if (xstotal > 0)
         @ PRow() + 1, 50 say "Total da data .......>>             " ;
            + Transform(xstotal, "@E 9,999,999,999.99") + ;
            "             " + Transform(xstotale, ;
            "@E 9,999,999,999.99")
         @ PRow() + 0, 50 say "Total da data .......>>             " ;
            + Transform(xstotal, "@E 9,999,999,999.99") + ;
            "             " + Transform(xstotale, ;
            "@E 9,999,999,999.99")
         @ PRow() + 0, 50 say "Total da data .......>>             " ;
            + Transform(xstotal, "@E 9,999,999,999.99") + ;
            "             " + Transform(xstotale, ;
            "@E 9,999,999,999.99")
         @ PRow() + 1,  2 say Replicate("-", 129)
      endif
      xtotal:= xtotal + xstotal
      xtotale:= xtotale + xstotale
      _xinicio++
   enddo
   if (PRow() > 59)
      cabe("371", xinicio, xfinal)
   endif
   @ PRow() + 1,  0 say prt->imp_10cpp
   @ PRow() + 1, 20 say "Total em Bancos .....>> " + ;
      Transform(xtot_b, "@E 9,999,999,999.99") + Transform(xtot_be, ;
      "@E 9,999,999,999.99")
   @ PRow() + 0, 20 say "Total em Bancos .....>> " + ;
      Transform(xtot_b, "@E 9,999,999,999.99") + Transform(xtot_be, ;
      "@E 9,999,999,999.99")
   @ PRow() + 1, 20 say "Total em Carteira ...>> " + ;
      Transform(xtot_c, "@E 9,999,999,999.99") + Transform(xtot_ce, ;
      "@E 9,999,999,999.99")
   @ PRow() + 0, 20 say "Total em Carteira ...>> " + ;
      Transform(xtot_c, "@E 9,999,999,999.99") + Transform(xtot_ce, ;
      "@E 9,999,999,999.99")
   @ PRow() + 1, 20 say "Total Geral .........>> " + ;
      Transform(xtotal, "@E 9,999,999,999.99") + Transform(xtotale, ;
      "@E 9,999,999,999.99")
   @ PRow() + 0, 20 say "Total Geral .........>> " + ;
      Transform(xtotal, "@E 9,999,999,999.99") + Transform(xtotale, ;
      "@E 9,999,999,999.99")
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   select TEMP
   close
   erase (arq_t)
   erase (arq_i)
   return

********************************
procedure NUC3911(Arg1)

   private pg:= 0
   select PROD_ACA
   set order to Arg1
   goto top
   nome_rel:= iif(Arg1 = 1, "Ordem de Codigo do produto acabado", ;
      "Ordem Alfabetica do produto acabado")
   set device to printer
   cabe("3911")
   do while (!EOF())
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() >= 60)
         eject
         cabe("3911")
      endif
      @ PRow() + 1,  2 say co_prod + "  " + de_prod + "  " + co_unid
      @ PRow(), 45 say est_atu picture "9999999.99"
      @ PRow(), 57 say val_mp picture "@E 9,999,999.99"
      @ PRow(), 71 say val_prod picture "@E 9,999,999.99"
      skip 
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function RECLOCK(Arg1)

   local Local1, Local2
   Local2:= .T.
   if (RLock())
      return .T.
   endif
   Local1:= (Arg1:= iif(ISNIL(Arg1), 0, Arg1)) == 0
   do while ((Local1 .OR. Arg1 > 0) .AND. Local2)
      if (RLock())
         return .T.
      endif
      Local2:= InKey(0.5) != K_ESC
      Arg1:= Arg1 - 0.5
   enddo
   mostrauser(alias())
   return .F.

********************************
procedure ERRORSYS

   errorblock({|_1| deferror(_1)})
   return

********************************
procedure NUC3533

   local Local1, Local2, Local3, Local4
   private pg:= 0
   set device to printer
   nome_rel:= ;
      "Relatorio de Duplicatas a Receber Geral por Clientes e periodo"
   set device to screen
   Local4:= ;
      ms250("Imprimir somente Duplicatas em aberto (S/N) ? ", ;
      24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c")
   aviso(24, "Aguarde... imprimindo relatorio solicitado.")
   set device to printer
   cabe(iif(Local4 = 83, "373", "373B"), xinicio, xfinal)
   Local1:= iif(xcx2, "CONT_RER", "CONT_REF")
   select (Local1)
   set order to 3
   goto top
   Local2:= Local3:= 0
   do while (!EOF())
      if (cod_cl != xcod_cl .OR. dt_ven_doc < xinicio .OR. ;
            dt_ven_doc > xfinal .OR. iif(Local4 = 83, ;
            !Empty(dt_liq_doc), .F.))
         skip 
         loop
      endif
      select (Local1)
      @ PRow() + 1,  2 say nr_doc_re
      @ PRow(), 10 say dt_ven_doc
      if (Local4 == 83)
         @ PRow(), 20 say val_doc picture "@E 9,999,999,999.99"
      else
         @ PRow(), 20 say dt_liq_doc
         @ PRow(), 31 say val_doc picture "@E 9,999,999,999.99"
         @ PRow(), 50 say val_liq picture "@E 9,999,999,999.99"
         Local3:= Local3 + val_liq
      endif
      Local2:= Local2 + val_doc
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 60)
         eject
         cabe("373", xinicio, xfinal)
      endif
      skip 
   enddo
   @ PRow() + 2,  8 say prt->imp_lenfat + "TOTAL GERAL"
   if (Local4 == 83)
      @ PRow(), 20 say Local2 picture "@E 9,999,999,999.99" + ;
         prt->imp_denfat
   else
      @ PRow(), 31 say Local2 picture "@E 9,999,999,999.99"
      @ PRow(), 50 say Local3 picture "@E 9,999,999,999.99" + ;
         prt->imp_denfat
   endif
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC366

   local Local1, Local2, Local3
   tone(800, 5)
   tone(1220, 3)
   Local3:= ;
      ms250("Troque o formulario p/ 132 colunas e tecle CTRL+ENTER ou <ESC> para sair", ;
      24, 0, cor[4], cor[5], {27, 10}, Nil, 80, "c")
   if (Local3 == 27)
   else
      Local1:= savescr(7, 1, 10, 57)
      set color to (cor[8])
      window(7, 1, 9, 55, "ͻȺ ", .T.)
      @  8,  3 say "Codigo.......: "
      _tabelas:= "TAB_TRA"
      xcod_tra:= Space(3)
      set escape (.F.)
      set color to (cor[3])
      @  8, 18 get XCOD_TRA picture "999" valid !Empty(xcod_tra) ;
         .AND. localiza(xcod_tra, "TAB_TRA", 1, "M", "DESCRICAO", 8, ;
         22) when ;
         mens_when("Digite o Codigo do Transportador ou tecle <ESC> p/ sair")
      read
      set color to 
      _tabelas:= Nil
      set escape (.T.)
      restscr(Local1)
      select CLIENTES
      set order to 1
      select VENDAS_R
      set order to 
      goto top
      ms250("Imprimindo programacao de entrega, agurde por favor.", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
      if (Len(vet_ped) == 0)
      else
         new_vet:= asort(vet_ped, Nil, Nil, {|_1, _2| _1[3] < _2[3]})
         ms250("Controle de entrega sera impresso neste momento", ;
            23, 0, cor[4], cor[5], Nil, Nil, 80, "c")
         if (xconf_rel:= iif(qt_copias() > 0, .T., .F.))
            nuc3661()
         endif
         return
      endif
   endif

********************************
function __GETSETBL(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[1]:= Arg1
   endif
   return qself()[1]

********************************
procedure NUC354

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {12, 51, " Abertas por periodo    ", ;
      "Duplicatas abertas por periodo"})
   AAdd(Local2, {13, 51, " Encerradas por periodo ", ;
      "Duplicatas Encerradas por periodo"})
   AAdd(Local2, {14, 51, " Abertas por Fornecedor ", ;
      "Duplicatas em Aberto por Fornecedores e Periodo"})
   AAdd(Local2, {15, 51, " Encerr. por Fornecedor ", ;
      "Duplicatas Encerradas por Fornecedores e Periodo"})
   private xinicio, xfinal, xcod_fo
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "DUPL. PAGAR")
   Local1:= 1
   do while (.T.)
      set color to (cor[16])
      window(11, 50, 16, 75, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case Local1 = 1
         tela_perio()
         if (!Empty(xinicio) .AND. !Empty(xfinal))
            t_copias:= qt_copias()
            if (t_copias > 0)
               for i:= 1 to t_copias
                  nuc3541()
               next
            endif
         endif
         restore screen from xtela1
      case Local1 = 2
         tela_perio()
         if (!Empty(xinicio) .AND. !Empty(xfinal))
            t_copias:= qt_copias()
            if (t_copias > 0)
               for i:= 1 to t_copias
                  nuc3542()
               next
            endif
         endif
         restore screen from xtela1
      case Local1 = 3 .OR. Local1 = 4
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 9, 31, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Fornecedor:"
         @  6,  2 to  6, 30
         @  7,  3 say "Inicio...........:"
         @  8,  3 say "Final............:"
         set color to 
         xcod_fo:= Space(4)
         set color to (cor[3])
         @  5, 22 get XCOD_FO picture "@k 9999" valid ;
            localiza(stz(@xcod_fo), "FORNECED", 1, "M") when ;
            mens_when("Digite o Codigo do " + ;
            "Fornecedor ou tecle <ESC> p/ sair")
         read
         xinicio:= xfinal:= CToD(Space(8))
         if (LastKey() != K_ESC)
            set color to (cor[3])
            @  7, 22 get XINICIO picture "@!" valid !Empty(xinicio) ;
               when mens_when("Digite " + ;
               "a data de inicio do periodo ou tecle <ESC> " + ;
               "p/ sair.")
            @  8, 22 get XFINAL picture "@!" valid xfinal >= xinicio ;
               .OR. !Empty(xfinal) when mens_when("Digite a data " ;
               + "final do periodo ou tecle <ENTER> p/ voltar") ;
               .AND. (xfinal:= xinicio) = xinicio
            read
            set color to 
            if (!Empty(xinicio) .AND. !Empty(xfinal))
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     if (Local1 == 3)
                        nuc3543()
                     else
                        nuc3544()
                     endif
                  next
               endif
            endif
         endif
         restore screen from xtela1
      case Local1 = 0
         restore screen from xtela1
         exit
      endcase
   enddo
   return

********************************
function __XRESTSCR

   if (Static31 != Nil)
      restore screen from Static31[3]
      SetPos(Static31[1], Static31[2])
   endif
   Static31:= Nil
   return Nil

********************************
procedure NUC3541

   local Local1
   private pg:= 0, xtotal:= xsubtotal:= 0
   set device to printer
   nome_rel:= "Relatorio de Duplicatas a Pagar em aberto por periodo"
   cabe("361", xinicio, xfinal)
   Local1:= iif(xcx2, "CONT_PGR", "CONT_PGF")
   select (Local1)
   set order to 4
   goto top
   xdata_loop:= xinicio
   do while (!EOF())
      if (!Empty(dt_liq_do) .OR. dt_ven_cp < xinicio .OR. dt_ven_cp ;
            > xfinal)
         skip 
         loop
      endif
      xdt_ven_cp:= dt_ven_cp
      do while (xdt_ven_cp = dt_ven_cp)
         if (PRow() > 56)
            eject
            cabe("361", xinicio, xfinal)
         endif
         if (!Empty(dt_liq_do) .OR. dt_ven_cp < xinicio .OR. ;
               dt_ven_cp > xfinal)
            skip 
            loop
         endif
         xcod_fo:= cod_fo
         select FORNECED
         set order to 1
         seek xcod_fo
         xnome_fo:= nome_fo
         select (Local1)
         @ PRow() + 1,  2 say xcod_fo
         @ PRow(),  8 say xnome_fo
         @ PRow(), 50 say Trim(tipo_doc) + "/" + Trim(nr_doc_cp)
         @ PRow(), 76 say dt_ven_cp
         @ PRow(), 89 say val_cp picture "@E 9,999,999,999.99"
         @ PRow(), 108 say SubStr(iif(tipo_doc = "Cheque", nr_cc, ;
            refer_cp), 1, 23)
         xtotal:= xtotal + val_cp
         xsubtotal:= xsubtotal + val_cp
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         skip 
      enddo
      @ PRow() + 1,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
         "Total do dia " + DToC(xdt_ven_cp)
      @ PRow(), 52 say xsubtotal picture "@E 9,999,999,999.99"
      @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
      xsubtotal:= 0
   enddo
   @ PRow() + 2,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
      "T O T A L   G E R A L"
   @ PRow(), 52 say xtotal picture "@E 9,999,999,999.99"
   @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC3651

   local Local1
   Local1:= savescr(3, 0, 24, 79)
   sinal("RELATORIO", "PROG.PROD.")
   do while (.T.)
      set color to (cor[12])
      @  3,  0 to 22, 79
      @  4,  1 clear to 21, 78
      set color to 
      @ 23,  0 clear to 24, 79
      set color to (cor[1])
      window(4, 1, 6, 25, "ͻȺ ", .T.)
      @  5,  3 say "Nr. da Carga.: "
      xnr_carga:= Space(6)
      set color to (cor[3])
      @  5, 18 get xnr_carga picture "@K 999999" valid ;
         !Empty(xnr_carga) .AND. localiza(stz(@xnr_carga), ;
         "VENDAS_R", 3, "M") when ;
         mens_when("Digite o Numero da Carga ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restscr(Local1)
         return
      endif
      xfalhou:= .F.
      clientes->(dbSetOrder(1))
      vendas_r->(dbSetOrder(3))
      ms250("Pesquisando pedidos sem PROGRAMACAO DE CARREGAMENTO. Aguarde por favor.", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
      do while (vendas_r->nr_carga = xnr_carga)
         if (!xcx2)
            if (vendas_r->editavel)
               skip 
               loop
            endif
         endif
         if (!vendas_r->prog_prod)
            AAdd(vet_ped, {vendas_r->nr_ped, 0, clientes->est_cl + ;
               clientes->cid_cl, .T., 0, 0})
         else
            ms250("Esta carga ja foi confirmada. Tecle [ESC] para cancelar", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
            xfalhou:= .T.
            exit
         endif
         vendas_r->(dbSkip())
      enddo
      if (!xfalhou)
         nuc3653()
      endif
      pg:= 0
      xtravou:= .F.
      new_vet:= {}
      vet_est:= {}
      vet_ped:= {}
      vet_item:= {}
      vet_edita:= {}
      vet_lin:= {}
      xtotal_cai:= 0
      xtotal_pes:= 0
      xtotal_val:= 0
      yxest_cl:= ""
      xnr_carga:= Space(6)
   enddo

********************************
procedure NUCAJUDA


********************************
procedure NUC3542

   local Local1
   private pg:= 0, xtotal_cp:= xsub_cp:= 0
   private xtotal_pg:= xsub_pg:= 0
   set device to printer
   nome_rel:= "Relatorio de Duplicatas a Pagar Fechadas por periodo"
   cabe("361B", xinicio, xfinal, 86)
   Local1:= iif(xcx2, "CONT_PGR", "CONT_PGF")
   select (Local1)
   set order to 4
   goto top
   do while (!EOF())
      if (Empty(dt_liq_do) .OR. dt_ven_cp < xinicio .OR. dt_ven_cp > ;
            xfinal)
         skip 
         loop
      endif
      xdt_ven_cp:= dt_ven_cp
      do while (xdt_ven_cp = dt_ven_cp)
         if (PRow() > 56)
            eject
            cabe("361B", xinicio, xfinal, 86)
         endif
         if (Empty(dt_liq_do) .OR. dt_ven_cp < xinicio .OR. ;
               dt_ven_cp > xfinal)
            skip 
            loop
         endif
         xcod_fo:= cod_fo
         select FORNECED
         set order to 1
         seek xcod_fo
         xnome_fo:= nome_fo
         select (Local1)
         @ PRow() + 1,  2 say xcod_fo
         @ PRow(),  8 say xnome_fo
         @ PRow(), 50 say Trim(tipo_doc) + "/" + Trim(nr_doc_cp)
         @ PRow(), 76 say dt_ven_cp
         @ PRow(), 89 say val_cp picture "@E 9,999,999,999.99"
         @ PRow(), 108 say SubStr(iif(tipo_doc = "Cheque", nr_cc, ;
            refer_cp), 1, 23)
         @ PRow(), 150 say dt_liq_do
         @ PRow(), 163 say val_liqui picture "@E 9,999,999,999.99"
         @ PRow(), 183 say nr_cheq
         xtotal_cp:= xtotal_cp + val_cp
         xsub_cp:= xsub_cp + val_cp
         xtotal_pg:= xtotal_pg + val_liqui
         xsub_pg:= xsub_pg + val_liqui
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         skip 
      enddo
      @ PRow() + 1,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
         "Total do dia " + DToC(xdt_ven_cp)
      @ PRow(), 52 say xsub_cp picture "@E 9,999,999,999.99"
      @ PRow(), 95 say xsub_pg picture "@E 9,999,999,999.99"
      @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
      xsub_cp:= 0
      xsub_pg:= 0
   enddo
   @ PRow() + 2,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
      "T O T A L   G E R A L"
   @ PRow(), 52 say xtotal_cp picture "@E 9,999,999,999.99"
   @ PRow(), 95 say xtotal_pg picture "@E 9,999,999,999.99"
   @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC361

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {15, 22, " Produtos acabados (Alfabetica) ", ;
      padc("Relatorio de Produtos acabados em Ordem Alfabetica", ;
      80)})
   AAdd(Local1, {16, 22, " Produtos acabados (Codigo)     ", ;
      padc("Relatorio de Produtos acabados em Ordem de Codigo", ;
      80)})
   sinal("SUB-MENU", "PRODUTOS")
   private m_ped391:= 1
   do while (.T.)
      set color to (cor[16])
      window(14, 21, 17, 55, "Ŀ ", .T.)
      m_ped391:= menu_prt(Local1, m_ped391, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (m_ped391 = 1)
         save screen to Local2
         set color to 
         Scroll(23, 0, 24, 79)
         t_copias:= qt_copias()
         if (t_copias > 0)
            nuc3911(2)
         endif
         restore screen from Local2
      elseif (m_ped391 = 2)
         save screen to Local2
         set color to 
         Scroll(23, 0, 24, 79)
         t_copias:= qt_copias()
         if (t_copias > 0)
            nuc3911(1)
         endif
         restore screen from Local2
      elseif (m_ped391 = 0)
         restore screen from xtela1
         return
      endif
   enddo
   return

********************************
procedure FUNC0034


********************************
procedure NUC3543

   local Local1
   private pg:= 0, xtotal:= xsubtotal:= 0
   set device to printer
   nome_rel:= ;
      "Relatorio de Duplicatas a Pagar em Aberto por Fornecedor/Periodo"
   cabe("361", xinicio, xfinal)
   Local1:= iif(xcx2, "CONT_PGR", "CONT_PGF")
   select (Local1)
   set order to 4
   goto top
   do while (!EOF())
      if (cod_fo != xcod_fo .OR. !Empty(dt_liq_do) .OR. dt_ven_cp < ;
            xinicio .OR. dt_ven_cp > xfinal)
         skip 
         loop
      endif
      xdt_ven_cp:= dt_ven_cp
      do while (xdt_ven_cp = dt_ven_cp)
         if (PRow() > 56)
            eject
            cabe("361", xinicio, xfinal)
         endif
         if (cod_fo != xcod_fo .OR. !Empty(dt_liq_do) .OR. dt_ven_cp ;
               < xinicio .OR. dt_ven_cp > xfinal)
            skip 
            loop
         endif
         xcod_fo:= cod_fo
         select FORNECED
         set order to 1
         seek xcod_fo
         xnome_fo:= nome_fo
         select (Local1)
         @ PRow() + 1,  2 say xcod_fo
         @ PRow(),  8 say xnome_fo
         @ PRow(), 50 say Trim(tipo_doc) + "/" + Trim(nr_doc_cp)
         @ PRow(), 76 say dt_ven_cp
         @ PRow(), 89 say val_cp picture "@E 9,999,999,999.99"
         @ PRow(), 108 say SubStr(iif(tipo_doc = "Cheque", nr_cc, ;
            refer_cp), 1, 23)
         xtotal:= xtotal + val_cp
         xsubtotal:= xsubtotal + val_cp
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         skip 
      enddo
      @ PRow() + 1,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
         "Total do dia " + DToC(xdt_ven_cp)
      @ PRow(), 52 say xsubtotal picture "@E 9,999,999,999.99"
      @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
      xsubtotal:= 0
   enddo
   @ PRow() + 2,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
      "T O T A L   G E R A L"
   @ PRow(), 52 say xtotal picture "@E 9,999,999,999.99"
   @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC366A1

   local Local1
   private cco_mp:= Space(4), ddat_ini:= ddat_fin:= CToD("")
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("RELATORIO", "M. PRIMA")
   set century on
   do while (.T.)
      set color to (cor[1])
      window(4, 1, 10, 70, "Ŀ ", .T.)
      @  5,  3 say "Materia Prima.: "
      @  7,  3 say "Data Inicial..: "
      @  9,  3 say "Data Final....: "
      set color to  
      set color to (cor[3])
      @  5, 19 get cCO_MP picture "@k 9999" valid ;
         localiza(stz(@cco_mp), "MP_R", 1, "M", ;
         "trim(substr(DE_MP,01,30))+[ ]+CO_UNID", 5, 25, cor[2]) ;
         when mens_when("Digite o Codigo da Materia Prima")
      @  7, 19 get dDAT_INI when ;
         mens_when("Digite o Periodo Inicial da Materia Prima")
      @  9, 19 get dDAT_FIN when ;
         mens_when("Digite o Periodo Final da Materia Prima")
      read
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
         set color to  
      endif
      t_copias:= qt_copias()
      if (t_copias > 0)
         nuc366a1_r()
      endif
   enddo

********************************
procedure AVISO(Arg1, Arg2)

   local Local1
   Local1:= Int((80 - Len(Arg2)) / 2)
   set color to (cor[4])
   @ Arg1,  0 say Space(80)
   @ Arg1, Local1 say Arg2
   set color to 
   return

********************************
function FT_DFCLOSE

   if (Static9 > 0)
      _ft_dfclos()
      fclose(Static9)
      Static9:= 0
   endif
   return Nil

********************************
procedure NUC3544

   local Local1
   private pg:= 0, xtotal_cp:= xsub_cp:= 0
   private xtotal_pg:= xsub_pg:= 0
   set device to printer
   nome_rel:= ;
      "Relatorio de Duplicatas a Pagar Fechadas por Fornecedor/Periodo"
   cabe("361B", xinicio, xfinal, 86)
   Local1:= iif(xcx2, "CONT_PGR", "CONT_PGF")
   select (Local1)
   set order to 4
   goto top
   do while (!EOF())
      if (cod_fo != xcod_fo .OR. Empty(dt_liq_do) .OR. dt_ven_cp < ;
            xinicio .OR. dt_ven_cp > xfinal)
         skip 
         loop
      endif
      xdt_ven_cp:= dt_ven_cp
      do while (xdt_ven_cp = dt_ven_cp)
         if (PRow() > 56)
            eject
            cabe("361B", xinicio, xfinal, 86)
         endif
         if (cod_fo != xcod_fo .OR. Empty(dt_liq_do) .OR. dt_ven_cp ;
               < xinicio .OR. dt_ven_cp > xfinal)
            skip 
            loop
         endif
         xcod_fo:= cod_fo
         select FORNECED
         set order to 1
         seek xcod_fo
         xnome_fo:= nome_fo
         select (Local1)
         @ PRow() + 1,  2 say xcod_fo
         @ PRow(),  8 say xnome_fo
         @ PRow(), 50 say Trim(tipo_doc) + "/" + Trim(nr_doc_cp)
         @ PRow(), 76 say dt_ven_cp
         @ PRow(), 89 say val_cp picture "@E 9,999,999,999.99"
         @ PRow(), 108 say SubStr(iif(tipo_doc = "Cheque", nr_cc, ;
            refer_cp), 1, 23)
         @ PRow(), 150 say dt_liq_do
         @ PRow(), 163 say val_liqui picture "@E 9,999,999,999.99"
         @ PRow(), 183 say nr_cheq
         xtotal_cp:= xtotal_cp + val_cp
         xsub_cp:= xsub_cp + val_cp
         xtotal_pg:= xtotal_pg + val_liqui
         xsub_pg:= xsub_pg + val_liqui
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         skip 
      enddo
      @ PRow() + 1,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
         "Total do dia " + DToC(xdt_ven_cp)
      @ PRow(), 52 say xsub_cp picture "@E 9,999,999,999.99"
      @ PRow(), 95 say xsub_pg picture "@E 9,999,999,999.99"
      @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
      xsub_cp:= 0
      xsub_pg:= 0
   enddo
   @ PRow() + 2,  8 say prt->imp_10cpp + prt->imp_lenfat + ;
      "T O T A L   G E R A L"
   @ PRow(), 52 say xtotal_cp picture "@E 9,999,999,999.99"
   @ PRow(), 95 say xtotal_pg picture "@E 9,999,999,999.99"
   @ PRow() + 1,  0 say prt->imp_denfat + prt->imp_16cpp
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC363

   local Local1
   Local1:= setcursor()
   private pg:= 0, xxco_prod:= "    "
   private xtela1:= savescr(14, 57, 17, 76)
   t_copias:= qt_copias()
   if (t_copias == 0)
   else
      do while (.T.)
         set color to (cor[1])
         window(14, 57, 16, 74, "ͻȺ ", .T.)
         xxco_prod:= "    "
         @ 15, 59 say "Produto : "
         setcursor(1)
         set color to (cor[3])
         @ 15, 69 get xxco_prod picture "9999" valid ;
            Empty(xxco_prod) .OR. localiza(stz(@xxco_prod), ;
            "PROD_ACA", 1, "M") when ;
            mens_when("Digite o Codigo do Produto Acabado ou [ENTER] para " ;
            + "todos. [ESC] cancela")
         read
         if (LastKey() == K_ESC)
            restscr(xtela1)
            setcursor(Local1)
            exit
         endif
         nuc3631()
      enddo
      if (i_m_p_r_ee = "LPT1")
         eject
         set printer to 
         if (xvid_imp == 86)
            vertexto()
         endif
      endif
      return
   endif

********************************
function FCOD_FO(Arg1, Arg2)

   if (Arg2 = Nil)
      Arg2:= 5
   endif
   if (Empty(Arg1))
      return .F.
   else
      forneced->(dbSetOrder(1))
      forneced->(dbSeek(Arg1))
      xnome_fo:= forneced->nome_fo
      if (forneced->(Found()))
         @ Arg2, 30 say xnome_fo color cor[2]
         return .T.
      else
         mensagem("Codigo nao encontrado. P/ continuar tecle [ESC].", ;
            27)
         Arg1:= Space(4)
         return .F.
      endif
   endif

********************************
procedure NUC355

   local Local1, Local2
   private pg:= 0, xtotal:= 0, xtot_ac:= xtot_ad:= xtot_fc:= ;
      xtot_fd:= 0
   private xtot_liq_c:= xtot_liq_d:= 0, xinicio, xfinal
   t_copias:= qt_copias()
   if (t_copias == 0)
   else
      set color to 
      Scroll(23, 0, 24, 79)
      tela_perio()
      Local2:= ;
         ms250("Qual o Tipo de Relatorio de Emprestimo que Deseja ?   Aberto  Fechado  Todos", ;
         24, 0, cor[4], cor[5], {65, 70, 84, 27}, Nil, 80, "C")
      if (Local2 == 27)
      else
         set device to printer
         nome_rel:= "Relatorio de Emprestimos " + iif(Local2 = 65, ;
            "em Aberto", iif(Local2 = 70, "Fechados", "")) + ;
            " por periodo"
         cabe("355", xinicio, xfinal)
         select EMPRESTI
         if (.T.)
            set relation to
         endif
         set relation to cod_moe into TAB_MOE, to COD_IND into TAB_IND
         set order to 2
         goto top
         do while (!EOF())
            if (dt_pr_liq < xinicio .OR. dt_pr_liq > xfinal)
               skip 
               loop
            endif
            if (Local2 == 65)
               if (!Empty(dt_liqui))
                  skip 
                  loop
               endif
               if (empresti->tipo_oper = "C")
                  xtot_ac:= xtot_ac + empresti->val_atu
               else
                  xtot_ad:= xtot_ad + empresti->val_atu
               endif
            elseif (Local2 == 70)
               if (Empty(dt_liqui))
                  skip 
                  loop
               endif
               if (empresti->tipo_oper = "C")
                  xtot_fc:= xtot_fc + empresti->val_atu
               else
                  xtot_fd:= xtot_fd + empresti->val_atu
               endif
            elseif (Local2 == 84)
               if (Empty(dt_liqui))
                  if (empresti->tipo_oper = "C")
                     xtot_ac:= xtot_ac + empresti->val_atu
                  else
                     xtot_ad:= xtot_ad + empresti->val_atu
                  endif
               elseif (empresti->tipo_oper = "C")
                  xtot_fc:= xtot_fc + empresti->val_atu
               else
                  xtot_fd:= xtot_fd + empresti->val_atu
               endif
            endif
            @ PRow() + 1,  3 say empresti->nome_emp
            @ PRow() + 0, 45 say empresti->ref_emp
            @ PRow() + 0, 107 say iif(empresti->tipo_oper = "D", ;
               "Debito", "Credito")
            @ PRow() + 0, 116 say empresti->dt_oper
            @ PRow() + 0, 126 say empresti->val_oper picture ;
               "@E 9,999,999,999.99"
            @ PRow() + 0, 144 say SubStr(tab_moe->descricao, 1, 12)
            @ PRow() + 0, 158 say SubStr(tab_ind->descricao, 1, 12)
            @ PRow() + 0, 173 say empresti->perc_acr picture ;
               "@E 9999.99"
            @ PRow() + 0, 183 say empresti->dt_pr_liq
            @ PRow() + 0, 195 say empresti->val_atu picture ;
               "@E 9,999,999,999.99"
            @ PRow() + 0, 213 say iif(empresti->emp_bp = "B", ;
               "Bancario", "Particular")
            @ PRow() + 0, 225 say empresti->val_liqui picture ;
               "@E 9,999,999,999.99"
            @ PRow() + 0, 244 say empresti->dt_liqui
            if (InKey() == K_ESC)
               if (cancel_rel())
                  exit
               endif
            endif
            if (PRow() > 60)
               eject
               cabe("355", xinicio, xfinal)
            endif
            skip 
         enddo
         @ PRow() + 1,  2 say Replicate("-", 250)
         if (Local2 == 65)
            @ PRow() + 1,  3 say "Totais de Creditos"
            @ PRow(), 195 say xtot_ac picture "@E 9,999,999,999.99"
            @ PRow() + 1,  3 say "Totais de Debitos"
            @ PRow(), 195 say xtot_ad picture "@E 9,999,999,999.99"
         elseif (Local2 == 70)
            @ PRow() + 1,  3 say "Totais de Creditos"
            @ PRow(), 195 say xtot_fc picture "@E 9,999,999,999.99"
            @ PRow() + 1,  3 say "Totais de Debitos"
            @ PRow(), 195 say xtot_fd picture "@E 9,999,999,999.99"
         else
            @ PRow() + 1,  3 say "Totais de Creditos em Aberto"
            @ PRow(), 195 say xtot_ac picture "@E 9,999,999,999.99"
            @ PRow() + 1,  3 say "Totais de Debitos em Aberto"
            @ PRow(), 195 say xtot_ad picture "@E 9,999,999,999.99"
            @ PRow() + 1,  3 say "Totais de Creditos Fechados"
            @ PRow(), 195 say xtot_fc picture "@E 9,999,999,999.99"
            @ PRow() + 1,  3 say "Totais de Debitos Fechados"
            @ PRow(), 195 say xtot_fd picture "@E 9,999,999,999.99"
         endif
         set device to screen
         if (i_m_p_r_ee = "LPT1")
            eject
            set printer to 
            if (xvid_imp == 86)
               vertexto()
            endif
         endif
         return
      endif
   endif

********************************
procedure NUC362

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {15, 22, " Materia Prima (Alfabetica) ", ;
      padc("Relatorio de Materia Prima em Ordem Alfabetica", 80)})
   AAdd(Local1, {16, 22, " Materia Prima (Codigo)     ", ;
      padc("Relatorio de Materia Prima em Ordem de Codigo", 80)})
   sinal("SUB-MENU", "M.PRIMA")
   private m_ped392:= 1
   do while (.T.)
      set color to (cor[16])
      window(14, 21, 17, 51, "Ŀ ", .T.)
      m_ped392:= menu_prt(Local1, m_ped392, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (m_ped392 = 1)
         save screen to Local2
         set color to 
         Scroll(23, 0, 24, 79)
         t_copias:= qt_copias()
         if (t_copias > 0)
            nuc3921(2)
         endif
         restore screen from Local2
      elseif (m_ped392 = 2)
         save screen to Local2
         set color to 
         Scroll(23, 0, 24, 79)
         t_copias:= qt_copias()
         if (t_copias > 0)
            nuc3921(1)
         endif
         restore screen from Local2
      elseif (m_ped392 = 0)
         restore screen from xtela1
         return
      endif
   enddo
   return

********************************
static function SETACOR(Arg1)

   set color to (Arg1)
   return SetColor()

********************************
procedure NUC358

   local Local1
   private pg:= 0
   private xinicio, xfinal, t_copias, xrecebe, xpaga, xsaldo, xnome, ;
      xcod
   private xpaga, xtipo_cl, xyrecebe, xypaga, xteste, xnome_ban, ;
      xval_saldo
   private xcod_nosso, xnome_cl
   xinicio:= xfinal:= CToD(Space(8))
   save screen to Local1
   tela_perio()
   if (LastKey() == K_ESC)
      @ 14, 36 clear to 18, 55
   else
      private xydata_i, xydata_f
      xydata_i:= xinicio
      xydata_f:= xfinal
      if (file("CHEQUE1.NTX") .AND. file("CHEQUE2.NTX") .AND. ;
            file("CHEQUE3.NTX") .AND. file("CHEQUE4.NTX") .AND. ;
            file("CHEQUE5.NTX"))
         if (!netuse("CHEQUE", "CHE", "S", "new", 5))
            return
         endif
      elseif (netuse("CHEQUE", "CHE", "E", "new", 5))
         set index to 
         index on che->nr_ch+che->nr_ag+che->nr_ban to cheque1
         index on che->Cod_CL+che->situacao to cheque2
         index on che->cod_ven+dtos(che->dt_comp) to cheque3
         index on che->nr_ped+situacao to cheque4
         index on dtos(che->dt_comp)+che->cod_ven to cheque5
      else
         return
      endif
      set index to cheque1, cheque2, cheque3, cheque4, cheque5
      if (!Empty(xinicio) .AND. !Empty(xfinal))
         t_copias:= qt_copias()
         if (t_copias > 0)
            for i:= 1 to t_copias
               nuc3581()
            next
         endif
      endif
      closedata("CHE")
      @ 14, 36 clear to 17, 63
      restore screen from Local1
      return
   endif

********************************
procedure NUC366A1_R

   private pg:= 0, nome_rel
   nome_rel:= "Relatorio de Movimentacao de Materia Prima"
   set device to printer
   mp_r->(dbSetOrder(1))
   mp_r->(dbSeek(cco_mp))
   set century off
   cabe("366A1", ddat_ini, ddat_fin)
   set century on
   tab_set->(dbSetOrder(1))
   select MOV_MP
   set order to 2
   set softseek on
   seek cco_mp + DToS(ddat_ini)
   set softseek off
   set device to printer
   do while (cco_mp = mov_mp->co_mp .AND. mov_mp->dt_mov_mp <= ;
         ddat_fin)
      @ PRow() + 1,  5 say mov_mp->co_set
      tab_set->(dbSeek(mov_mp->co_set))
      @ PRow(), 10 say tab_set->descricao
      @ PRow(), 60 say mov_mp->refer
      @ PRow(), 106 say iif(mov_mp->tipo_mov = "E", "Entrada", ;
         "Saida")
      @ PRow(), 123 say mov_mp->qtd_mp picture "@E 999,999,999.99"
      @ PRow(), 146 say mov_mp->dt_mov_mp
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 57)
         set century off
         cabe("366a", ddat_ini, ddat_fin)
      endif
      skip 
   enddo
   @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_10cpp, "")
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure INSOVR(Arg1)

   local Local1
   Local1:= SetColor()
   if (xcx2)
      set color to (cor[11])
   else
      set color to (cor[7])
   endif
   if (ValType(Arg1) = "L")
      @  0, 75 say iif(readinsert(), " INS ", " OVR ")
      set color to (Local1)
   else
      if (readinsert())
         readinsert(.F.)
         @  0, 75 say " OVR "
      else
         readinsert(.T.)
         @  0, 75 say " INS "
      endif
      set color to (Local1)
      return
   endif

********************************
procedure NUC3581

   select CONT_RER
   set order to 3
   set filter to DT_LIQ_DOC = ctod(space(8))
   goto top
   xrecebe:= 0
   do while (dt_ven_doc < xinicio .AND. !EOF())
      xrecebe:= xrecebe + val_doc
   enddo
   select CONT_PGR
   set order to 4
   set filter to DT_LIQ_DO = ctod(space(8))
   goto top
   xpaga:= 0
   do while (dt_ven_cp < xinicio .AND. !EOF())
      xpaga:= xpaga + val_cp
      skip 
   enddo
   xsaldo:= xrecebe - xpaga
   nome_rel:= "FLUXO DE CAIXA"
   set device to printer
   cabe("38", xydata_i, xydata_f)
   @ PRow() + 1, 26 say " "
   @ PRow(), 25 say "Saldo de Transporte"
   @ PRow(), 112 say Transform(xsaldo, "@E 999,999,999,999.99")
   do while (xinicio <= xfinal)
      xyrecebe:= 0
      xypaga:= 0
      xteste:= .F.
      if (xinicio = Date())
         select bancos
         set order to 4
         goto top
         do while (!EOF())
            xnome_ban:= nome_ban
            xcod_nosso:= cod_nosso
            xnr_banco:= nr_banco + "/" + Trim(nr_agencia) + "/" + ;
               Trim(nr_conta)
            select SALDO
            set order to 3
            seek xcod_nosso
            if (val_saldo != 0)
               xteste:= .T.
               xval_saldo:= val_saldo
               if (PRow() >= 58)
                  eject
                  cabe("38", xydata_i, xydata_f)
               endif
               @ PRow() + 1,  5 say xnr_banco
               @ PRow() + 0, 25 say xnome_ban
               if (xval_saldo < 0)
                  xypaga:= xypaga - xval_saldo
                  @ PRow(), 68 say Transform(xval_saldo * -1, ;
                     "@E 999,999,999,999.99")
               else
                  xyrecebe:= xyrecebe + xval_saldo
                  @ PRow(), 90 say Transform(xval_saldo, ;
                     "@E 999,999,999,999.99")
               endif
               xsaldo:= xsaldo + xval_saldo
               @ PRow(), 112 say Transform(xsaldo, ;
                  "@E 999,999,999,999.99")
            endif
            select BANCOS
            skip 
         enddo
      endif
      select CHE
      set order to 5
      seek DToS(xinicio)
      do while (dt_comp = xinicio)
         if (che->situacao = "C")
            dbSkip()
            loop
         endif
         xteste:= .T.
         xcod:= cod_cl
         xrecebe:= valor
         xdoc:= nr_ch
         xnr_banco:= nr_ban + "/" + alltrim(nr_ag) + "/" + ;
            alltrim(nr_ch)
         select CLIENTES
         set order to 1
         seek xcod
         xnome:= nome_cl
         if (PRow() >= 58)
            eject
            cabe("38", xydata_i, xydata_f)
         endif
         @ PRow() + 1,  5 say xnr_banco
         @ PRow(), 25 say xnome
         @ PRow(), 90 say Transform(xrecebe, "@E 999,999,999,999.99")
         xyrecebe:= xyrecebe + xrecebe
         xsaldo:= xsaldo + xrecebe
         @ PRow(), 112 say Transform(xsaldo, "@E 999,999,999,999.99")
         select CHE
         skip 
      enddo
      select CONT_RER
      do while (dt_ven_doc = xinicio)
         xteste:= .T.
         xcod:= cod_cl
         xrecebe:= val_doc
         xdoc:= nr_doc_re
         select CLIENTES
         set order to 1
         seek xcod
         xnome:= nome_cl
         if (PRow() >= 58)
            eject
            cabe("38", xydata_i, xydata_f)
         endif
         @ PRow() + 1,  5 say xcod + "   " + xdoc + "       " + xnome
         @ PRow(), 90 say Transform(xrecebe, "@E 999,999,999,999.99")
         xyrecebe:= xyrecebe + xrecebe
         xsaldo:= xsaldo + xrecebe
         @ PRow(), 112 say Transform(xsaldo, "@E 999,999,999,999.99")
         select CONT_RER
         skip 
      enddo
      select CONT_PGR
      do while (dt_ven_cp = xinicio)
         xteste:= .T.
         xcod:= cod_fo
         xpaga:= val_cp
         xdoc:= nr_doc_cp
         select FORNECED
         set order to 1
         seek xcod
         xnome:= nome_fo
         if (PRow() >= 58)
            eject
            cabe("38", xydata_i, xydata_f)
         endif
         @ PRow() + 1,  5 say xcod + "    " + xdoc + "     " + xnome
         @ PRow(), 68 say Transform(xpaga, "@E 999,999,999,999.99")
         xypaga:= xypaga + xpaga
         xsaldo:= xsaldo - xpaga
         @ PRow(), 112 say Transform(xsaldo, "@E 999,999,999,999.99")
         select CONT_PGR
         skip 
      enddo
      if (xteste)
         @ PRow() + 1, 25 say "Total do dia " + DToC(xinicio)
         @ PRow(), 68 say Transform(xypaga, "@E 999,999,999,999.99")
         @ PRow(), 90 say Transform(xyrecebe, "@E 999,999,999,999.99")
         @ PRow(), 112 say Transform(xsaldo, "@E 999,999,999,999.99")
         @ PRow(), 25 say "Total do dia " + DToC(xinicio)
         @ PRow(), 68 say Transform(xypaga, "@E 999,999,999,999.99")
         @ PRow(), 90 say Transform(xyrecebe, "@E 999,999,999,999.99")
         @ PRow(), 112 say Transform(xsaldo, "@E 999,999,999,999.99")
         @ PRow() + 1,  0 say " "
      endif
      xinicio:= xinicio + 1
   enddo
   select CONT_RER
   set filter to
   select CONT_PGR
   set filter to
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure GET_CO

   set color to (cor[3])
   @  7, 22 get XCONTATO valid !Empty(xcontato) when ;
      mens_when(mens1[2])
   @  9, 22 get XCARGO picture "@!" when mens_when(mens1[3])
   @ 11, 22 get XSETOR picture "@!" when mens_when(mens1[4])
   @ 13, 22 get XTEL_COM when mens_when(mens1[5])
   @ 15, 22 get XTEL_RES when mens_when(mens1[6])
   @ 17, 22 get XDATA_NASC picture "@D" when mens_when(mens1[7])
   return

********************************
function __GETSETBU(Arg1)

   return iif(Len(qself()) == 13, qself()[12]:= Arg1, Arg1)

********************************
procedure NUC36

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {11, 47, " Produto Acabado  ", ;
      "Relatorio de Produtos Acabados por Codigo e Ordem Alfabetica"})
   AAdd(Local2, {12, 47, " Materia Prima    ", ;
      "Relatorio de Materia Prima por Codigo e Ordem Alfabetca"})
   AAdd(Local2, {13, 47, " Formula          ", ;
      "Relatorio de Formula do Produto acabado"})
   AAdd(Local2, {14, 47, " Producao         ", ;
      "Relatorio de Producao"})
   AAdd(Local2, {15, 47, " Controle de Carga", ;
      "Relatorio de Programacao de Producao"})
   AAdd(Local2, {16, 47, " Mov. M. Prima    ", ;
      "Relatorio de Movimento de Materia Prima"})
   AAdd(Local2, {17, 47, " Tabela de Precos ", ;
      "Relatorio de Tabela de Precos"})
   AAdd(Local2, {18, 47, " Custo Geral F.   ", ;
      "Relatorio de Custo Geral de Fabricacao"})
   AAdd(Local2, {19, 47, " Tabela de Custos ", ;
      "Relatorio de Tabela de Custos"})
   private xtela1
   save screen to xtela1
   sinal("SUB-MENU", "PRODUCAO")
   Local1:= 1
   do while (.T.)
      restore screen from xtela1
      set color to (cor[14])
      window(10, 46, 20, 65, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case Local1 = 1
         if (acesso("NUC361"))
            nuc361()
         endif
      case Local1 = 2
         if (acesso("NUC362"))
            nuc362()
         endif
      case Local1 = 3
         if (acesso("NUC363"))
            set color to 
            Scroll(23, 0, 24, 79)
            nuc363()
            restore screen from xtela1
         endif
      case Local1 = 4
         if (acesso("NUC364"))
            nuc364()
         endif
      case Local1 = 5
         if (acesso("NUC365"))
            nuc365()
         endif
      case Local1 = 6
         if (acesso("NUC366A"))
            nuc366a()
         endif
      case Local1 = 7
         if (acesso("NUC367"))
            nuc367()
         endif
      case Local1 = 8
         linha_23_2:= SaveScreen(23, 0, 24, 79)
         if (LastKey() != K_ESC)
            t_copias:= qt_copias()
            if (t_copias > 0)
               nuc368()
            endif
         endif
         restore screen from xtela1
      case Local1 = 9
         if (acesso("NUC367"))
            nuc367a()
         endif
      case Local1 = 0
         restore screen from xtela1
         exit
      endcase
   enddo
   return

********************************
procedure VERTEXTO(Arg1, Arg2, Arg3, Arg4)

   local Local1, Local2
   Local2:= SaveScreen(3, 0, 24, 79)
   Arg1:= iif(Arg1 = Nil, 4, Arg1)
   Arg2:= iif(Arg2 = Nil, 1, Arg2)
   Arg3:= iif(Arg3 = Nil, 21, Arg3)
   Arg4:= iif(Arg4 = Nil, 78, Arg4)
   Local1:= colorton(ntocolor(Asc(SubStr(Local2, 2, 1)), .T.))
   set printer to LPT1
   set device to screen
   aviso(24, ;
      "Use as teclas de movimentacao ou tecle <ESC> para sair.")
   ft_dfsetup("ARQUIVO.TXT", Arg1, Arg2, Arg3, Arg4, 1, Local1, ;
      Local1, "SsQq", .T., 5, 260, 4096)
   ft_dispfil()
   ft_dfclose()
   erase ARQUIVO.TXT
   xvid_imp:= 73
   RestScreen(Local2, Arg1, Arg2, Arg3, Arg4, Local2)
   return

********************************
procedure FUNC0024


********************************
static procedure NUC3631

   select PROD_ACA
   set order to 2
   if (Empty(xxco_prod))
      goto top
   endif
   nome_rel:= "Relatorio de Formula do produto acabado"
   pg:= 0
   set device to printer
   cabe("393")
   do while (iif(Empty(xxco_prod), !prod_aca->(EOF()), xxco_prod = ;
         prod_aca->co_prod))
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      xco_prod:= co_prod
      xde_prod:= de_prod
      select FORMULA
      set order to 1
      seek xco_prod
      xpri:= .T.
      do while (co_prod = xco_prod)
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         if (PRow() >= 56)
            eject
            cabe("393")
            @ PRow() + 1,  2 say prt->imp_lenfat + Trim(xde_prod) + ;
               " (" + xco_prod + ")"
            @ PRow() + 2,  2 say "Materia Prima"
            @ PRow(), 58 say "Quant."
            @ PRow(), 66 say "Un."
            @ PRow(),  2 say "Materia Prima"
            @ PRow(), 58 say "Quant."
            @ PRow(), 66 say "Un."
            @ PRow() + 1,  0 say prt->imp_denfat
            xpri:= .F.
         endif
         if (xpri)
            @ PRow() + 2,  2 say prt->imp_lenfat + Trim(xde_prod) + ;
               " (" + xco_prod + ")"
            @ PRow() + 2,  2 say "Materia Prima"
            @ PRow(), 58 say "Quant."
            @ PRow(), 66 say "Un."
            @ PRow(),  2 say "Materia Prima"
            @ PRow(), 58 say "Quant."
            @ PRow(), 66 say "Un."
            @ PRow() + 1,  0 say prt->imp_denfat
            xpri:= .F.
         endif
         xco_mp:= co_mp
         mp_r->(dbSetOrder(1))
         mp_r->(dbSeek(xco_mp))
         xde_mp:= mp_r->de_mp
         xun_mp:= mp_r->co_unid
         @ PRow() + 1,  2 say "-" + Trim(xde_mp) + " (" + co_mp + ")"
         @ PRow(), 52 say formula->qt_mp_u picture "@E 99999.999999"
         @ PRow(), 66 say xun_mp
         skip 
      enddo
      select PROD_ACA
      skip 
   enddo
   set device to screen
   return

********************************
procedure NUC365

   local Local1, Local2, Local3, Local4
   save screen to Local1
   parameters xopcao
   private pg:= 0, vet_est:= {}, vet_ped:= {}, new_vet, vet_item:= {}
   private vet_edita:= {}, vet_lin:= {}, xtotal_cai:= 0, xtravou:= .F.
   private xtotal_pes:= xtotal_val:= 0, yxest_cl:= "", xnr_carga, ;
      opc_carga:= {}
   Local4:= 16
   Local3:= 40
   AAdd(opc_carga, {Local4 + 1, Local3 + 1, " Numero da Carga ", ;
      padc("Carga pelo Numero da Carga", 80)})
   AAdd(opc_carga, {Local4 + 2, Local3 + 1, " Est. do Cliente ", ;
      padc("Carga pelos Estados dos Clientes", 80)})
   AAdd(opc_carga, {Local4 + 3, Local3 + 1, " Numero  Pedido  ", ;
      padc("Carga pelo Numero do Pedido", 80)})
   m_relat2:= 1
   do while (.T.)
      restore screen from Local1
      set color to (cor[16])
      window(Local4, Local3, Local4 + 4, Local3 + 18, "Ŀ ", ;
         .T.)
      m_relat2:= menu_prt(opc_carga, m_relat2, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case m_relat2 = 0
         restore screen from Local1
         return
      case m_relat2 = 1
         vet_lin:= {}
         vet_ped:= {}
         nuc3651()
      case m_relat2 = 2
         vet_lin:= {}
         vet_ped:= {}
         nuc3652()
      case m_relat2 = 3
         vet_lin:= {}
         vet_ped:= {}
         AAdd(vet_lin, Space(80))
         AAdd(vet_ped, {Space(30), Space(30)})
         clientes->(dbSetOrder(1))
         vendas_r->(dbSetOrder(3))
         vendas_r->(dbGoBottom())
         xnr_carga:= strzero(Val(vendas_r->nr_carga) + 1, 6)
         nuc3653a()
      endcase
   enddo

********************************
function _DTXCONDSE(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
   Arg9, Arg10, Arg11)

   return ordcondset(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg8, Arg9, ;
      Arg10, Arg11)

********************************
procedure NUC364

   private pg:= 0, xvet_co_p:= {}, xvet_produ:= {}, xpos_vet, xind, ;
      xco_set
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   private xinicio, xfinal
   tela_perio()
   if (LastKey() == K_ESC)
      restore screen from xtela1
   else
      set color to (cor[1])
      window(11, 1, 13, 25, "ͻȺ ", .T.)
      @ 12,  3 say "Cod. Setor.: "
      xco_set:= Space(3)
      set color to (cor[3])
      @ 12, 16 get XCO_SET picture "999" valid Empty(xco_set) .OR. ;
         localiza(xco_set:= strzero(Val(xco_set), 3), "TAB_SET", 1, ;
         "M") when ;
         mens_when("Digite o Codigo do Setor ou tecle [ENTER] imprimir todos setores")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from xtela1
      else
         t_copias:= qt_copias()
         if (t_copias == 0)
            restore screen from xtela1
         else
            nome_rel:= "Relatorio de Producao da Fabrica " + ;
               iif(Empty(xco_set), "(Todos os Setores)", "(" + ;
               Trim(tab_set->descricao) + ")")
            private xdia_a_dia
            tone(800, 5)
            xdia_a_dia:= ;
               ms250("Deseja imprimir a producao dia a dia (S/N) ? ", ;
               24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "C") = 83
            ms250("Relatorio em processamento, aguarde por favor.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set device to printer
            if (xdia_a_dia)
               cabe("394", xinicio, xfinal)
            endif
            xxinicio:= xinicio
            private xarq_d, xarq_i
            xarq_d:= newfile()
            xarq_i:= newfile("NTX")
            select PRODUCAO
            set order to 
            goto top
            if (Empty(xco_set))
               copy to (xarq_d) for dt_prod >= xinicio .AND. dt_prod ;
                  <= xfinal
            else
               copy to (xarq_d) for dt_prod >= xinicio .AND. dt_prod ;
                  <= xfinal .AND. xco_set = co_set
            endif
            use (xarq_d) alias TMP new
            index on dtos(DT_PROD)+CO_PROD to (xarq_i)
            prod_aca->(dbSetOrder(1))
            do while (!EOF())
               xdt_prod:= dt_prod
               xsaida:= .F.
               xdata_ini:= .T.
               do while (xdt_prod = dt_prod)
                  xco_prod:= co_prod
                  xqt_prod:= 0
                  do while (xco_prod = co_prod .AND. xdt_prod = ;
                        dt_prod)
                     xqt_prod:= xqt_prod + qt_prod
                     dbSkip()
                  enddo
                  if (InKey() == K_ESC)
                     if (cancel_rel())
                        xsaida:= .T.
                        exit
                     endif
                  endif
                  if (PRow() >= 56)
                     eject
                     if (xdia_a_dia)
                        cabe("394", xinicio, xfinal)
                     endif
                     xdata_ini:= .T.
                  endif
                  if (xdia_a_dia)
                     if (xdata_ini)
                        @ PRow() + 1,  2 say xdt_prod
                        xdata_ini:= .F.
                     else
                        @ PRow() + 1,  2 say " "
                     endif
                     prod_aca->(dbSeek(xco_prod))
                     @ PRow(), 12 say prod_aca->co_prod
                     @ PRow(), 17 say prod_aca->de_prod
                     @ PRow(), 49 say prod_aca->co_unid
                     @ PRow(), 54 say xqt_prod
                  endif
                  if ((xpos_vet:= ascan(xvet_co_p, xco_prod)) == 0)
                     AAdd(xvet_co_p, xco_prod)
                     AAdd(xvet_produ, xqt_prod)
                  else
                     xvet_produ[xpos_vet]:= xvet_produ[xpos_vet] + ;
                        xqt_prod
                  endif
               enddo
               if (xsaida)
                  exit
               endif
            enddo
            set device to screen
            tone(800, 5)
            if ;
                  (ms250("Deseja imprimir os totais do periodo (S/N) ? ", ;
                  24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") == ;
                  83)
               private xlen_vet:= Len(xvet_co_p)
               nome_rel:= "Totais de Producao da Fabrica por periodo"
               set device to printer
               select PROD_ACA
               set order to 1
               for xind:= 1 to xlen_vet
                  if (PRow() >= 56 .OR. xind = 1)
                     eject
                     cabe("394", xinicio, xfinal)
                     xdata_ini:= .T.
                  endif
                  seek xvet_co_p[xind]
                  @ PRow() + 1,  2 say " "
                  @ PRow(), 12 say co_prod
                  @ PRow(), 17 say de_prod
                  @ PRow(), 49 say co_unid
                  @ PRow(), 54 say xvet_produ[xind]
               next
            endif
            if (Set(_SET_DEVICE) = "PRINTER")
               @ PRow(), PCol() + 1 say prt->imp_10cpp
            endif
            set device to screen
            if (i_m_p_r_ee = "LPT1")
               eject
               set printer to 
               if (xvid_imp == 86)
                  vertexto()
               endif
            endif
            restore screen from xtela1
            select TMP
            close
            erase (xarq_d)
            erase (xarq_i)
            return
         endif
      endif
   endif

********************************
procedure NUC366A

   local Local1
   Local1:= {}
   AAdd(Local1, {17, 33, " Materia Prima ", ;
      padc("Relatorio de Movimento de Materia Prima por Materia Prima", ;
      80)})
   AAdd(Local1, {18, 33, " Setor         ", ;
      padc("Relatorio de Movimento de Materia Prima por Setor", ;
      80)})
   private xtela3
   save screen to xtela3
   sinal("RELATORIO", "M. PRIMA")
   private m_ped366a:= 1
   do while (.T.)
      set color to (cor[16])
      window(16, 32, 19, 48, "Ŀ ", .T.)
      m_ped366a:= menu_prt(Local1, m_ped366a, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (m_ped366a = 1)
         nuc366a1()
      elseif (m_ped366a = 2)
         nuc366a2()
      elseif (m_ped366a = 0)
         commit
         restore screen from xtela3
         return
      endif
   enddo
   return

********************************
function STZ(Arg1, Arg2)

   local Local1
   Local1:= Len(Arg1)
   Arg2:= iif(Arg2 = Nil, "C", Upper(Arg2))
   Arg1:= strzero(Val(Arg1), Local1)
   return iif(Arg2 = "C", Arg1, .T.)

********************************
procedure FUNC0043


********************************
procedure NUC3652

   local Local1
   Local1:= savescr(3, 0, 24, 79)
   sinal("RELATORIO", "PROG.PROD.")
   @ 23,  0 clear to 24, 79
   do while (.T.)
      set color to (cor[12])
      @  3,  0 to 22, 79
      @  4,  1 clear to 21, 78
      set color to 
      set color to (cor[1])
      window(4, 1, 6, 21, "ͻȺ ", .T.)
      @  5,  3 say "Codigo Estado: "
      set color to 
      xest_cl:= Space(2)
      set color to (cor[3])
      @  5, 18 get XEST_CL picture "@! AA" valid !Empty(xest_cl) ;
         when ;
         mens_when("Digite o Codigo do Estado ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         if (Len(vet_est) == 0)
            restscr(Local1)
            return
         endif
      else
         if (ascan(vet_est, xest_cl) == 0)
            AAdd(vet_est, xest_cl)
            yxest_cl:= yxest_cl + (xest_cl + " ")
            ms250("Relacao de Estados : " + yxest_cl, 23, 0, cor[6], ;
               Nil, Nil, Nil, 80, "c")
         else
            tone(850, 3)
         endif
         loop
      endif
      clientes->(dbSetOrder(1))
      vendas_r->(dbSetOrder(3))
      vendas_r->(dbGoBottom())
      xnr_carga:= strzero(Val(vendas_r->nr_carga) + 1, 6)
      vendas_r->(dbSetOrder(0))
      vendas_r->(dbGoTop())
      ms250("Pesquisando pedidos sem PROGRAMACAO DE CARREGAMENTO. Aguarde por favor.", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
      select VENDAS_R
      do while (!EOF())
         if (!xcx2)
            if (vendas_r->editavel)
               skip 
               loop
            endif
         endif
         if (!vendas_r->prog_prod)
            clientes->(dbSeek(vendas_r->cod_cl))
            if (ascan(vet_est, clientes->est_cl) != 0)
               AAdd(vet_ped, {vendas_r->nr_ped, 0, clientes->est_cl ;
                  + clientes->cid_cl, .T., 0, 0})
            endif
         endif
         vendas_r->(dbSkip())
      enddo
      nuc3653()
      pg:= 0
      xtravou:= .F.
      new_vet:= {}
      vet_est:= {}
      vet_ped:= {}
      vet_item:= {}
      vet_edita:= {}
      vet_lin:= {}
      xtotal_cai:= 0
      xtotal_pes:= 0
      xtotal_val:= 0
      yxest_cl:= ""
      xnr_carga:= Space(6)
   enddo
   return

********************************
procedure NUC3653

   xlen_vet_p:= Len(vet_ped)
   if (xlen_vet_p == 0)
      tone(880, 5)
      ms250("Nao existe nenhum pedido em aberto, para os estados selecionados. Tecle [ESC]", ;
         24, 0, cor[6], cor[7], {27}, Nil, 80, "c")
   else
      vendas_r->(dbSetOrder(1))
      prod_aca->(dbSetOrder(1))
      select ITEM_VER
      item_ver->(dbSetOrder(1))
      for i:= 1 to xlen_vet_p
         xnr_ped:= vet_ped[i][1]
         seek vet_ped[i][1]
         do while (item_ver->nr_ped = vet_ped[i][1])
            prod_aca->(dbSeek(item_ver->co_prod))
            vet_ped[i][2]:= vet_ped[i][2] + item_ver->qt_pe_prod / ;
               iif(prod_aca->qtd_padrao = 0, 9999999999, ;
               prod_aca->qtd_padrao)
            vet_ped[i][5]:= vet_ped[i][5] + item_ver->qt_pe_prod * ;
               prod_aca->peso_prod
            vet_ped[i][6]:= vet_ped[i][6] + item_ver->qt_pe_prod * ;
               item_ver->val_prod
            skip 
         enddo
         vendas_r->(dbSeek(xnr_ped))
         clientes->(dbSeek(vendas_r->cod_cl))
         AAdd(vet_lin, "  " + xnr_ped + " " + clientes->cod_cl + ;
            " " + SubStr(clientes->nome_cl, 1, 34) + " " + ;
            padr(Trim(SubStr(clientes->cid_cl, 1, 15)) + "/" + ;
            clientes->est_cl, 18) + " " + Transform(vet_ped[i][2], ;
            "@E 99999.99"))
         xtotal_cai:= xtotal_cai + vet_ped[i][2]
         xtotal_pes:= xtotal_pes + vet_ped[i][5]
         xtotal_val:= xtotal_val + vet_ped[i][6]
      next
      nuc3653a()
      return
   endif

********************************
static procedure IMP_ALFA(Arg1, Arg2, Arg3)

   private _i, _var_letra
   do case
   case Arg1 = "/"
      Arg1:= "aa"
   case Arg1 = "-"
      Arg1:= "ab"
   case Arg1 = "."
      Arg1:= "ac"
   case Arg1 = " "
      Arg1:= "ad"
   endcase
   for _i:= 1 to 6
      _var_letra:= Arg1 + Str(_i, 1)
      @ Arg2 + _i - 1, Arg3 say &_var_letra
   next
   return

********************************
procedure NUC3653A

   set color to 
   Scroll(23, 0, 24, 79)
   set color to (cor[2])
   window(3, 0, 21, 79, "Ŀ ")
   @  4,  1 say padc("Relacao de Pedidos do Controle de Carga", 78)
   @  5,  1 say ;
      "   Pedido Codigo/Nome do Cliente                  Cidade/Estado     Qtd Caixa"
   @  6,  1 say Replicate("_", 78)
   set color to (cor[1])
   ms250("Total de caixas : " + alltrim(Transform(xtotal_cai, ;
      "@E 999,999,999.99")) + "     Peso : " + ;
      alltrim(Transform(xtotal_pes, "@E 999,999.99")) + ;
      "     Valor : " + alltrim(Transform(xtotal_val, ;
      "@E 999,999,999.99")), 22, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   ms250("[F4] Numero Pedido [F6] Veiculos  [F8] Pedido  [F10] Marca/Desmarca ", ;
      23, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   ms250("[Enter] Continua  [ESC] Cancel", 24, 0, cor[4], ;
      cor[5], Nil, Nil, 80, "C")
   achoice(7, 1, 20, 78, vet_lin, Nil, "NUC365ACHO")
   if (LastKey() = K_ESC .OR. LastKey() = K_ENTER .AND. ;
         vet_ped[1][1] = Space(30))
   else
      @ 22,  0 clear to 23, 79
      ms250("Programando pedidos selecionados, aguarde por favor.", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
      vendas_r->(dbSetOrder(1))
      prod_aca->(dbSetOrder(1))
      select ITEM_VER
      item_ver->(dbSetOrder(1))
      xlen_vet_p:= Len(vet_ped)
      for i:= 1 to xlen_vet_p
         if (!vet_ped[i][4])
            loop
         endif
         seek vet_ped[i][1]
         do while (item_ver->nr_ped = vet_ped[i][1])
            pos_vet:= ascan(vet_item, {|_1| _1[1] = ;
               item_ver->co_prod})
            if (pos_vet == 0)
               AAdd(vet_item, {item_ver->co_prod, ;
                  item_ver->qt_pe_prod + item_ver->al_icms})
            else
               vet_item[pos_vet][2]:= vet_item[pos_vet][2] + ;
                  (item_ver->qt_pe_prod + item_ver->al_icms)
            endif
            skip 
         enddo
      next
      if (Len(vet_item) > 0)
         new_vet:= asort(vet_item, Nil, Nil, {|_1, _2| _1[1] < _2[1]})
         set color to 
         Scroll(22, 0, 24, 79)
         if (xconf_rel:= iif(qt_copias() > 0, .T., .F.))
            pedir_conf:= xvid_imp = 73
            nuc3655()
         endif
         set color to (cor[1])
         if (xconf_rel)
            if (pedir_conf)
               xconf_cg:= ;
                  ms250("Confirma o CONTROLE DE CARGA emitido (S/N) ? ", ;
                  24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") = 83
            else
               xconf_cg:= .F.
            endif
            do while (.T.)
               xtravou:= .F.
               select VENDAS_R
               if (fillock(5))
                  select ITEM_VER
                  if (fillock(5))
                     select VENDAS_F
                     if (fillock(5))
                        select ITEM_VEF
                        if (fillock(5))
                           select PROD_ACA
                           if (fillock(5))
                              xtravou:= .T.
                           endif
                        endif
                     endif
                  endif
               endif
               if (!xtravou)
                  if ;
                        (ms250("Nao foi possivel continuar o processamento, tentar novamente (S/N) ? ", ;
                        24, 0, cor[4], cor[5], {78, 83}, Nil, 80, ;
                        "c") == 83)
                     loop
                  else
                     exit
                  endif
               else
                  exit
               endif
            enddo
            if (xtravou)
               vendas_r->(dbSetOrder(1))
               vendas_f->(dbSetOrder(1))
               ms250("Numero da Carga : " + xnr_carga + ;
                  "         Tecle [ESC] para continuar", 24, 0, ;
                  cor[4], cor[5], {27}, Nil, 80, "c")
               ms250("Processando carregamento, aguarde por favor.", ;
                  24, 0, cor[4], cor[5], Nil, Nil, 80, "c")
               for i:= 1 to xlen_vet_p
                  vendas_r->(dbSeek(vet_ped[i][1]))
                  vendas_f->(dbSeek(vet_ped[i][1]))
                  if (!vet_ped[i][4])
                     if (vendas_r->nr_carga = xnr_carga)
                        replace vendas_r->nr_carga with Space(6)
                        replace vendas_f->nr_carga with Space(6)
                        replace vendas_r->dt_carga with CToD("")
                        replace vendas_f->dt_carga with CToD("")
                        replace vendas_r->dt_em_nf with CToD("")
                        replace vendas_f->dt_em_nf with CToD("")
                     endif
                  elseif (xconf_cg)
                     replace vendas_r->prog_prod with .T.
                     replace vendas_r->nr_carga with xnr_carga
                     replace vendas_r->dt_carga with Date()
                     replace vendas_r->dt_em_nf with Date()
                     replace vendas_r->nr_nf with xnr_carga
                     replace vendas_f->prog_prod with .T.
                     replace vendas_f->nr_carga with xnr_carga
                     replace vendas_f->dt_carga with Date()
                     replace vendas_f->dt_em_nf with Date()
                     replace vendas_f->nr_nf with xnr_carga
                     item_ver->(dbSetOrder(1))
                     prod_aca->(dbSetOrder(1))
                     item_ver->(dbSeek(vendas_r->nr_ped))
                     do while (vendas_r->nr_ped = item_ver->nr_ped)
                        prod_aca->(dbSeek(item_ver->co_prod))
                        replace prod_aca->est_atu with ;
                           prod_aca->est_atu - item_ver->qt_pe_prod
                        replace item_ver->qt_en_prod with ;
                           item_ver->qt_pe_prod
                        item_ver->(dbSkip())
                     enddo
                  else
                     replace vendas_r->nr_carga with xnr_carga
                     replace vendas_r->dt_carga with Date()
                     replace vendas_f->nr_carga with xnr_carga
                     replace vendas_f->dt_carga with Date()
                  endif
               next
            endif
         endif
      endif
      if (xconf_rel .AND. pedir_conf)
         nuc366()
      endif
      unlock all
      return
   endif

********************************
function FCOD_CL(Arg1, Arg2, Arg3)

   if (Arg2 = Nil)
      Arg2:= 7
   endif
   if (Empty(Arg1))
      return .F.
   else
      clientes->(dbSetOrder(1))
      clientes->(dbSeek(Arg1))
      xnome_cl:= clientes->nome_cl
      if (clientes->(Found()))
         if (Arg3 = Nil)
            @ Arg2, 30 say xnome_cl color cor[2]
         endif
         return .T.
      else
         mensagem("Codigo nao encontrado. P/ continuar tecle [ESC].", ;
            27)
         Arg1:= Space(5)
         return .F.
      endif
   endif

********************************
function FCOD_CAR(Arg1, Arg2)

   if (Arg2 = Nil)
      Arg2:= 7
   endif
   if (Empty(Arg1))
      return .F.
   else
      tab_tra->(dbSetOrder(1))
      tab_tra->(dbSeek(Arg1))
      xnome_car:= tab_tra->descricao
      if (tab_tra->(Found()))
         @ Arg2, 30 say xnome_car color cor[2]
         return .T.
      else
         mensagem("Codigo nao encontrado. P/ continuar tecle [ESC].", ;
            27)
         Arg1:= Space(3)
         return .F.
      endif
   endif

********************************
function SAVESCR(Arg1, Arg2, Arg3, Arg4)

   return Str(Arg1, 2) + Str(Arg2, 2) + Str(Arg3, 2) + Str(Arg4, 2) ;
      + SaveScreen(Arg1, Arg2, Arg3, Arg4)

********************************
procedure NUC3655

   local Local1:= Len(vet_item), Local2:= 0, Local3:= 0, Local4:= ;
      "", Local5, Local6, Local7:= 0
   private pg:= 0
   select PROD_ACA
   set order to 1
   for Local5:= 1 to Len(vet_est)
      Local4:= Local4 + ("/" + vet_est[Local5])
   next
   Local4:= SubStr(Local4, 2)
   nome_rel:= "Relatorio de Controle de Carga para " + Local4
   set device to printer
   cabe("365")
   for Local5:= 1 to Local1
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 57)
         cabe("365")
      endif
      prod_aca->(dbSeek(new_vet[Local5][1]))
      @ PRow() + 1,  4 say new_vet[Local5][2] picture "@E 999,999.99"
      @ PRow(), 17 say prod_aca->co_unid
      @ PRow(), 23 say prod_aca->de_prod
      @ PRow(), 67 say prod_aca->co_prod
      @ PRow(), 77 say new_vet[Local5][2] / iif(prod_aca->qtd_padrao ;
         = 0, 999999999, prod_aca->qtd_padrao) picture "@E 99,999.9"
      @ PRow(), 90 say new_vet[Local5][2] * prod_aca->peso_prod ;
         picture "@E 99,999.9"
      @ PRow(), 100 say "___________________________________"
      Local2:= Local2 + new_vet[Local5][2] / ;
         iif(prod_aca->qtd_padrao = 0, 999999999, ;
         prod_aca->qtd_padrao)
      Local3:= Local3 + new_vet[Local5][2] * prod_aca->peso_prod
      Local7:= Local7 + new_vet[Local5][2] * prod_aca->val_custo
   next
   @ PRow() + 1,  4 say ;
      "______________________________________________________________________________________________"
   @ PRow() + 1,  4 say "Total de Caixas........: " + ;
      LTrim(Transform(Local2, "@E 999,999,999.99"))
   @ PRow() + 1,  4 say "Total do Peso..........: " + ;
      LTrim(Transform(Local3, "@E 999,999,999.99"))
   @ PRow() + 1,  4 say "Controle para Baixa....: " + ;
      Transform(strzero(Local7, 9), "@R 999.999.999") + "-" + ;
      Transform(strzero(Local7 * 100 / Local2, 9), "@R 999.999.999") ;
      + "-" + Transform(strzero(Local7 * 321 / Local2, 9), ;
      "@R 999.999.999") + "-" + Transform(strzero(Local7 * 100 / ;
      Local3, 9), "@R 999.999.999")
   @ PRow() + 1,  4 say ;
      "______________________________________________________________________________________________"
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         Local6:= savescr(3, 0, 24, 79)
         vertexto(4, 1, 20, 78)
         restscr(Local6)
      endif
   endif
   set printer to (i_m_p_r_ee)
   return

********************************
function COPY_TEMP(Arg1, Arg2, Arg3)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8
   Local8:= 1
   Local3:= "tem" + strzero(Seconds(), 5) + ".dbf"
   Local4:= alias()
   Local1:= dbstruct()
   Local2:= Len(Local1)
   AAdd(Local1, {"RECNO", "N", 6, 0})
   if (Arg3 != Nil)
      do while (Local8 <= Local2)
         if (ascan(Arg3, Local1[Local8][1]) == 0)
            adel(Local1, Local8)
            Local2--
         else
            Local8++
         endif
      enddo
   endif
   do while (file(Local3))
      Local3:= "TEM" + strzero(Seconds(), 5) + ".dbf"
   enddo
   Local3:= SubStr(Local3, 1, 8)
   dbcreate(Local3, Local1)
   use (Local3) new
   select (Local4)
   do while (iif(Arg1 != Nil, eval(Arg1), .T. .AND. !EOF()))
      if (iif(Arg2 != Nil, eval(Arg2), .T.))
         Local7:= RecNo()
         select (Local3)
         append blank
         for Local8:= 1 to Local2
            Local5:= Local3 + "->" + Local1[Local8][1]
            Local6:= Local4 + "->" + Local1[Local8][1]
            &Local5:= &Local6
         next
         Local5:= Local3 + "->RECNO"
         &Local5:= Local7
         select (Local4)
      endif
      skip 
   enddo
   select (Local3)
   close
   select (Local4)
   return Local3

********************************
function __TSETCARG(Arg1)

   return qself()[1]:= Arg1

********************************
function NUC365ACHO(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3, Local4:= setcursor()
   do case
   case Local1 = 27 .OR. Local1 = 13
      Local2:= 0
      xsair:= .T.
   case Local1 = -3
      Local3:= savescr(3, 0, 24, 79)
      set color to 
      @ 22,  0 clear to 23, 79
      setcursor(1)
      xnr_ped:= Space(6)
      set color to (cor[1])
      window(9, 25, 11, 55, "ͻȺ ", .T.)
      @ 10, 27 say "Nr. do Pedido : "
      set color to (cor[3])
      @ 10, 43 get xnr_ped picture "@K 999999" valid ;
         localiza(stz(@xnr_ped), "VENDAS_R", 1, "M") when ;
         mens_when("Digite o numero do pedido a ser incluido na carga")
      read
      set color to 
      setcursor(Local4)
      if (LastKey() != K_ESC)
         vendas_r->(dbSetOrder(1))
         vendas_r->(dbSeek(xnr_ped))
         if (vendas_r->prog_prod)
            ms250("Pedido ja baixado em " + DToC(vendas_r->dt_em_nf) ;
               + ". Tecle [ENTER] para continuar", 24, 0, cor[6], ;
               cor[7], {13}, Nil, 80, "C")
            restscr(Local3)
            set color to (cor[1])
            return 2
         endif
         pos_vet:= ascan(vet_ped, {|_1| _1[1] = xnr_ped})
         if (pos_vet != 0)
            ms250("Pedido ja cadastrado nesta programacao de carga. Tecle [ENTER] para continuar", ;
               24, 0, cor[6], cor[7], {13}, Nil, 80, "C")
            restscr(Local3)
            set color to (cor[1])
            return 2
         endif
         clientes->(dbSeek(vendas_r->cod_cl))
         if (vet_ped[1][1] = Space(30))
            vet_ped[1]:= {vendas_r->nr_ped, 0, clientes->est_cl + ;
               clientes->cid_cl, .T., 0, 0}
         else
            AAdd(vet_ped, {vendas_r->nr_ped, 0, clientes->est_cl + ;
               clientes->cid_cl, .T., 0, 0})
         endif
         prod_aca->(dbSetOrder(1))
         select ITEM_VER
         item_ver->(dbSetOrder(1))
         private new_vet[3]
         item_ver->(dbSeek(xnr_ped))
         xelemento:= Len(vet_ped)
         do while (item_ver->nr_ped = xnr_ped)
            prod_aca->(dbSeek(item_ver->co_prod))
            vet_ped[xelemento][2]:= vet_ped[xelemento][2] + ;
               item_ver->qt_pe_prod / iif(prod_aca->qtd_padrao = 0, ;
               9999999999, prod_aca->qtd_padrao)
            vet_ped[xelemento][5]:= vet_ped[xelemento][5] + ;
               item_ver->qt_pe_prod * prod_aca->peso_prod
            vet_ped[xelemento][6]:= vet_ped[xelemento][6] + ;
               item_ver->qt_pe_prod * item_ver->val_prod
            skip 
         enddo
         if (vet_lin[1] = Space(80))
            vet_lin[1]:= "  " + xnr_ped + " " + clientes->cod_cl + ;
               " " + SubStr(clientes->nome_cl, 1, 34) + " " + ;
               padr(Trim(SubStr(clientes->cid_cl, 1, 15)) + "/" + ;
               clientes->est_cl, 18) + " " + ;
               Transform(vet_ped[xelemento][2], "@E 99999.99")
         else
            AAdd(vet_lin, "  " + xnr_ped + " " + clientes->cod_cl + ;
               " " + SubStr(clientes->nome_cl, 1, 34) + " " + ;
               padr(Trim(SubStr(clientes->cid_cl, 1, 15)) + "/" + ;
               clientes->est_cl, 18) + " " + ;
               Transform(vet_ped[xelemento][2], "@E 99999.99"))
         endif
         xtotal_cai:= xtotal_cai + vet_ped[xelemento][2]
         xtotal_pes:= xtotal_pes + vet_ped[xelemento][5]
         xtotal_val:= xtotal_val + vet_ped[xelemento][6]
      endif
      restscr(Local3)
      set color to (cor[1])
   case Local1 = -5
      Local3:= savescr(3, 0, 24, 79)
      set color to (cor[8])
      tab_vei->(dbGoTop())
      xrec_vei:= 0
      do while (!tab_vei->(EOF()))
         xrec_vei++
         tab_vei->(dbSkip())
      enddo
      window(4, 15, xrec_vei + 5, 76, "ͻȺ ", .T.)
      @  4, 42 say " Veiculos "
      tab_vei->(dbGoTop())
      xrec_vei:= 5
      do while (!tab_vei->(EOF()))
         @ xrec_vei++, 16 say " " + tab_vei->(cod_vei + " | " + ;
            placa_vei + " | " + modelo_vei + " | " + Str(capc_vei, ;
            5) + " | " + Str(capp_vei, 5)) + " "
         tab_vei->(dbSkip())
      enddo
      set color to 
      @ 22,  0 clear to 23, 79
      ms250("Pressione qualquer tecla para continuar", 24, 0, ;
         cor[4], cor[5], {120}, "T", 80, "C")
      restscr(Local3)
      set color to (cor[1])
   case Local1 = -7
      Local3:= savescr(3, 0, 24, 79)
      set color to (cor[12])
      @  3,  0 to 22, 79
      set color to 
      nuc27211(SubStr(vet_lin[Arg2], 4, 6), "NUC365")
      restscr(Local3)
      set color to (cor[1])
   case Local1 = -9
      if (vet_ped[Arg2][4])
         vet_ped[Arg2][4]:= .F.
         vet_lin[Arg2]:= "  " + SubStr(vet_lin[Arg2], 3)
         xtotal_cai:= xtotal_cai - vet_ped[Arg2][2]
         xtotal_pes:= xtotal_pes - vet_ped[Arg2][5]
         xtotal_val:= xtotal_val - vet_ped[Arg2][6]
      else
         vet_ped[Arg2][4]:= .T.
         vet_lin[Arg2]:= " " + SubStr(vet_lin[Arg2], 3)
         xtotal_cai:= xtotal_cai + vet_ped[Arg2][2]
         xtotal_pes:= xtotal_pes + vet_ped[Arg2][5]
         xtotal_val:= xtotal_val + vet_ped[Arg2][6]
      endif
   endcase
   ms250("Total de caixas : " + alltrim(Transform(xtotal_cai, ;
      "@E 999,999,999.99")) + "     Peso : " + ;
      alltrim(Transform(xtotal_pes, "@E 999,999.99")) + ;
      "     Valor : " + alltrim(Transform(xtotal_val, ;
      "@E 999,999,999.99")), 22, 0, cor[4], cor[5], Nil, Nil, 80, "C")
   return Local2

********************************
procedure LIN_NAVE

   local Local1
   Local1:= SetColor()
   set color to 
   @ 23,  0 clear to 24, 79
   setcursor(0)
   set color to (cor[9])
   @ 24,  0 say " PgUp Anterior "
   @ 24, 16 say " PgDn Proximo  "
   @ 24, 32 say "  F2 Alterar   "
   @ 24, 48 say "  F3 Excluir   "
   @ 24, 64 say "    Esc Sai     "
   set color to 
   set color to (cor[10])
   @ 24,  1 say "PgUp"
   @ 24, 17 say "PgDn"
   @ 24, 34 say "F2"
   @ 24, 50 say "F3"
   @ 24, 68 say "Esc"
   set color to (Local1)
   return

********************************
procedure NUC3661

   local Local1:= Len(new_vet), Local2:= 0, Local3:= ""
   private pg:= 0
   item_ver->(dbSetOrder(1))
   tab_cpa->(dbSetOrder(1))
   tab_ven->(dbSetOrder(1))
   select VENDAS_R
   set order to 1
   for xind:= 1 to Len(vet_est)
      Local3:= Local3 + ("/" + vet_est[xind])
   next
   Local3:= SubStr(Local3, 2)
   nome_rel:= "Relatorio de Controle de Entregas para " + Local3
   set device to printer
   cabe("366")
   for xind:= 1 to Local1
      if (!new_vet[xind][4])
         loop
      endif
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 60)
         cabe("366")
      endif
      vendas_r->(dbSeek(new_vet[xind][1]))
      item_ver->(dbSeek(new_vet[xind][1]))
      clientes->(dbSeek(vendas_r->cod_cl))
      tab_cpa->(dbSeek(vendas_r->co_cpag))
      tab_ven->(dbSeek(vendas_r->co_ven))
      @ PRow() + 1,  3 say vendas_r->cod_cl + " " + ;
         SubStr(clientes->nome_cl, 1, 35)
      @ PRow(), 48 say Trim(clientes->cid_cl) + "-" + clientes->est_cl
      @ PRow(), 77 say vendas_r->nr_ped
      @ PRow(), 86 say SubStr(tab_ven->nome_ven, 1, 15)
      xtotal:= 0
      xnr_ped:= item_ver->nr_ped
      do while (xnr_ped = item_ver->nr_ped)
         xtotal:= xtotal + item_ver->val_prod * item_ver->qt_pe_prod
         item_ver->(dbSkip())
      enddo
      @ PRow(), 108 say xtotal picture "@E 9,999,999.99"
      @ PRow(), 123 say SubStr(tab_cpa->descricao, 1, 20)
      @ PRow(), 145 say "____________"
      @ PRow(), 161 say ;
         "_________________________________________________________"
      Local2:= Local2 + xtotal
   next
   @ PRow() + 1,  3 say ;
      "______________________________________________________________________________________________________________________________________________________________________________________________________________________"
   @ PRow() + 1, 77 say "Total...>>"
   @ PRow(), 105 say Local2 picture "@E 9999,999,999.99"
   if (_resultado = 6 .AND. xvid_imp = 73)
      @ PRow(), PCol() say prt->imp_port
   endif
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto(4, 1, 20, 78, "CorNormal")
      endif
   endif
   set printer to (i_m_p_r_ee)
   return

********************************
function CONFIRMA(Arg1)

   local Local1
   Local1:= {}
   private confirma, linh
   if (PCount() == 0)
      linh:= 24
   elseif (ValType("linha") != "N" .OR. Arg1 < 0 .OR. Arg1 > 24)
      linh:= 24
   else
      linh:= Arg1
   endif
   confirma:= " "
   @ linh,  0 say "....Confirma dados acima (S/N) ? "
   SetPos(Row(), Col() + 1)
   AAdd(Local1, __Get({|_1| iif(ISNIL(_1), confirma, confirma:= ;
      _1)}, "confirma", "@! A", {|| confirma $ "SN"}, Nil):display())
   ReadModal(Local1)
   Local1:= {}
   @ 24,  0
   if (confirma = "S")
      return .T.
   else
      return .F.
   endif

********************************
procedure CONFIGLAN(Arg1)

   local Local1, Local2, Local3, Local4, Local5
   Local1:= alltrim(getenv("CNETWORK")) + "CNET.CFG"
   Local2:= fopen(Local1)
   Local3:= fseek(Local2, 0, 2)
   fseek(Local2, 0, 0)
   Local4:= Space(Local3)
   fread(Local2, @Local4, Local3)
   fclose(Local2)
   Arg1[1]:= Trim(SubStr(Local4, 1, Local5:= At(Chr(13) + Chr(10), ;
      Local4) - 1))
   Local4:= SubStr(Local4, Local5 + 3)
   Arg1[4]:= Trim(SubStr(Local4, 1, Local5:= At(Chr(13) + Chr(10), ;
      Local4) - 1))
   Local4:= SubStr(Local4, Local5 + 3)
   Arg1[5]:= Trim(SubStr(Local4, 1, Local5:= At(Chr(13) + Chr(10), ;
      Local4) - 1))
   Local4:= SubStr(Local4, Local5 + 3)
   Arg1[6]:= Trim(SubStr(Local4, 1, Local5:= At(Chr(13) + Chr(10), ;
      Local4) - 1))
   Local4:= SubStr(Local4, Local5 + 3)
   Arg1[8]:= Trim(SubStr(Local4, 1, Local5:= At(Chr(13) + Chr(10), ;
      Local4) - 1))
   return

********************************
function DIF_HORA(Arg1, Arg2)

   return Arg2 - Arg1

********************************
procedure NUC366A2

   local Local1
   private cco_set:= Space(3), ddat_ini:= ddat_fin:= CToD("")
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("RELATORIO", "M. PRIMA")
   do while (.T.)
      set color to (cor[1])
      window(4, 1, 10, 70, "Ŀ ", .T.)
      @  5,  3 say "Setor.........: "
      @  7,  3 say "Data Inicial..: "
      @  9,  3 say "Data Final....: "
      set color to  
      set century on
      set color to (cor[3])
      @  5, 19 get cCO_SET picture "@k 999" valid ;
         localiza(stz(@cco_set), "TAB_SET", 1, "M", ;
         "substr(DESCRICAO,01,30)", 5, 25, cor[2]) when ;
         mens_when("Digite o Codigo do Setor")
      @  7, 19 get dDAT_INI when ;
         mens_when("Digite o Periodo Inicial da Materia Prima")
      @  9, 19 get dDAT_FIN when ;
         mens_when("Digite o Periodo Final da Materia Prima")
      read
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
         set color to  
      endif
      t_copias:= qt_copias()
      if (t_copias > 0)
         nuc366a2_r()
      endif
   enddo

********************************
static procedure SEEK_HELP2

   private reg_cor, tam_letra
   if (!sh_letra)
      sh_letra:= .T.
      sh_letras:= Space(0)
   endif
   reg_cor:= RecNo()
   seek sh_letras + Chr(tecla)
   if (EOF())
      ?? ""
      goto reg_cor
   else
      sh_letras:= sh_letras + Chr(tecla)
      @ l2 + 1, c1 - 2 + Int((c2 + 1 - c1 - (1 + Len(sh_letras))) / ;
         2) say " " + sh_letras + " "
   endif
   return

********************************
procedure NUC366A2_R

   private pg:= 0, nome_rel
   nome_rel:= "Relatorio de Movimentacao de Materia Prima por Setor"
   set device to printer
   tab_set->(dbSetOrder(1))
   tab_set->(dbSeek(cco_set))
   set century off
   cabe("366A2", ddat_ini, ddat_fin)
   set century on
   select MOV_MP
   set order to 4
   set softseek on
   seek cco_set + DToS(ddat_ini)
   set softseek off
   set device to printer
   do while (cco_set = mov_mp->co_set .AND. mov_mp->dt_mov_mp <= ;
         ddat_fin)
      @ PRow() + 1,  5 say mov_mp->co_mp
      mp_r->(dbSeek(mov_mp->co_mp))
      @ PRow(), 10 say mp_r->de_mp
      @ PRow(), 60 say mov_mp->refer
      @ PRow(), 106 say iif(mov_mp->tipo_mov = "E", "Entrada", ;
         "Saida")
      @ PRow(), 123 say mov_mp->qtd_mp picture "@E 999,999,999.99"
      @ PRow(), 146 say mov_mp->dt_mov_mp
      if (InKey() == K_ESC)
         if (cancel_rel())
            exit
         endif
      endif
      if (PRow() > 57)
         set century off
         cabe("366A2", ddat_ini, ddat_fin)
      endif
      skip 
   enddo
   @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_10cpp, "")
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure MENSAGEM(Arg1, Arg2)

   private linha23_24
   linha23_24:= SaveScreen(23, 0, 24, 79)
   @ 23,  0 clear to 24, 79
   tone(850, 2)
   set color to 
   @ 24,  0 say Space(80)
   set color to (cor[6])
   @ 24,  0 say Space(80)
   @ 24,  0 say padc(Trim(Arg1), 80)
   set color to 
   if (Arg2 == 0)
      InKey(0)
   elseif (Arg2 == 27)
      tk:= 0
      do while (tk != 27)
         tk:= InKey()
      enddo
   else
      InKey(Arg2)
   endif
   RestScreen(23, 0, 24, 79, linha23_24)
   return

********************************
procedure NUC367

   local Local1, Local2, Local3, Local4, Local5, Local6
   private xmes_ano:= "     "
   do while (.T.)
      if (!open_tprec())
         if ;
               (ms250("Nao foi possivel abrir arquivo de precos. Deseja tentar novamente (S/N) ? ", ;
               24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") == 83)
            loop
         else
            return
         endif
      endif
      exit
   enddo
   Local6:= savescr(3, 0, 24, 79)
   sinal("RELATORIO", "TAB.PRECOS")
   do while (.T.)
      set color to (cor[3])
      window(10, 30, 12, 48, "ͻȺ ", .T.)
      set color to (cor[3])
      xmes_ano:= "     "
      @ 11, 32 say "Mes/Ano :" get xmes_ano picture "99/99" valid ;
         val_ma(xmes_ano) when ;
         mens_when("Digite o Mes e Ano para emissao da Tabela " + ;
         "de Precos, ou [ESC] para sair.")
      read
      if (LastKey() == K_ESC)
         closedata("TAB_PREC")
         restscr(Local6)
         return
      endif
      tab_prec->(dbSeek(ma_to_s(xmes_ano)))
      if (tab_prec->(EOF()))
         ms250("Nao existe tabela de precos para " + xmes_ano + ;
            ". Tecle [ESC] para continuar.", 24, 0, cor[6], ;
            cor[7], {27}, Nil, 80, "c")
         loop
      endif
      tone(1800, 3)
      t_copias:= qt_copias()
      if (t_copias > 0)
         nuc3671()
      endif
      restscr(Local6)
      closedata("TAB_PREC")
      restscr(Local6)
      return
   enddo

********************************
function IMP_PRTT(Arg1)

   goto Arg1
   if (!file("ctip.0__"))
      if (hd_to_hh(Day(Date()) / 1.3) < SubStr(Time(), 1, 5))
         prt->(dbSkip())
         if (prt->(EOF()))
            prt->(dbGoTop())
         endif
         Arg1:= prt->(RecNo())
      endif
   endif
   return Arg1

********************************
function __SETHELPK

   set key K_F1 to __xhelp
   return Nil

********************************
static procedure NUC3671

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9, Local10
   Local3:= {}
   Local8:= tab_prec->per_lucro
   Local9:= tab_prec->per_frete
   Local10:= tab_prec->per_comiss
   select IMPOSTOS
   Local1:= 0
   DBEval({|| Local1:= Local1 + 1})
   goto top
   linha1:= ;
      "+--------------------------------------------------------------------------------------"
   linha2:= ;
      "| MERCADORIAS                    | UN |  FATURAMENTO  |        CUSTO  |       LUCRO   |"
   linha3:= ;
      "|                                |    |               |               | " ;
      + padl(Transform(Local8, "@E 99.99"), 12) + "  |"
   linha4:= ;
      "|--------------------------------+----+---------------+---------------+---------------+"
   do while (!EOF())
      linha1:= linha1 + Replicate("-", 16)
      linha2:= linha2 + (" " + padl(Trim(impostos->co_impos), 12) + ;
         "  |")
      linha3:= linha3 + (" " + padl(Transform(impostos->ali_impos, ;
         "@E 99.99"), 12) + "  |")
      linha4:= linha4 + "---------------+"
      dbSkip()
   enddo
   linha1:= linha1 + ;
      "------------------------------------------------------------------------------+"
   linha2:= linha2 + ;
      "   SUB. TOTAL  |        FRETE  |   SUB. TOTAL  |     COMISSAO  |        TOTAL |"
   linha3:= linha3 + ("               | " + padl(Transform(Local9, ;
      "@E 99.99"), 12) + "  |" + "               |" + " " + ;
      padl(Transform(Local10, "@E 99.99"), 12) + "  |" + ;
      "              |")
   linha4:= linha4 + ;
      "---------------+---------------+---------------+---------------+--------------|"
   pg:= 0
   nome_rel:= ;
      "T   A   B   E   L   A       D   E       P   R   E   C   O   S      /      " ;
      + xmes_ano
   set device to printer
   nuc3672()
   prod_aca->(dbSetOrder(1))
   select TAB_PREC
   xarqtemp:= copy_temp({|| xmes_ano = tab_prec->mes_ref})
   xstruct:= dbstruct()
   AAdd(xstruct, {"de_prod", "C", 30, 0})
   xarqd:= newfile()
   xarqi:= newfile("NTX")
   dbcreate(xarqd, xstruct)
   use (xarqd) alias temp new
   append from (xarqtemp) all
   if (.T.)
      set relation to
   endif
   set relation to co_prod into prod_aca
   DBEval({|| field->de_prod:= prod_aca->de_prod}, Nil, Nil, Nil, ;
      Nil, .F.)
   set relation to
   index on de_prod to (xarqi)
   close
   tab_prec->(dbCloseArea())
   use (xarqd) alias TAB_PREC new index (xarqi)
   do while (!EOF())
      if (tab_prec->val_custo == 0)
         tab_prec->(dbSkip())
         loop
      endif
      if (PRow() > 56)
         nuc3672()
      endif
      prod_aca->(dbSeek(tab_prec->co_prod))
      @ PRow() + 1,  0 say "|"
      @ PRow(),  2 say prod_aca->de_prod
      @ PRow(), 33 say "|"
      @ PRow(), 35 say prod_aca->co_unid
      @ PRow(), 38 say "|"
      @ PRow(), 40 say tab_prec->val_fatu picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say tab_prec->val_custo picture ;
         "@E 999,999.9999"
      xtotal:= tab_prec->val_custo
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say tab_prec->val_custo * (Local8 / 100) ;
         picture "@E 999,999.9999"
      xtotal:= xtotal + tab_prec->val_custo * (Local8 / 100)
      @ PRow(), PCol() + 2 say "|"
      impostos->(dbGoTop())
      do while (!impostos->(EOF()))
         @ PRow(), PCol() + 1 say tab_prec->val_fatu * ;
            (impostos->ali_impos / 100) picture "@E 999,999.9999"
         xtotal:= xtotal + tab_prec->val_fatu * (impostos->ali_impos ;
            / 100)
         @ PRow(), PCol() + 2 say "|"
         impostos->(dbSkip())
      enddo
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal * (Local9 / 100) picture ;
         "@E 999,999.9999"
      xtotal:= xtotal + xtotal * (Local9 / 100)
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal * (Local10 / 100) picture ;
         "@E 999,999.9999"
      xtotal:= xtotal + xtotal * (Local10 / 100)
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 1 say "|"
      tab_prec->(dbSkip())
   enddo
   @ PRow() + 1,  0 say linha1
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   tab_prec->(dbCloseArea())
   erase (xarqi)
   erase (xarqd)
   erase (xarqtemp + ".DBF")
   return

********************************
function QT_COPIAS

   local Local1:= 1, Local2:= SetColor("")
   tela_qt:= SaveScreen(23, 0, 24, 79)
   set color to 
   @ 23,  0 clear to 24, 79
   xvid_imp:= ms250(" Mostrar <V>ideo ou <I>mpressora ?", 24, ;
      45, cor[4], cor[5], {86, 73, 27})
   if (xvid_imp == 27)
      return 0
   endif
   @ 24, 45 clear
   if (xvid_imp == 86)
      set printer to ARQUIVO.TXT
   endif
   if (!confirme())
      Local1:= 0
   endif
   aviso(24, "Aguarde... imprimindo relatorio solicitado.")
   set color to (Local2)
   return Local1

********************************
function __TSETRTOP(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[2]:= _einstvar(qself(), "NTOP", Arg1, "N", 1001, 0, Nil)
      qself():configure(2)
   endif
   return qself()[2]

********************************
procedure NUC367A

   local Local1, Local2, Local3, Local4, Local5, Local6
   private xmes_ano:= "     "
   do while (.T.)
      if (!open_tprec())
         if ;
               (ms250("Nao foi possivel abrir arquivo de precos. Deseja tentar novamente (S/N) ? ", ;
               24, 0, cor[4], cor[5], {78, 83}, Nil, 80, "c") == 83)
            loop
         else
            return
         endif
      endif
      exit
   enddo
   Local6:= savescr(3, 0, 24, 79)
   sinal("RELATORIO", "TAB.PRECOS")
   do while (.T.)
      set color to (cor[3])
      window(10, 30, 12, 48, "ͻȺ ", .T.)
      set color to (cor[3])
      xmes_ano:= "     "
      @ 11, 32 say "Mes/Ano :" get xmes_ano picture "99/99" valid ;
         val_ma(xmes_ano) when ;
         mens_when("Digite o Mes e Ano para emissao da Tabela " + ;
         "de Precos, ou [ESC] para sair.")
      read
      if (LastKey() == K_ESC)
         closedata("TAB_PREC")
         restscr(Local6)
         return
      endif
      tab_prec->(dbSeek(ma_to_s(xmes_ano)))
      if (tab_prec->(EOF()))
         ms250("Nao existe tabela de precos para " + xmes_ano + ;
            ". Tecle [ESC] para continuar.", 24, 0, cor[6], ;
            cor[7], {27}, Nil, 80, "c")
         loop
      endif
      tone(1800, 3)
      t_copias:= qt_copias()
      if (t_copias > 0)
         nuc3671()
      endif
      restscr(Local6)
      closedata("TAB_PREC")
      restscr(Local6)
      return
   enddo

********************************
function FNUM_DOC(Arg1)

   if (Empty(Arg1))
      return .F.
   else
      cont_rer->(dbSetOrder(2))
      cont_rer->(dbSeek(descend(Arg1)))
      if (cont_rer->(Found()))
         return .T.
      else
         mensagem("Documento nao foi localizado. P/ continuar tecle [ESC].", ;
            27)
         return .F.
      endif
   endif
   return

********************************
static procedure NUC3671

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9, Local10
   Local3:= {}
   Local8:= tab_prec->per_lucro
   Local9:= tab_prec->per_frete
   Local10:= tab_prec->per_comiss
   select IMPOSTOS
   Local1:= 0
   DBEval({|| Local1:= Local1 + 1})
   goto top
   linha1:= ;
      "+--------------------------------------------------------------------------------------"
   linha2:= ;
      "| MERCADORIAS                    | UN |  FATURAMENTO  |        CUSTO  |       LUCRO   |"
   linha3:= ;
      "|                                |    |               |               | " ;
      + padl(Transform(Local8, "@E 99.99"), 12) + "  |"
   linha4:= ;
      "|--------------------------------+----+---------------+---------------+---------------+"
   do while (!EOF())
      linha1:= linha1 + Replicate("-", 16)
      linha2:= linha2 + (" " + padl(Trim(impostos->co_impos), 12) + ;
         "  |")
      linha3:= linha3 + (" " + padl(Transform(impostos->ali_impos, ;
         "@E 99.99"), 12) + "  |")
      linha4:= linha4 + "---------------+"
      dbSkip()
   enddo
   linha1:= linha1 + ;
      "------------------------------------------------------------------------------+"
   linha2:= linha2 + ;
      "   SUB. TOTAL  |        FRETE  |   SUB. TOTAL  |     COMISSAO  |        TOTAL |"
   linha3:= linha3 + ("               | " + padl(Transform(Local9, ;
      "@E 99.99"), 12) + "  |" + "               |" + " " + ;
      padl(Transform(Local10, "@E 99.99"), 12) + "  |" + ;
      "              |")
   linha4:= linha4 + ;
      "---------------+---------------+---------------+---------------+--------------|"
   pg:= 0
   nome_rel:= ;
      "T   A   B   E   L   A       D   E       P   R   E   C   O   S      /      " ;
      + xmes_ano
   set device to printer
   nuc3672()
   prod_aca->(dbSetOrder(1))
   select TAB_PREC
   xarqtemp:= copy_temp({|| xmes_ano = tab_prec->mes_ref})
   xstruct:= dbstruct()
   AAdd(xstruct, {"de_prod", "C", 30, 0})
   xarqd:= newfile()
   xarqi:= newfile("NTX")
   dbcreate(xarqd, xstruct)
   use (xarqd) alias temp new
   append from (xarqtemp) all
   if (.T.)
      set relation to
   endif
   set relation to co_prod into prod_aca
   DBEval({|| field->de_prod:= prod_aca->de_prod}, Nil, Nil, Nil, ;
      Nil, .F.)
   set relation to
   index on de_prod to (xarqi)
   close
   tab_prec->(dbCloseArea())
   use (xarqd) alias TAB_PREC new index (xarqi)
   do while (!EOF())
      if (tab_prec->val_custo == 0)
         tab_prec->(dbSkip())
         loop
      endif
      if (PRow() > 56)
         nuc3672()
      endif
      prod_aca->(dbSeek(tab_prec->co_prod))
      @ PRow() + 1,  0 say "|"
      @ PRow(),  2 say prod_aca->de_prod
      @ PRow(), 33 say "|"
      @ PRow(), 35 say prod_aca->co_unid
      @ PRow(), 38 say "|"
      @ PRow(), 40 say tab_prec->val_fatu picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say tab_prec->val_custo picture ;
         "@E 999,999.9999"
      xtotal:= tab_prec->val_custo
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say tab_prec->val_custo * (Local8 / 100) ;
         picture "@E 999,999.9999"
      xtotal:= xtotal + tab_prec->val_custo * (Local8 / 100)
      @ PRow(), PCol() + 2 say "|"
      impostos->(dbGoTop())
      do while (!impostos->(EOF()))
         @ PRow(), PCol() + 1 say tab_prec->val_fatu * ;
            (impostos->ali_impos / 100) picture "@E 999,999.9999"
         xtotal:= xtotal + tab_prec->val_fatu * (impostos->ali_impos ;
            / 100)
         @ PRow(), PCol() + 2 say "|"
         impostos->(dbSkip())
      enddo
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal * (Local9 / 100) picture ;
         "@E 999,999.9999"
      xtotal:= xtotal + xtotal * (Local9 / 100)
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal * (Local10 / 100) picture ;
         "@E 999,999.9999"
      xtotal:= xtotal + xtotal * (Local10 / 100)
      @ PRow(), PCol() + 2 say "|"
      @ PRow(), PCol() + 1 say xtotal picture "@E 999,999.9999"
      @ PRow(), PCol() + 1 say "|"
      tab_prec->(dbSkip())
   enddo
   @ PRow() + 1,  0 say linha1
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   tab_prec->(dbCloseArea())
   erase (xarqi)
   erase (xarqd)
   erase (xarqtemp + ".DBF")
   return

********************************
procedure T_CONTATOS

   set color to (cor[1])
   window(4, 1, 18, 69, "ͻȺ ", .T.)
   @  5,  3 say "Codigo Cliente...:"
   @  6,  2 say Replicate("", 67)
   @  7,  3 say "Nome Contato.....: "
   @  9,  3 say "Cargo............: "
   @ 11,  3 say "Setor............: "
   @ 13,  3 say "Telefone (Com)...: "
   @ 15,  3 say "Telefone (Res)...: "
   @ 17,  3 say "Data Nascimento..: "
   set color to 
   return

********************************
function __GETUNDO

   if (Len(qself()) == 13)
      qself():varput(qself()[13])
      qself():reset()
      qself():changed(.F.)
   endif
   return qself()

********************************
procedure NUC368

   local Local1
   private xopcao, xnovoarq, xmes_ano, xco_custo, pg:= 0, xdesc_cust
   private mrel:= ;
      {"Digite o MES/ANO a ser impresso ou tecle <ESC> p/ sair", ;
      "Digite o CODIGO DO CUSTO a ser impresso ou tecle <ESC> p/ sair"}
   xnovoarq:= newfile()
   save screen to Local1
   @ 23,  0 clear to 24, 79
   xopcao:= ms250("Imprimir por [M]es/Ano ou [C]odigo Custo ", ;
      24, 0, cor[4], cor[5], {27, 77, 67}, Nil, 80, "C")
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   select TAB_CGF
   set order to 1
   select TAB_SET
   set order to 1
   select CUSTO_GF
   set order to 
   if (xopcao == 77)
      do while (.T.)
         xmes_ano:= Space(5)
         set color to (cor[1])
         window(4, 1, 6, 20, "ͻȺ ", .T.)
         @  5,  3 say "Mes/Ano :"
         set color to (cor[3])
         @  5, 13 get xMES_ANO picture "99/99" valid ;
            !Empty(xmes_ano) when mens_when(mrel[1])
         read
         set color to 
         if (LastKey() == K_ESC)
            restore screen from Local1
            return
         endif
         if (!confirme())
            set color to (cor[1])
            @  5, 23 clear to  5, 75
            set color to 
            loop
         endif
         sort to (xnovoarq) on CUSTO_GF->CO_CUSTO for ;
            custo_gf->mes_ano = xmes_ano
         nome_rel:= "Relatorio por Mes/Ano"
         imprime()
      enddo
   else
      do while (.T.)
         xco_custo:= Space(3)
         set color to (cor[1])
         window(4, 1, 6, 76, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Custo :"
         set color to (cor[3])
         @  5, 18 get xCO_CUSTO picture "999" valid ;
            !Empty(xco_custo) .AND. localiza(xco_custo, "TAB_CGF", ;
            1, "M", "DESCRICAO", 5, 23) when mens_when(mrel[2])
         read
         set color to 
         if (LastKey() == K_ESC)
            restore screen from Local1
            return
         endif
         if (!confirme())
            set color to (cor[1])
            @  5, 23 clear to  5, 75
            set color to 
            loop
         endif
         xdesc_cust:= tab_cgf->descricao
         sort to (xnovoarq) on CUSTO_GF->MES_ANO for ;
            custo_gf->co_custo = xco_custo
         nome_rel:= "Relatorio por Codigo do Custo"
         imprime()
      enddo
   endif

********************************
procedure NUC37

   local Local1, Local2
   Local2:= {}
   AAdd(Local2, {13, 22, " Pedidos de Compras ", ;
      "Pedidos de Compras em Geral por periodo"})
   AAdd(Local2, {14, 22, " Pedidos de Vendas  ", ;
      "Pedidos de Vendas em Geral por periodo"})
   private xtela1
   private xinicio, xfinal, xcod_cl
   save screen to xtela1
   sinal("SUB-MENU", "PEDIDOS")
   Local1:= 1
   do while (.T.)
      set color to (cor[14])
      window(12, 21, 15, 42, "Ŀ ", .T.)
      Local1:= menu_prt(Local2, Local1, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      if (Local1 = 1)
         if (acesso("NUC371"))
            nuc371()
         endif
      elseif (Local1 = 2)
         if (acesso("NUC372"))
            nuc372()
         endif
      elseif (Local1 = 0)
         restore screen from xtela1
         exit
      endif
   enddo
   return

********************************
static procedure IMPRIME

   use (xnovoarq) alias TCUSTO new
   goto top
   @ 23,  0 clear to 24, 79
   if (LastRec() == 0)
      ms250("Sr. Usuario, nenhum registro foi encontrado. Tecle <ESC> para sair", ;
         24, 0, cor[4], cor[5], {27}, Nil, 80, "C")
      tcusto->(dbCloseArea())
      erase (xnovoarq)
   else
      ms250("Processando relatorio, aguarde por favor.", 24, 0, ;
         cor[4], cor[5], Nil, Nil, 80, "C")
      set device to printer
      if (xopcao = 77)
         cabe("368A")
      else
         cabe("368B")
      endif
      do while (!tcusto->(EOF()))
         if (InKey() == K_ESC)
            if (cancel_rel())
               exit
            endif
         endif
         clear typeahead
         if (PRow() >= 60)
            eject
            if (xopcao = 77)
               cabe("368A")
            else
               cabe("368B")
            endif
         endif
         if (xopcao == 77)
            @ PRow() + 1,  6 say tcusto->co_custo
            tab_cgf->(dbSeek(tcusto->co_custo))
            @ PRow(), 15 say tab_cgf->descricao
            tab_set->(dbSeek(tcusto->co_set))
            @ PRow(), 50 say Trim(tab_set->descricao) + " " + "(" + ;
               tab_set->codigo + ")"
            @ PRow(), 90 say tcusto->val_custo picture "@E 999,999.99"
         else
            @ PRow() + 1,  4 say tcusto->mes_ano
            tab_set->(dbSeek(tcusto->co_set))
            @ PRow(), 15 say Trim(tab_set->descricao) + " " + "(" + ;
               tab_set->codigo + ")"
            @ PRow(), 62 say tcusto->val_custo picture "@E 999,999.99"
         endif
         tcusto->(dbSkip())
      enddo
      set device to screen
      if (i_m_p_r_ee = "LPT1")
         eject
         set printer to 
         if (xvid_imp == 86)
            vertexto()
         endif
      endif
      set color to (cor[12])
      @  4,  1 clear to 21, 78
      set color to 
      tcusto->(dbCloseArea())
      erase (xnovoarq)
      return
   endif

********************************
procedure LIMPA_CO

   set color to (cor[1])
   @  7, 22 clear to 17, 68
   set color to 
   return

********************************
procedure NUC371

   local Local1, Local2
   Local1:= {}
   AAdd(Local1, {15, 5, " Pedidos Abertos por Fornecedor  ", ;
      padc("Relatorio de Pedidos em aberto por fornecedor e periodo", ;
      80)})
   AAdd(Local1, {16, 5, " Pedidos Fechados por Fornecedor ", ;
      padc("Relatorio de Pedidos fechados por fornecedor e periodo", ;
      80)})
   sinal("SUB-MENU", "PEDIDOS")
   private m_ped381:= 1
   do while (.T.)
      set color to (cor[16])
      window(14, 4, 17, 38, "Ŀ ", .T.)
      m_ped381:= menu_prt(Local1, m_ped381, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      if (m_ped381 = 1)
         save screen to Local2
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 9, 34, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Fornecedor:"
         @  6,  2 to  6, 33
         @  7,  3 say "Inicio...........:"
         @  8,  3 say "Final............:"
         set color to 
         xcod_fo:= Space(4)
         set color to (cor[3])
         @  5, 22 get XCOD_FO picture "@K !999" valid xcod_fo = "*" ;
            .OR. localiza(stz(@xcod_fo), "FORNECED", 1, "M") when ;
            mens_when("Digite o Codigo do " + ;
            "Fornecedor (*) p/ todos ou tecle <ESC> p/ sair")
         read
         xinicio:= xfinal:= CToD(Space(8))
         if (LastKey() != K_ESC)
            set color to (cor[3])
            @  7, 22 get XINICIO picture "@!" valid !Empty(xinicio) ;
               when mens_when("Digite " + ;
               "a data de inicio do periodo ou tecle <ESC> " + ;
               "p/ sair.")
            @  8, 22 get XFINAL picture "@!" valid xfinal >= xinicio ;
               .OR. !Empty(xfinal) when mens_when("Digite a data " ;
               + "final do periodo ou tecle <ENTER> p/ voltar")
            read
            set color to 
            if (!Empty(xinicio) .AND. !Empty(xfinal))
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     nuc3711(xcod_fo, xinicio, xfinal, iif(xcod_fo = ;
                        "*", Nil, "*"))
                  next
               endif
            endif
         endif
         restore screen from Local2
      elseif (m_ped381 = 2)
         save screen to Local2
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 9, 33, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Fornecedor:"
         @  6,  2 to  6, 32
         @  7,  3 say "Inicio...........:"
         @  8,  3 say "Final............:"
         set color to 
         xcod_fo:= Space(4)
         set color to (cor[3])
         @  5, 22 get XCOD_FO picture "@k !999" valid xcod_fo = "*" ;
            .OR. localiza(stz(@xcod_fo), "FORNECED", 1, "M") when ;
            mens_when("Digite o Codigo do " + ;
            "Fornecedor (*) p/ todos ou tecle <ESC> p/ sair")
         read
         xinicio:= xfinal:= CToD(Space(8))
         if (LastKey() != K_ESC)
            set color to (cor[3])
            @  7, 22 get XINICIO picture "@!" valid !Empty(xinicio) ;
               when mens_when("Digite " + ;
               "a data de inicio do periodo ou tecle <ESC> " + ;
               "p/ sair.")
            @  8, 22 get XFINAL picture "@!" valid xfinal >= xinicio ;
               .OR. !Empty(xfinal) when mens_when("Digite a data " ;
               + "final do periodo ou tecle <ENTER> p/ voltar")
            read
            set color to 
            if (!Empty(xinicio) .AND. !Empty(xfinal))
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     nuc3712(xcod_fo, xinicio, xfinal, iif(xcod_fo = ;
                        "*", Nil, "*"))
                  next
               endif
            endif
         endif
         restore screen from Local2
      elseif (m_ped381 = 0)
         restore screen from xtela1
         return
      endif
   enddo
   return

********************************
function NUC4621(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= " ", Local4, ;
      Local5:= Len(vacessos), Local6
   if (Local1 = 27 .OR. Local1 = -19)
      lcont_ach:= .F.
      Local2:= 0
   elseif (Local1 = 13)
      vacessos[Arg2]:= iif(SubStr(vacessos[Arg2], 1, 1) = " ", "" + ;
         SubStr(vacessos[Arg2], 2), " " + SubStr(vacessos[Arg2], 2))
   elseif (Local1 = -9)
      nelem:= Arg2
      nposi:= Arg3
      vacessos[Arg2]:= iif(SubStr(vacessos[Arg2], 1, 1) = " ", "" + ;
         SubStr(vacessos[Arg2], 2), " " + SubStr(vacessos[Arg2], 2))
      Local4:= countleft(SubStr(vacessos[Arg2], 2), " ")
      Local3:= SubStr(vacessos[Arg2], 1, 1)
      Arg2++
      do while (Arg2 <= Local5)
         if (countleft(SubStr(vacessos[Arg2], 2), " ") > Local4)
            vacessos[Arg2]:= Local3 + SubStr(vacessos[Arg2], 2)
         else
            exit
         endif
         Arg2++
      enddo
      Local2:= 0
   endif
   return Local2

********************************
procedure NUC3711

   parameters xcod_fo, xdatai, xdataf, xfiltro
   private pg:= 0, xcancelar
   select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
   set order to 2
   if (xfiltro != Nil)
      set filter to COD_FO = XCOD_FO
      nome_rel:= ;
         "Relatorio de Pedidos em abertos por Fornecedor e periodo"
   else
      nome_rel:= "Relatorio de Pedidos em aberto por periodo"
   endif
   goto top
   set device to printer
   cabe("3811")
   do while (!EOF())
      if (!Empty(nr_nf) .OR. dt_ped < xdatai .OR. dt_ped > xdataf)
         skip 
         loop
      endif
      @ PRow() + 1,  2 say nr_ped
      @ PRow(), 10 say nr_ped_o
      @ PRow(), 20 say dt_ped
      xcod_fo:= cod_fo
      forneced->(dbSetOrder(1))
      forneced->(dbSeek(xcod_fo))
      @ PRow(), 31 say forneced->nome_fo
      xnr_ped:= nr_ped
      select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
      set order to 1
      seek xnr_ped
      mp_r->(dbSetOrder(1))
      @ PRow() + 2,  2 say prt->imp_lenfat + ;
         " Item   Descricao da Materia Prima                  Qtd. Pedida   Preco Unit." ;
         + prt->imp_denfat
      xcancelar:= .F.
      do while (nr_ped = xnr_ped .AND. !EOF())
         if (PRow() > 56)
            cabe("3811")
            select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
            @ PRow() + 1,  2 say nr_ped
            @ PRow(), 10 say nr_ped_o
            @ PRow(), 20 say dt_ped
            @ PRow(), 30 say forneced->nome_fo
            @ PRow() + 2,  2 say prt->imp_lenfat + ;
               " Item   Descricao da Materia Prima                  Qtd. Pedida   Preco Unit." ;
               + prt->imp_denfat
         endif
         select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
         xco_mp:= co_mp
         mp_r->(dbSeek(xco_mp))
         @ PRow() + 1,  4 say nr_item_pd + "    " + mp_r->de_mp + ;
            "  " + Transform(qt_pe_mp, "@E 99,999,999.99") + "  " + ;
            Transform(val_mp, "@E 9,999,999.99")
         if (InKey() == K_ESC)
            if (cancel_rel())
               xcancelar:= .T.
               exit
            endif
         endif
         skip 
      enddo
      if (xcancelar)
         exit
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      @ PRow() + 1,  0 say ""
      skip 
   enddo
   select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
   if (xfiltro != Nil)
      set filter to
   endif
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure VEND_ESTOQ(Arg1, Arg2, Arg3)

   select (Arg1)
   set order to 1
   seek DToS(Arg2)
   if (Found())
      DBEval({|| field->qtde:= qtde - Arg3}, Nil, Nil, Nil, Nil, .T.)
   else
      goto top
      set softseek on
      seek DToS(Arg2)
      skip -1
      xxqtde:= qtde - Arg3
      set softseek off
      append blank
      replace dat_entra with Arg2
      replace qtde with xxqtde
      goto top
      seek DToS(Arg2)
      skip 
      if (!EOF())
         DBEval({|| field->qtde:= qtde - Arg3}, Nil, Nil, Nil, Nil, ;
            .T.)
      endif
   endif
   return

********************************
function TEMPO

   parameters inicio, fim
   private tempn, tempc
   if (inicio > fim)
      return "00:00:00"
   else
      tempn:= fim - inicio
      tempc:= strzero(Int(tempn / 3600), 2, 0) + ":"
      tempn:= tempn - Int(tempn / 3600) * 3600
      tempc:= tempc + strzero(Int(tempn / 60), 2, 0) + ":"
      tempn:= tempn - Int(tempn / 60) * 60
      tempc:= tempc + strzero(tempn, 2, 0)
      return tempc
   endif

********************************
procedure STOP

   parameters tempo
   private inicio
   if (PCount() == 0)
   else
      inicio:= Seconds()
      set escape off
      do while (inicio + tempo > Seconds())
      enddo
      set escape on
      return
   endif

********************************
function __XSAVESCR

   Static31:= {Row(), Col(), SaveScreen(0, 0, MaxRow(), MaxCol())}
   return Nil

********************************
procedure NUC3712

   parameters xcod_fo, xdatai, xdataf, xfiltro
   private pg:= 0, xcancelar
   select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
   set order to 2
   if (xfiltro != Nil)
      set filter to COD_FO = XCOD_FO
      nome_rel:= ;
         "Relatorio de Pedidos baixados por Fornecedor e periodo"
   else
      nome_rel:= "Relatorio de Pedidos baixados por periodo"
   endif
   goto top
   set device to printer
   cabe("3812")
   do while (!EOF())
      if (Empty(nr_nf) .OR. dt_ped < xdatai .OR. dt_ped > xdataf)
         skip 
         loop
      endif
      @ PRow() + 1,  2 say nr_ped
      @ PRow(), 10 say nr_ped_o
      @ PRow(), 20 say dt_ped
      xcod_fo:= cod_fo
      forneced->(dbSetOrder(1))
      forneced->(dbSeek(xcod_fo))
      @ PRow(), 31 say SubStr(forneced->nome_fo, 1, 35)
      @ PRow(), 68 say dt_re_ped
      @ PRow(), 79 say dt_em_nf
      @ PRow(), 89 say nr_nf
      xnr_ped:= nr_ped
      select (iif(xcx2, "IT_P_MPR", "IT_P_MPF"))
      set order to 1
      seek xnr_ped
      mp_r->(dbSetOrder(1))
      @ PRow() + 2,  2 say prt->imp_lenfat + ;
         " Item   Descricao da Materia Prima                  Qtd. Pedida   Preco Unit.    Qtd. Receb." ;
         + prt->imp_denfat
      xcancelar:= .F.
      do while (nr_ped = xnr_ped .AND. !EOF())
         if (PRow() > 60)
            cabe("3812")
            select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
            @ PRow() + 1,  2 say nr_ped
            @ PRow(), 10 say nr_ped_o
            @ PRow(), 20 say dt_ped
            @ PRow(), 31 say SubStr(forneced->nome_fo, 1, 35)
            @ PRow(), 68 say dt_re_ped
            @ PRow(), 79 say dt_em_nf
            @ PRow(), 89 say nr_nf
            @ PRow() + 2,  2 say prt->imp_lenfat + ;
               " Item   Descricao da Materia Prima                  Qtd. Pedida   Preco Unit.    Qtd. Receb." ;
               + prt->imp_denfat
         endif
         mp_r->(dbSeek(co_mp))
         @ PRow() + 1,  4 say nr_item_pd + "    " + mp_r->de_mp + ;
            "  " + Transform(qt_pe_mp, "@E 99,999,999.99") + "  " + ;
            Transform(val_mp, "@E 9,999,999.99") + "  " + ;
            Transform(qt_re_mp, "@E 99,999,999.99")
         if (InKey() == K_ESC)
            if (cancel_rel())
               xcancelar:= .T.
               exit
            endif
         endif
         skip 
      enddo
      if (xcancelar)
         exit
      endif
      select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
      @ PRow() + 1,  0 say ""
      skip 
   enddo
   @ PRow(), PCol() + 1 say prt->imp_10cpp
   select (iif(xcx2, "PED_MP_R", "PED_MP_F"))
   if (xfiltro != Nil)
      set filter to
   endif
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure LIN_NAVE3

   local Local1
   Local1:= SetColor()
   set color to 
   @ 23,  0 clear to 24, 79
   setcursor(0)
   set color to (cor[9])
   @ 24,  1 say " PgUp Ant.  "
   @ 24, 14 say " PgDn Prox. "
   @ 24, 27 say " F2 Alterar "
   @ 24, 40 say " F3 Excluir "
   @ 24, 53 say " F4 Itens   "
   @ 24, 66 say "   Esc Sai  "
   set color to 
   set color to (cor[10])
   @ 24,  2 say "PgUp"
   @ 24, 15 say "PgDn"
   @ 24, 28 say "F2"
   @ 24, 41 say "F3"
   @ 24, 54 say "F4"
   @ 24, 69 say "Esc"
   set color to (Local1)
   return

********************************
function READKILL(Arg1)

   local Local1
   Local1:= Static23
   if (PCount() > 0)
      Static23:= Arg1
   endif
   return Local1

********************************
procedure NUC372

   local Local1, Local2, Local3
   Local1:= {}
   AAdd(Local1, {15, 5, " Pedidos Abertos por Clientes  ", ;
      padc("Relatorio de Pedidos em aberto por Clientes e periodo", ;
      80)})
   AAdd(Local1, {16, 5, " Pedidos Fechados por Clientes ", ;
      padc("Relatorio de Pedidos fechados por Clientes e periodo", ;
      80)})
   AAdd(Local1, {17, 5, " Pedidos Individuais           ", ;
      padc("Relatorio de Individuais", 80)})
   sinal("SUB-MENU", "PEDIDOS")
   private m_ped382:= 1
   Local3:= Len(Local1)
   do while (.T.)
      set color to (cor[16])
      window(14, 4, Local3 + 15, 36, "Ŀ ", .T.)
      m_ped382:= menu_prt(Local1, m_ped382, cor[16], ;
         SubStr(SubStr(cor[16], At(",", cor[16]) + 1), 1, At(",", ;
         SubStr(cor[16], At(",", cor[16]) + 1)) - 1), cor[17], ;
         SubStr(SubStr(cor[17], At(",", cor[17]) + 1), 1, At(",", ;
         SubStr(cor[17], At(",", cor[17]) + 1)) - 1), 80)
      set color to 
      do case
      case m_ped382 = 1
         save screen to Local2
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 9, 30, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         @  6,  2 to  6, 29
         @  7,  3 say "Inicio........:"
         @  8,  3 say "Final.........:"
         set color to 
         xcod_cl:= Space(5)
         set color to (cor[3])
         @  5, 19 get XCod_CL picture "@k !9999" valid xcod_cl = "*" ;
            .OR. localiza(stz(@xcod_cl), "CLIENTES", 1, "M") when ;
            mens_when("Digite o Codigo do " + ;
            "Cliente (*) p/ todos ou tecle <ESC> p/ sair")
         read
         xinicio:= xfinal:= CToD(Space(8))
         if (LastKey() != K_ESC)
            set color to (cor[3])
            @  7, 19 get XINICIO picture "@!" valid !Empty(xinicio) ;
               when mens_when("Digite " + ;
               "a data de inicio do periodo ou tecle <ESC> " + ;
               "p/ sair.")
            @  8, 19 get XFINAL picture "@!" valid xfinal >= xinicio ;
               .OR. !Empty(xfinal) when mens_when("Digite a data " ;
               + "final do periodo ou tecle <ENTER> p/ voltar")
            read
            set color to 
            if (!Empty(xinicio) .AND. !Empty(xfinal))
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     nuc3721(xcod_cl, xinicio, xfinal, iif(xcod_cl = ;
                        "*", Nil, "*"))
                  next
               endif
            endif
         endif
         restore screen from Local2
      case m_ped382 = 2
         save screen to Local2
         set color to (cor[12])
         @  4,  1 clear to 21, 78
         set color to 
         @ 23,  0 clear to 24, 79
         set color to (cor[1])
         window(4, 1, 9, 30, "ͻȺ ", .T.)
         @  5,  3 say "Codigo Cliente:"
         @  6,  2 to  6, 29
         @  7,  3 say "Inicio........:"
         @  8,  3 say "Final.........:"
         set color to 
         xcod_cl:= Space(5)
         set color to (cor[3])
         @  5, 19 get XCod_CL picture "@k !9999" valid xcod_cl = "*" ;
            .OR. localiza(stz(@xcod_cl), "CLIENTES", 1, "M") when ;
            mens_when("Digite o Codigo do " + ;
            "Cliente (*) p/ todos ou tecle <ESC> p/ sair")
         read
         xinicio:= xfinal:= CToD(Space(8))
         if (LastKey() != K_ESC)
            set color to (cor[3])
            @  7, 19 get XINICIO picture "@!" valid !Empty(xinicio) ;
               when mens_when("Digite " + ;
               "a data de inicio do periodo ou tecle <ESC> " + ;
               "p/ sair.")
            @  8, 19 get XFINAL picture "@!" valid xfinal >= xinicio ;
               .OR. !Empty(xfinal) when mens_when("Digite a data " ;
               + "final do periodo ou tecle <ESC> p/ sair")
            read
            set color to 
            if (!Empty(xinicio) .AND. !Empty(xfinal))
               t_copias:= qt_copias()
               if (t_copias > 0)
                  for i:= 1 to t_copias
                     nuc3722(xcod_cl, xinicio, xfinal, iif(xcod_cl = ;
                        "*", Nil, "*"))
                  next
               endif
            endif
         endif
         restore screen from Local2
      case m_ped382 = 3
         nuc3723()
      case m_ped382 = 4
      case m_ped382 = 0
         restore screen from xtela1
         return
      endcase
   enddo
   return

********************************
procedure DESENVOLV

   local Local1:= savescr(10, 25, 13, 55), Local2:= ;
      SetColor(cor[6]), Local3:= setcursor(0)
   tone(800, 5)
   Scroll(10, 25, 12, 54)
   window(10, 25, 12, 54, "Ŀ ", .T.)
   set color to (cor[7])
   @ 11, 27 say "Rotina em Desenvolvimento."
   InKey(2)
   restscr(Local1)
   set color to (Local2)
   setcursor(Local3)
   return

********************************
procedure TRANS_CO

   xcod_cl:= cod_cl
   xcontato:= contato
   xsetor:= setor
   xcargo:= cargo
   xtel_res:= tel_res
   xtel_com:= tel_com
   xdata_nasc:= data_nasc
   return

********************************
procedure NUC3721

   parameters xcod_cl, xdatai, xdataf, xfiltro
   private pg:= 0, xcancelar
   prod_aca->(dbSetOrder(1))
   clientes->(dbSetOrder(1))
   select ITEM_VER
   set order to 1
   select VENDAS_R
   set order to 1
   if (xfiltro != Nil)
      set filter to Cod_CL = XCod_CL
      nome_rel:= "Relatorio de Pedidos Abertos por Clientes/Periodo"
   else
      nome_rel:= "Relatorio de Pedidos Abertos por Periodo"
   endif
   goto top
   set device to printer
   cabe("3821")
   xtotal:= 0
   do while (!EOF())
      xstotal:= 0
      if (prog_prod .OR. dt_ped < xdatai .OR. dt_ped > xdataf)
         skip 
         loop
      endif
      xnr_ped:= nr_ped
      xcod_cl:= cod_cl
      clientes->(dbSeek(xcod_cl))
      if (PRow() > 54)
         cabe("3821")
      endif
      nuc37211()
      seek xnr_ped
      xcancelar:= .F.
      do while (nr_ped = xnr_ped .AND. !EOF())
         if (PRow() > 56)
            cabe("3821")
            nuc37211()
         endif
         xco_prod:= co_prod
         prod_aca->(dbSeek(xco_prod))
         @ PRow() + 1,  3 say nr_item_pd + "  " + prod_aca->de_prod ;
            + " " + Transform(qt_pe_prod, "@E 9999,999.99") + " " + ;
            Transform(val_prod, "@E 99,999,999.99") + " " + ;
            Transform(val_prod * qt_pe_prod, "@E 999,999,999.99")
         xstotal:= xstotal + val_prod * qt_pe_prod
         if (InKey() == K_ESC)
            if (cancel_rel())
               xcancelar:= .T.
               exit
            endif
         endif
         skip 
      enddo
      @ PRow() + 1, 39 say "Total do Pedido ......>> " + ;
         Transform(xstotal, "@E 999,999,999.99")
      xtotal:= xtotal + xstotal
      if (xcancelar)
         exit
      endif
      select VENDAS_R
      @ PRow() + 1,  0 say ""
      skip 
   enddo
   @ PRow() + 1, 39 say "Total Geral ..........>> " + ;
      Transform(xtotal, "@E 999,999,999.99")
   select VENDAS_R
   if (xfiltro != Nil)
      set filter to
   endif
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
function MEMO_HELP(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 0, Local3:= SetColor()
   cursor_atu:= setcursor()
   setcursor(0)
   if (Arg1 != 0)
      if (Local1 = -9 .OR. Local1 = 23)
         Local2:= 23
      elseif (Local1 == 27)
         Local2:= 27
      endif
   else
      do case
      case Local1 = 5
         if (cal_pos_cu > lin_top + 1)
            cal_pos_cu--
         endif
      case Local1 = 29
         cal_pos_cu:= lin_top + 1
      case Local1 = 24 .OR. Local1 = 13
         if (cal_pos_cu < lin_bot - 1)
            cal_pos_cu++
         endif
      case Local1 = 23
         cal_pos_cu:= lin_bot - 1
      case Local1 = 18
         if (Arg2 == 1)
            cal_pos_cu:= lin_top + 1
         endif
      case Local1 = 3 .OR. Local1 = 18 .OR. Local1 = 28 .OR. Local1 ;
            = 4 .OR. Local1 = 19 .OR. Local1 = 31 .OR. Local1 = 6 ;
            .OR. Local1 = 30 .OR. Local1 = 1
      otherwise
         set color to (Local3)
         keyboard Chr(27)
      endcase
      setcursor(0)
      if (lin_top + Arg2 > cal_pos_cu)
         if (loop_help = 2 .OR. prog1 = "DB_HELP")
            set color to (SubStr(SubStr(cor[18], At(",", cor[18]) + ;
               1), 1, At(",", SubStr(cor[18], At(",", cor[18]) + 1)) ;
               - 1))
         else
            set color to (SubStr(SubStr(cor[19], At(",", cor[19]) + ;
               1), 1, At(",", SubStr(cor[19], At(",", cor[19]) + 1)) ;
               - 1))
         endif
         @ lin_top + 1, col_rig say " "
      else
         @ lin_top + 1, col_rig say ""
      endif
      if (nr_linhas - Arg2 >= lin_bot - cal_pos_cu)
         if (loop_help = 2 .OR. prog1 = "DB_HELP")
            set color to (SubStr(SubStr(cor[18], At(",", cor[18]) + ;
               1), 1, At(",", SubStr(cor[18], At(",", cor[18]) + 1)) ;
               - 1))
         else
            set color to (SubStr(SubStr(cor[19], At(",", cor[19]) + ;
               1), 1, At(",", SubStr(cor[19], At(",", cor[19]) + 1)) ;
               - 1))
         endif
         @ lin_bot - 1, col_rig say " "
      else
         set color to (Local3)
         @ lin_bot - 1, col_rig say ""
      endif
      setcursor(1)
   endif
   setcursor(cursor_atu)
   set color to (Local3)
   return Local2

********************************
procedure NUC3722

   parameters xcod_cl, xdatai, xdataf, xfiltro
   private pg:= 0, xcancelar
   prod_aca->(dbSetOrder(1))
   clientes->(dbSetOrder(1))
   select ITEM_VER
   set order to 1
   select VENDAS_R
   set order to 1
   if (xfiltro != Nil)
      set filter to Cod_CL = XCod_CL
      nome_rel:= ;
         "Relatorio de Pedidos Fechados por Clientes e periodo"
   else
      nome_rel:= "Relatorio de Pedidos Fechados por periodo"
   endif
   goto top
   set device to printer
   cabe("3821")
   xtotal:= 0
   do while (!EOF())
      xstotal:= 0
      if (!prog_prod .OR. dt_ped < xdatai .OR. dt_ped > xdataf)
         skip 
         loop
      endif
      xnr_ped:= nr_ped
      xcod_cl:= cod_cl
      clientes->(dbSeek(xcod_cl))
      if (PRow() > 54)
         cabe("3821")
      endif
      nuc37211()
      seek xnr_ped
      xcancelar:= .F.
      do while (nr_ped = xnr_ped .AND. !EOF())
         if (PRow() > 56)
            cabe("3821")
            nuc37211()
         endif
         xco_prod:= co_prod
         prod_aca->(dbSeek(xco_prod))
         @ PRow() + 1,  3 say nr_item_pd + "  " + prod_aca->de_prod ;
            + " " + Transform(qt_pe_prod, "@E 9999,999.99") + " " + ;
            Transform(val_prod, "@E 99,999,999.99") + " " + ;
            Transform(val_prod * qt_pe_prod, "@E 999,999,999.99")
         xstotal:= xstotal + val_prod * qt_pe_prod
         if (InKey() == K_ESC)
            if (cancel_rel())
               xcancelar:= .T.
               exit
            endif
         endif
         skip 
      enddo
      @ PRow() + 1, 39 say "Total do Pedido ......>> " + ;
         Transform(xstotal, "@E 999,999,999.99")
      xtotal:= xtotal + xstotal
      if (xcancelar)
         exit
      endif
      select VENDAS_R
      @ PRow() + 1,  0 say ""
      skip 
   enddo
   @ PRow() + 1, 39 say "Total Geral ..........>> " + ;
      Transform(xtotal, "@E 999,999,999.99")
   select VENDAS_R
   if (xfiltro != Nil)
      set filter to
   endif
   set device to screen
   if (i_m_p_r_ee = "LPT1")
      eject
      set printer to 
      if (xvid_imp == 86)
         vertexto()
      endif
   endif
   return

********************************
procedure NUC43

   if (!acesso("NUC43"))
   else
      ctrl_cor()
      set color to (cor[11])
      @  0,  0 clear to  0, 79
      @  0,  0 say padc(_xempresa, 18) + "" + ;
         " Sistema Financeiro " + "" + " " + DToC(Date()) + " " + ;
         "" + Space(11) + "" + Space(11) + ""
      set color to 
      set color to (cor[12])
      window(3, 0, 22, 79, "Ŀ ")
      sinal("M E N U", "PRINCIPAL")
      insovr(.T.)
      set color to 
      @ 23,  0 say Space(80)
      aviso(24, ;
         "Use as setas para escolher sua opcao e <ENTER> ou <ESC> para sair")
      set color to (cor[14])
      keyboard Chr(27)
      @  2,  0 clear to  2, 79
      n_i_v:= 4
      @  2,  2 prompt " Cadastro    "
      @  2, 19 prompt " Manutencao  "
      @  2, 36 prompt " Relatorios  "
      @  2, 53 prompt " Utilitarios   "
      menu to n_i_v
      set color to (SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, ;
         At(",", SubStr(cor[14], At(",", cor[14]) + 1)) - 1))
      @  2,  3 say "C"
      @  2, 20 say "M"
      @  2, 37 say "R"
      @  2, 54 say "U"
      set color to (cor[15])
      @  2, 53 say " Utilitarios   "
      set color to (SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, ;
         At(",", SubStr(cor[15], At(",", cor[15]) + 1)) - 1))
      @  2, 54 say "U"
      save screen to cesar
      return
   endif

********************************
procedure NUC3723

   local Local1
   Local1:= savescr(4, 0, 24, 79)
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   set color to (cor[1])
   window(4, 1, 6, 29, "ͻȺ ", .T.)
   @  5,  3 say "Numero do Pedido : "
   pg:= 0
   nome_rel:= "Relatorio de Pedido Individual"
   prod_aca->(dbSetOrder(1))
   clientes->(dbSetOrder(1))
   item_ver->(dbSetOrder(1))
   select VENDAS_R
   do while (.T.)
      xnr_ped:= Space(6)
      set color to (cor[3])
      @  5, 22 get XNR_PED picture "@K 999999" valid ;
         localiza(stz(@xnr_ped), "vendas_r", 1, "M") when ;
         mens_when("Digite o Numero do Pedido" + ;
         " ou tecle <ESC> p/ sair")
      read
      if (LastKey() == K_ESC)
         restscr(Local1)
         return
      endif
      t_copias:= qt_copias()
      if (t_copias == 0)
         restscr(Local1)
         return
      endif
      set device to printer
      if (pg = 0 .OR. PRow() > 54)
         cabe("9999")
      endif
      clientes->(dbSeek(vendas_r->cod_cl))
      @ PRow() + 1,  2 say cod_cl
      @ PRow(),  8 say clientes->nome_cl
      @ PRow(), 52 say iif(clientes->jur_fis = "J", ;
         clientes->cgc_cl, clientes->cpf_cl) picture ;
         iif(clientes->jur_fis = "J", "@R 99.999.999/9999-99", ;
         "@R 999.999.999-99")
      @ PRow() + 1,  8 say Trim(clientes->end_cl) + ",  " + ;
         clientes->bairro_cl
      @ PRow() + 1,  8 say Trim(clientes->cid_cl) + ;
         iif(Empty(clientes->cid_cl), "", ", ") + clientes->est_cl + ;
         ", " + Transform(clientes->cep_cl, "@R 99.999-999")
      @ PRow(), 52 say clientes->insc_estc
      @ PRow(), 73 say vendas_r->nr_ped
      @ PRow() + 1,  0 say ""
      item_ver->(dbSeek(vendas_r->nr_ped))
      xtotal_ped:= 0
      do while (item_ver->nr_ped = vendas_r->nr_ped)
         if (pg = 0 .OR. PRow() > 58)
            cabe("9999")
         endif
         prod_aca->(dbSeek(item_ver->co_prod))
         @ PRow() + 1,  2 say item_ver->co_prod
         @ PRow(),  7 say prod_aca->de_prod
         @ PRow(), 39 say prod_aca->co_unid
         @ PRow(), 42 say item_ver->qt_pe_prod picture ;
            "@E 99999,999.99"
         @ PRow(), 56 say item_ver->val_prod picture "@E 99,999.99"
         @ PRow(), 66 say item_ver->qt_pe_prod * item_ver->val_prod ;
            picture "@E 999999,999.99"
         xtotal_ped:= xtotal_ped + item_ver->qt_pe_prod * ;
            item_ver->val_prod
         item_ver->(dbSkip(1))
      enddo
      @ PRow() + 1,  7 say "Total do Pedido....>>>"
      @ PRow(), 65 say xtotal_ped picture "@E 999,999,999.99"
      @ PRow() + 1,  2 say Replicate("-", 77)
      @ PRow() + 1,  0 say " "
      set device to screen
      if (i_m_p_r_ee = "LPT1")
         eject
         set printer to 
         if (xvid_imp == 86)
            vertexto()
         endif
      endif
   enddo

********************************
procedure MOVE_HELP

   local Local1:= LastKey(), Local2:= .F.
   do case
   case Local1 = 408
      if (lin_top > 0)
         move_lint:= -1
         move_linb:= -1
         Local2:= .T.
      endif
   case Local1 = 416
      if (lin_bot < 24)
         move_lint:= 1
         move_linb:= 1
         Local2:= .T.
      endif
   case Local1 = 411
      if (col_lef > 1)
         move_coll:= -2
         move_colr:= -2
         Local2:= .T.
      endif
   case Local1 = 413
      if (col_rig < 78)
         move_coll:= 2
         move_colr:= 2
         Local2:= .T.
      endif
   case Local1 = 417
      if (lin_bot < 24)
         move_linb:= 1
         Local2:= .T.
      endif
   case Local1 = 409
      if (lin_bot - lin_top > 4)
         move_linb:= -1
         Local2:= .T.
      endif
   case Local1 = 407
      if (col_rig - col_lef > 10)
         move_colr:= -1
         Local2:= .T.
      endif
   case Local1 = 415
      if (col_rig < 78)
         move_colr:= 1
         Local2:= .T.
      endif
   endcase
   if (Local2)
      mover_tela:= .T.
      if (ult_proc != "HELP1")
         keyboard Chr(23)
      else
         keyboard Chr(27)
      endif
   else
      tone(800, 5)
   endif
   return

********************************
procedure NUC41

   local Local1
   if (acesso("ERRO"))
   endif
   sinal("BACK-UP", "ARQUIVOS")
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   set color to (cor[12])
   @  4, 79 to 15, 79
   set color to 
   set color to (cor[1])
   window(7, 12, 18, 68, "Ŀ ", .T.)
   @  8, 14 say ;
      "                    A T E N C A O                    "
   @ 10, 14 say ;
      "Ser  iniciado o processo de cpia para os disquetes. "
   @ 11, 14 say ;
      "Para executar o Backup insira o disquete no drive <A>"
   @ 12, 14 say ;
      "     e confirme ( <S>im ou <N>ao ) para execucao.    "
   @ 14, 14 say ;
      "    No interrompa de forma alguma este Processo !   "
   @ 17, 14 say ;
      "             Deseja iniciar o Processo  ?            "
   set color to 
   @ 23,  0
   if (confirme())
      aviso(24, ;
         "..... Aguarde ! Executando Backup dos Arquivos para o drive <A>")
      run pkarc a a:arquivos.nuc *.db* > tempo.txt
      mensagem("Fim do Processo ! Tecle <ESC>", 27)
      if (file("TEMPO.TXT"))
         erase TEMPO.TXT
      endif
   endif
   restore screen from Local1
   return

********************************
procedure INI_CO

   xcontato:= Space(35)
   xdata_nasc:= CToD("")
   xcargo:= xsetor:= Space(20)
   xtel_com:= xtel_res:= Space(14)
   xnivel:= "S"
   return

********************************
procedure NUC42

   local Local1
   if (acesso("ERRO"))
   endif
   sinal("RESTAURA", "ARQUIVOS")
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   set color to (cor[12])
   @  4, 79 to 15, 79
   set color to 
   set color to (cor[1])
   window(7, 12, 18, 69, "Ŀ ", .T.)
   @  8, 14 say ;
      "                     A T E N C A O                    "
   @ 10, 14 say ;
      "Ser  iniciado o processo de cpia para o Winchester.  "
   @ 11, 14 say ;
      "Para executar o Restore insira o disquete no drive <A>"
   @ 12, 14 say ;
      "     e confirme ( <S>im ou <N>ao ) para execucao.     "
   @ 14, 14 say ;
      "    No interrompa de forma alguma este Processo !    "
   @ 17, 14 say ;
      "              Deseja iniciar o Processo  ?            "
   set color to 
   @ 23,  0
   if (confirme())
      aviso(24, ;
         "..... Aguarde ! Restaurando Arquivos do disquete para o Winchester.")
      run pkxarc -r a:arquivos.nuc > tempo.txt
      mensagem("Fim do Processo ! Tecle <ESC>", 27)
      @ 24,  0 clear
      indexar(.F., "TODOS")
      if (file("TEMPO.TXT"))
         erase TEMPO.TXT
      endif
   endif
   restore screen from Local1
   return

********************************
procedure NUC44

   local Local1
   if (!acesso("NUC44"))
   else
      if (file("PADRAO.CF_"))
         copy file PADRAO.CF_ to CORES.CF_
         readcor(@cor)
      else
         set color to 
         SaveScreen(23, 0, 24, 79)
         @ 23,  0 clear to 24, 79
         mensagem("Arquivo de Cores Original nao localizado, Tecle <ESC> p/ continuar.", ;
            27)
         RestScreen(23, 0, 24, 79, Local1)
         return
      endif
      set color to (cor[11])
      @  0,  0 clear to  0, 79
      @  0,  0 say padc(_xempresa, 18) + "" + ;
         " Sistema Financeiro " + "" + " " + DToC(Date()) + " " + ;
         "" + Space(11) + "" + Space(11) + ""
      set color to 
      set color to (cor[12])
      window(3, 0, 22, 79, "Ŀ ")
      sinal("M E N U", "PRINCIPAL")
      insovr(.T.)
      set color to 
      @ 23,  0 say Space(80)
      aviso(24, ;
         "Use as setas para escolher sua opcao e <ENTER> ou <ESC> para sair")
      set color to (cor[14])
      keyboard Chr(27)
      @  2,  0 clear to  2, 79
      n_i_v:= 4
      @  2,  2 prompt " Cadastro    "
      @  2, 19 prompt " Manutencao  "
      @  2, 36 prompt " Relatorios  "
      @  2, 53 prompt " Utilitarios   "
      menu to n_i_v
      set color to (SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, ;
         At(",", SubStr(cor[14], At(",", cor[14]) + 1)) - 1))
      @  2,  3 say "C"
      @  2, 20 say "M"
      @  2, 37 say "R"
      @  2, 54 say "U"
      set color to (cor[15])
      @  2, 53 say " Utilitarios   "
      set color to (SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, ;
         At(",", SubStr(cor[15], At(",", cor[15]) + 1)) - 1))
      @  2, 54 say "U"
      save screen to cesar
      return
   endif

********************************
function CANCEL_REL

   private cancela, tela, cor_corren
   save screen to tela
   cor_corren:= SetColor()
   set escape off
   cancela:= 1
   clear typeahead
   set device to screen
   set color to (cor[6])
   @  9,  7 clear to 16, 72
   ? ""
   @ 10,  9 say ;
      ""
   @ 11,  9 say ;
      "                                                          "
   @ 12,  9 say ;
      " Confirma o Cancelamento da Emissao do Relatorio Corrente "
   @ 13,  9 say ;
      "                      Nao / Sim                           "
   @ 14,  9 say ;
      "                                                          "
   @ 15,  9 say ;
      ""
   @ 13, 33 prompt "Nao"
   @ 13, 39 prompt "Sim"
   menu to cancela
   set color to (cor_corren)
   set escape on
   restore screen from tela
   if (cancela == 2)
      return .T.
   else
      set device to printer
      return .F.
   endif

********************************
function __GETSETPB(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[4]:= Arg1
   endif
   return qself()[4]

********************************
procedure NUC461

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> p/ sair"}
   private cusuario, csenha, cconf, nelem, nposi, lcont_ach
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "USUARIOS")
   select PSW
   set order to 2
   do while (.T.)
      nelem:= nposi:= 1
      vacessos:= {}
      cusuario:= Space(20)
      csenha:= Space(20)
      cconf:= Space(20)
      set color to (cor[1])
      window(4, 1, 9, 39, "ͻȺ ", .T.)
      @  5,  3 say "Nome usuario.: "
      @  7,  3 say "Senha Usuario: "
      @  8,  3 say "  Confirmacao: "
      set color to (cor[3])
      @  5, 18 get cUSUARIO picture "@!" valid !Empty(cusuario) when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      seek cusuario
      if (Found())
         ms250("Usuario ja cadastrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      do while (.T.)
         csenha:= Space(20)
         cconf:= Space(20)
         ms250("Digite a Senha do Usuario ou tecle <ESC> para sair.", ;
            24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
         set color to (cor[3])
         csenha:= Upper(getsecret(csenha, 7, 18))
         if (LastKey() != K_ESC)
            ms250("Digite novamente a Senha para confirmacao.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            cconf:= Upper(getsecret(cconf, 8, 18))
            set color to 
            if (csenha != cconf)
               ms250("Senha nao confere, favor digitar novamente. Tecle <ESC> para sair.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               set color to (cor[1])
               @  7, 17 clear to  8, 38
               set color to 
               loop
            endif
         endif
         exit
      enddo
      if (LastKey() == K_ESC)
         loop
      endif
      ms250("Aguarde um momento... Gerando arquivo...", 24, 0, ;
         cor[4], cor[5], Nil, Nil, 80, "C")
      psw->(dbGoTop())
      DBEval({|| AAdd(vacessos, "  " + descricao + " " + programa)}, ;
         {|| crypt(usuario, ckey) = "MASTER"})
      @ 23,  0
      ms250("[ENTER] Setar Item    [F10] Setar Grupo    [Shift+F10] Grava    [ESC] Cancela", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      set color to (cor[19])
      window(11, 1, 20, 54, "Ŀ ", .T.)
      lcont_ach:= .T.
      do while (lcont_ach)
         achoice(12, 2, 19, 53, vacessos, Nil, "NUC4621", nelem, ;
            nposi)
      enddo
      set color to 
      if (LastKey() = K_SH_F10 .AND. confirme())
         ni:= 0
         ms250("Aguarde um momento... Gravando arquivo...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         for ni:= 1 to Len(vacessos)
            psw->(dbAppend())
            replace psw->autorizado with iif(SubStr(vacessos[ni], 1, ;
               1) = "", .T., .F.)
            replace psw->descricao with SubStr(vacessos[ni], 3, 50)
            replace psw->sequencia with crypt(strzero(RecNo(), 5), ;
               ckey)
            replace psw->programa with SubStr(vacessos[ni], 54, 15)
            replace psw->usuario with crypt(cusuario, ckey)
            replace psw->senha with crypt(csenha, ckey)
         next
      endif
      set color to (cor[12])
      @ 11,  1 clear to 21, 78
      set color to 
   enddo
   return

********************************
procedure NUC462

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> p/ sair"}
   private cusuario, nelem, nposi, lcont_ach
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "SENHAS")
   select PSW
   do while (.T.)
      nelem:= nposi:= 1
      vacessos:= {}
      cusuario:= Space(20)
      set color to (cor[1])
      window(4, 1, 6, 38, "ͻȺ ", .T.)
      @  5,  3 say "Nome usuario: "
      set color to (cor[3])
      @  5, 17 get cUSUARIO picture "@!" valid !Empty(cusuario) when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      if (Trim(cusuario) = "MASTER")
         loop
      endif
      psw->(dbSetOrder(2))
      seek Trim(cusuario)
      if (!Found())
         ms250("Usuario nao encontrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      cusuario:= psw->usuario
      ms250("Aguarde um momento... Gerando arquivo...", 24, 0, ;
         cor[4], cor[5], Nil, Nil, 80, "C")
      DBEval({|| AAdd(vacessos, iif(autorizado, " " + descricao + ;
         " " + programa, "  " + descricao + " " + programa))}, {|| ;
         Trim(usuario) = Trim(cusuario)})
      @ 23,  0
      ms250("[ENTER] Setar Item    [F10] Setar Grupo    [Shift+F10] Grava    [ESC] Cancela", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      set color to (cor[19])
      window(8, 1, 20, 54, "Ŀ ", .T.)
      lcont_ach:= .T.
      do while (lcont_ach)
         achoice(9, 2, 19, 53, vacessos, Nil, "NUC4621", nelem, nposi)
      enddo
      set color to 
      if (LastKey() = K_SH_F10 .AND. confirme())
         psw->(dbSetOrder(1))
         ms250("Aguarde um momento... Atualizando arquivo...", 24, ;
            0, cor[4], cor[5], Nil, Nil, 80, "C")
         ni:= 0
         for ni:= 1 to Len(vacessos)
            psw->(dbSeek(crypt(cusuario, ckey) + ;
               SubStr(vacessos[ni], 54, 15)))
            if (psw->(Found()))
               replace psw->autorizado with iif(SubStr(vacessos[ni], ;
                  1, 1) = "", .T., .F.)
            endif
         next
         if (Trim(cusu) = Trim(cusuario))
            vdireitos:= {}
            DBEval({|| AAdd(vdireitos, psw->programa)}, {|| ;
               psw->autorizado .AND. Trim(psw->usuario) = cusu})
         endif
      endif
      set color to (cor[12])
      @  8,  1 clear to 21, 78
      set color to 
   enddo
   return

********************************
procedure ESTOQUE(Arg1, Arg2, Arg3)

   select (Arg1)
   set order to 1
   seek DToS(Arg2)
   if (Found())
      DBEval({|| field->qtde:= qtde + Arg3}, Nil, Nil, Nil, Nil, .T.)
   else
      goto top
      set softseek on
      seek DToS(Arg2)
      skip -1
      xxqtde:= iif(BOF(), Arg3, qtde + Arg3)
      set softseek off
      append blank
      replace dat_entra with Arg2
      replace qtde with xxqtde
      goto top
      seek DToS(Arg2)
      skip 
      if (!EOF())
         DBEval({|| field->qtde:= qtde + Arg3}, Nil, Nil, Nil, Nil, ;
            .T.)
      endif
   endif
   return

********************************
procedure CFG_PRINT

   filemem:= config[8] + "PRINT.MEM"
   if (file(filemem))
      restore from (filemem) additive
      arq_print:= config[5] + "print.sys"
      use (arq_print) alias PRT new shared
      _resultado:= imp_prtt(_resultado)
      goto _resultado
      save all like _RESULTADO to (filemem)
   else
      _resultado:= imp_prtt(print(7, 50))
      save all like _RESULTADO to (filemem)
   endif
   return

********************************
function __ATPROMPT(Arg1, Arg2, Arg3, Arg4)

   AAdd(Static20, {Arg1, Arg2, Arg3, Arg4})
   SetPos(Arg1, Arg2)
   dispout(Arg3)
   return .F.

********************************
procedure NUC463

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> p/ sair"}
   private cusuario
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("EXCLUSAO", "USUARIO")
   select PSW
   set order to 2
   do while (.T.)
      vacessos:= {}
      cusuario:= Space(20)
      set color to (cor[1])
      window(4, 1, 6, 38, "ͻȺ ", .T.)
      @  5,  3 say "Nome usuario: "
      set color to (cor[3])
      @  5, 17 get cUSUARIO picture "@!" valid !Empty(cusuario) when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      if (Trim(cusuario) = "MASTER")
         loop
      endif
      seek cusuario
      if (!Found())
         ms250("Usuario nao encontrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      cusuario:= crypt(psw->usuario, ckey)
      if (cusu = cusuario)
         ms250("Usuario corrente nao pode ser excluido. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      if (confirme())
         ms250("Aguarde um momento... Eliminando Usuario...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         DBEval({|| dbDelete()}, {|| crypt(usuario, ckey) = cusuario})
         psw->(__dbPack())
      endif
   enddo
   return

********************************
procedure GRAVA_CO

   replace cod_cl with xcod_cl
   replace contato with xcontato
   replace data_nasc with xdata_nasc
   replace cargo with xcargo
   replace setor with xsetor
   replace tel_com with xtel_com
   replace tel_res with xtel_res
   replace nivel with "S"
   return

********************************
procedure NUC464

   local Local1, Local2, Local3, Local4, Local5
   Local1:= {}
   set deleted on
   if (cusu != "MASTER")
   else
      Local5:= SaveScreen(23, 0, 24, 79)
      set color to 
      @ 23,  0 clear
      select PSW
      if (!confirme())
         RestScreen(23, 0, 24, 79, Local5)
      else
         ms250("Aguarde um momento... Importando arquivo...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         DBEval({|| dbDelete()}, {|| crypt(usuario, ckey) = ;
            "MASTER"}, Nil, Nil, Nil, .F.)
         psw->(dbSetOrder(3))
         psw->(dbGoTop())
         if (psw->(LastRec()) > 0)
            DBEval({|| AAdd(Local1, crypt(psw->usuario, ckey))})
         endif
         set order to 2
         Local3:= newfile()
         copy to (Local3) all
         use (Local3) alias PSW_TMP new
         Local4:= newfile("NTX")
         index on crypt(usuario,cKEY)+programa to (Local4)
         select PSW
         zap
         append from PASSWORD.TXT sdf all
         psw->(dbGoTop())
         psw->(dbSetOrder(0))
         DBEval({|| (field->usuario:= crypt("MASTER              ", ;
            ckey), field->senha:= crypt("PCOIIW              ", ;
            ckey), field->autorizado:= .T., field->sequencia:= ;
            crypt(strzero(RecNo(), 5), ckey))}, Nil, Nil, Nil, Nil, ;
            .F.)
         for Local2:= 1 to Len(Local1)
            cusuario:= Local1[Local2]
            psw_tmp->(dbSeek(cusuario))
            append from PASSWORD.TXT sdf all
            psw->(dbSetOrder(2))
            psw->(dbSeek(cusuario))
            psw->(dbSetOrder(0))
            DBEval({|| (field->usuario:= crypt(cusuario, ckey), ;
               field->senha:= psw_tmp->senha, field->autorizado:= ;
               .T., field->sequencia:= crypt(strzero(RecNo(), 5), ;
               ckey))}, {|| Empty(psw->usuario)}, Nil, Nil, Nil, .F.)
            psw->(dbSetOrder(2))
            psw->(dbSeek(cusuario))
            do while (psw->usuario = crypt(cusuario, ckey))
               psw_tmp->(dbSeek(crypt(psw->usuario, ckey) + ;
                  psw->programa))
               replace psw->autorizado with psw_tmp->autorizado
               psw->(dbSkip())
            enddo
         next
         psw_tmp->(dbCloseArea())
         erase (Local3)
         erase (Local4)
         RestScreen(23, 0, 24, 79, Local5)
         return
      endif
   endif

********************************
function LER_TECLAS

   parameters quant, linha, coluna
   private i_tcl, tecla, vetor[quant], string, quant_tcl
   set color to I
   coluna:= coluna - 1
   quant_tcl:= quant
   string:= Space(0)
   for i_tcl:= 1 to quant_tcl
      vetor[i_tcl]:= 32
      @ linha, coluna + i_tcl say " "
   next
   i_tcl:= 0
   tecla:= 0
   do while (tecla != 13 .AND. tecla != 27)
      if (i_tcl == 0)
         setcursor(0)
         set color to n*/w
         @ linha, coluna + 1 say ""
      else
         setcursor(1)
         set color to I
      endif
      tecla:= InKey(0)
      if (tecla > 31 .AND. tecla < 127 .AND. i_tcl < quant_tcl)
         set color to I
         i_tcl:= i_tcl + 1
         vetor[i_tcl]:= tecla
         @ linha, coluna + i_tcl say Chr(tecla)
      elseif (tecla = 8)
         if (i_tcl > 0)
            i_tcl:= i_tcl - 1
         endif
         vetor[i_tcl + 1]:= 32
         if (i_tcl == 0)
            @ linha, coluna + 1 say " "
         else
            @ linha, coluna + i_tcl + 1 say " "
            @ linha, coluna + i_tcl say Chr(vetor[i_tcl])
         endif
      elseif (tecla = 13)
         for i_tcl:= 1 to quant_tcl
            string:= string + Chr(vetor[i_tcl])
         next
      endif
   enddo
   setcursor(1)
   set color to 
   return string

********************************
procedure TECLE_ESC

   parameters linha
   private linh
   if (PCount() == 0)
      linh:= 24
   elseif (Type("linha") != "N" .OR. linha < 0 .OR. linha > 24)
      linh:= 24
   else
      linh:= linha
   endif
   @ 24,  0 clear
   setcursor(0)
   @ linh,  0 say "....Tecle <ESCape> para continuar."
   setcursor(1)
   do while (InKey() != K_ESC)
   enddo
   return

********************************
init procedure DBFNTXINI

   rddregiste("DBFNTX", 1)
   return

********************************
procedure NUC465

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> para sair"}
   private cusuario, csenha, cconf, csenha_n
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("ALTERA", "SENHA")
   select PSW
   set order to 2
   do while (.T.)
      cusuario:= Space(20)
      set color to (cor[1])
      window(4, 1, 11, 39, "ͻȺ ", .T.)
      @  5,  3 say "Nome usuario.: "
      @  7,  3 say "Senha Usuario: "
      @  9,  3 say "Nova Senha...: "
      @ 10,  3 say "  Confirmacao: "
      if (ascan(vdireitos, "SENHAMASTER") > 0)
         set color to (cor[3])
         @  5, 18 get cUSUARIO picture "@!" valid !Empty(cusuario) ;
            when mens_when(mens1[1])
         read
         set color to 
         if (LastKey() == K_ESC)
            restore screen from Local1
            return
         endif
      else
         cusuario:= cusu
         set color to (cor[3])
         @  5, 18 get cUSUARIO picture "@!" valid !Empty(cusuario) ;
            when mens_when(mens1[1])
         readkill(.T.)
         getlist:= {}
         set color to 
      endif
      if (cusuario = "MASTER")
         loop
      endif
      seek cusuario
      if (!Found())
         ms250("Usuario nao encontrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      cusuario:= crypt(usuario, ckey)
      do while (.T.)
         if (ascan(vdireitos, "SENHAMASTER") == 0)
            csenha:= Space(20)
            set color to (cor[3])
            ms250("Digite a Senha do Usuario ou tecle <ESC> para sair.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            csenha:= Upper(getsecret(csenha, 7, 18))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            if (psw->(crypt(senha, ckey)) != csenha)
               ms250("Senha incorreta. Tecle <ESC> para sair.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               loop
            endif
         endif
         do while (.T.)
            csenha_n:= Space(20)
            ms250("Digite a Nova Senha do Usuario ou tecle <ESC> para sair.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            csenha_n:= Upper(getsecret(csenha_n, 9, 18))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            cconf:= Space(20)
            ms250("Digite novamente a Senha para confirmacao.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            cconf:= Upper(getsecret(cconf, 10, 18))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            if (csenha_n != cconf)
               ms250("Senha nao confere. Tecle <ESC> para digitar novamente.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               set color to (cor[1])
               @ 10, 18 say Space(20)
               set color to 
               loop
            endif
            exit
         enddo
         if (LastKey() != K_ESC .AND. confirme())
            DBEval({|| psw}, {|| crypt(usuario, ckey) = cusuario})
         endif
         set color to (cor[1])
         @  7, 17 clear to 10, 38
         set color to 
         exit
      enddo
      if (ascan(vdireitos, "SENHAMASTER") == 0)
         restore screen from Local1
         exit
      endif
   enddo
   return

********************************
static function EMPTYFILE

   if (LastRec() == 0)
      return .T.
   endif
   if ((EOF() .OR. RecNo() == LastRec() + 1) .AND. BOF())
      return .T.
   endif
   return .F.

********************************
procedure HELP1(Arg1, Arg2, Arg3)

   local Local1, Local2, Local3, Local4, Local5:= {Space(30)}, ;
      Local6, Local7, Local8:= {Space(30)}, Local9:= .T.
   private tela, mover_tela:= .T., lin_top, col_lef, lin_bot, ;
      col_rig, move_lint:= 0, move_coll:= 0, move_linb:= 0, ;
      move_colr:= 0, ult_proc:= "HELP1"
   if ("" = Arg3)
   else
      mv_hlp_on()
      Local2:= alias()
      Local4:= SetColor()
      Local3:= indexord()
      Local1:= Arg3
      if (Arg3 = "XNOME_PROD")
         Local1:= iif(xcod_prod = "IN", "INDICE", "MOEDA")
      endif
      select help1
      help1->(dbSetOrder(iif(_tabelas = Nil, 1, 2)))
      seek iif(_tabelas = Nil, Local1, _tabelas)
      if (Found())
         lin_top:= help1->lin_top
         col_lef:= help1->col_lef
         lin_bot:= help1->lin_bot
         col_rig:= help1->col_rig
         Local8[1]:= Trim(help1->titulo)
         Local5[1]:= help1->field1
         Local7:= help1->buffer
         Local6:= help1->alias
         select (Local6)
         set order to help1->orde_ind
         if (Arg1 = "CIM16" .AND. Arg3 = "XCONTATO")
            set filter to Cod_CL = XCod_CL
         endif
         goto top
         do while (mover_tela)
            mover_tela:= .F.
            tela:= SaveScreen(lin_top, col_lef, lin_bot, col_rig)
            set color to (cor[18])
            if (Local9)
               Local9:= .F.
               window(lin_top, col_lef, lin_bot, col_rig, "Ŀ ")
            else
               window(lin_top, col_lef, lin_bot, col_rig, "Ŀ ")
            endif
            if (db_help(lin_top + 1, col_lef + 1, lin_bot - 1, ;
                  col_rig - 1, @Local5, .T., Local8, .T., .T., .T., ;
                  .T.))
               Local7:= &Local7
               keyboard Local7
               exit
            endif
            keyboard "A"
            InKey()
            if (mover_tela)
               if (help1->(RLock()))
                  RestScreen(lin_top, col_lef, lin_bot, col_rig, tela)
                  lin_top:= lin_top + move_lint
                  lin_bot:= lin_bot + move_linb
                  col_lef:= col_lef + move_coll
                  col_rig:= col_rig + move_colr
                  replace help1->lin_top with lin_top
                  replace help1->col_lef with col_lef
                  replace help1->lin_bot with lin_bot
                  replace help1->col_rig with col_rig
                  move_lint:= move_coll:= move_linb:= move_colr:= 0
               endif
               help1->(dbUnlock())
            endif
         enddo
         RestScreen(lin_top, col_lef, lin_bot, col_rig, tela)
      else
         tone(2000, 1)
         tela:= SaveScreen(10, 26, 15, 54)
         set color to (cor[4])
         window(10, 26, 14, 53, "Ŀ ")
         @ 12, 29 say "Help, nao disponivel !"
         set color to 
         InKey(2)
         RestScreen(10, 26, 15, 54, tela)
      endif
      if ("" != Local2)
         select (Local2)
         set order to Local3
      endif
      set color to (Local4)
      mv_hlp_off()
      return
   endif

********************************
function PRINT(Arg1, Arg2, Arg3)

   local Local1:= {}, Local2, Local3, Local4:= alias(), Local5, ;
      Local6, Local7, Local8:= Row(), Local9:= Col(), Local10:= ;
      setcursor(), Local11
   Arg3:= iif(Arg3 != Nil, Arg3, 1)
   Local11:= config[5] + "print.sys"
   if (Select("PRT") != 0)
      return Static13
   else
      Arg1:= iif(Arg1 = Nil, 8, Arg1)
      Arg2:= iif(Arg2 = Nil, 28, iif(Arg2 > 56, 56, Arg2))
      Local6:= Arg2 + 23
      use (Local11) alias PRT new shared
      set filter to IMPRESSORA <> SPACE(10)
      do while (!EOF())
         AAdd(Local1, padc(Trim(prt->impressora), 22))
         skip 
      enddo
      set filter to
      Local7:= Len(Local1)
      Local5:= iif(Arg1 + Local7 + 1 > 24, 24, Arg1 + Local7 + 1)
      Local2:= SaveScreen(Arg1, Arg2, Local5, Local6)
      Local3:= SetColor("w/n,n/w")
      set color to n/w,w+/n
      @ Arg1, Arg2 to Local5, Local6 double
      @ Arg1, Arg2 + 1 say padc(" Impressora ", 22, "")
      Static13:= achoice(Arg1 + 1, Arg2 + 1, Local5 - 1, Local6 - 1, ;
         Local1, Nil, Nil, Arg3)
      goto Static13
      do while (LastKey() = K_ESC)
         Static13:= achoice(Arg1 + 1, Arg2 + 1, Local5 - 1, Local6 - ;
            1, Local1, Nil, Nil, Arg3)
         goto Static13
      enddo
   endif
   set color to (Local3)
   RestScreen(Arg1, Arg2, Local5, Local6, Local2)
   SetPos(Local8, Local9)
   setcursor(Local10)
   if (!Empty(Local4))
      select (Local4)
   else
      select 0
   endif
   return Static13

********************************
function IMP_PRT(Arg1)

   local Local1:= Len(Arg1), Local2, Local3:= "", Local4
   for Local2:= 1 to Local1
      Local4:= SubStr(Arg1, Local2, 1)
      if (Local4 != " ")
         Local3:= Local3 + Local4
      endif
   next
   return Local3

********************************
procedure HELP(Arg1, Arg2, Arg3)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8
   Local5:= .T.
   private mover_tela:= .T., lin_top, col_lef, lin_bot, col_rig, ;
      move_lint:= 0, move_coll:= 0, move_linb:= 0, move_colr:= 0, ;
      prog1:= Arg1, ult_proc:= "HELP", nr_linhas:= 0, cal_pos_cu:= 0
   if (Arg1 = "DB_HELP" .AND. loop_help = 1 .OR. loop_help = 2)
   else
      Local2:= alias()
      Local3:= SetColor()
      Local6:= setcursor()
      setcursor(0)
      select help
      seek Trim(Arg1) + Arg3
      if (Found())
         texto:= help->texto
         lin_top:= help->lin_top
         col_lef:= help->col_lef
         lin_bot:= help->lin_bot
         col_rig:= help->col_rig
      else
         tone(2000, 1)
         Local1:= SaveScreen(10, 26, 15, 54)
         set color to (cor[19])
         window(10, 26, 14, 53, "Ŀ ")
         @ 12, 29 say "Help, nao disponivel !"
         set color to 
         InKey(2)
         RestScreen(10, 26, 15, 54, Local1)
         setcursor(Local6)
         if (!Empty(Local2))
            select (Local2)
         endif
         SetPos(Local7, Local8)
         return
      endif
      loop_help++
      mv_hlp_on(.T.)
      SetKey(K_CTRL_END, Nil)
      cal_pos_cu:= lin_top + 1
      do while (mover_tela)
         mover_tela:= .F.
         Local1:= SaveScreen(lin_top, col_lef, lin_bot, col_rig)
         if (loop_help = 2 .OR. Arg1 = "DB_HELP")
            set color to (cor[18])
         else
            set color to (cor[19])
         endif
         if (Local5)
            window(lin_top, col_lef, lin_bot, col_rig, "Ŀ ")
            Local5:= .F.
         else
            @ lin_top, col_lef, lin_bot, col_rig box "Ŀ"
         endif
         if (loop_help = 2 .OR. Arg1 = "DB_HELP")
            set color to (cor[18])
         else
            set color to (cor[19])
         endif
         @ lin_top, col_lef + 2 say " HELP "
         if (loop_help = 2 .OR. Arg1 = "DB_HELP")
            set color to (cor[18])
         else
            set color to (cor[19])
         endif
         nr_linhas:= mlcount(texto, col_rig - 1 - (col_lef + 2))
         texto:= memoedit(texto, lin_top + 1, col_lef + 2, lin_bot - ;
            1, col_rig - 1, .T., "MEMO_HELP")
         set color to (Local3)
         RestScreen(lin_top, col_lef, lin_bot, col_rig, Local1)
         if (LastKey() == K_ESC)
            keyboard Chr(13)
            InKey()
            exit
         endif
         if (EOF())
            append blank
            replace help->programa with Arg1
            replace help->variavel with Arg3
         endif
         if (RLock())
            lin_top:= lin_top + move_lint
            lin_bot:= lin_bot + move_linb
            col_lef:= col_lef + move_coll
            col_rig:= col_rig + move_colr
            replace help->lin_top with lin_top
            replace help->col_lef with col_lef
            replace help->lin_bot with lin_bot
            replace help->col_rig with col_rig
            replace help->texto with texto
            move_lint:= move_coll:= move_linb:= move_colr:= 0
         endif
         unlock
      enddo
      if (!Empty(Local2))
         select (Local2)
      endif
      if (loop_help == 1)
         mv_hlp_off()
      endif
      loop_help--
      setcursor(Local6)
      SetPos(Local7, Local8)
      return
   endif

********************************
function EXCLUI

   local Local1
   Local1:= {}
   parameters linha
   private exclui, linh
   if (PCount() == 0)
      linh:= 24
   elseif (Type("linha") != "N" .OR. linha < 0 .OR. linha > 24)
      linh:= 24
   else
      linh:= linha
   endif
   set escape off
   exclui:= " "
   @ linh,  0 say "....Confirma a exclusao do registro acima (S/N) ? "
   SetPos(Row(), Col() + 1)
   AAdd(Local1, __Get({|_1| iif(ISNIL(_1), exclui, exclui:= _1)}, ;
      "exclui", "@! A", {|| exclui $ "SN"}, Nil):display())
   ReadModal(Local1)
   Local1:= {}
   @ 24,  0
   set escape on
   if (exclui = "S")
      return .T.
   else
      return .F.
   endif

********************************
function S123456789

   parameters modo, indice
   private tecla
   if (modo == 1000)
      return .F.
   endif
   tecla:= LastKey()
   tecla:= iif(tecla > 96 .AND. tecla < 123, tecla - 32, tecla)
   if (tecla = 27)
      return 0
   elseif (tecla = 13)
      sh_buffer:= .T.
      return 0
   elseif (tecla > 31)
      if (modo == 4)
         seek_help2()
      endif
   else
      RestScreen(l2 + 1, c1 - 1, l2 + 1, c2 + 1, sh_subtela)
      sh_letra:= .F.
   endif
   return 1

********************************
function MENS_WHEN(Arg1)

   if (ValType(n_a_v_e_g_) = "U")
      n_a_v_e_g_:= .F.
   endif
   if (n_a_v_e_g_)
      return .T.
   endif
   when250(Arg1, 24, 0, cor[4], cor[5], 80)
   return .T.

********************************
procedure INDEXAR(Arg1, Arg2, Arg3, Arg4)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7
   if (!file(xpathdbf + "CTEN.0__") .OR. !file(xpathdbf + ;
         "CTET.0__") .OR. !file(xpathdbf + "CTRE.0__") .OR. ;
         !file(xpathdbf + "CTPG.0__"))
      ms250("Nao foi localizado todos os arquivos do sistema. Tecle [ESC] para terminar.", ;
         24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
      set color to 
      close databases
      clear screen
      quit
   endif
   if (Arg4 = Nil)
      aviso(24, "Abrindo arquivos de Indices.  Aguarde...", .T.)
   else
      aviso(24, ;
         "Compactando arquivos de dados.  Aguarde por favor.", .T.)
   endif
   if (Arg2 = "TODOS" .OR. "BANCOS" $ Arg2)
      if (!file("BANCOS01.NTX") .OR. !file("BANCOS02.NTX") .OR. ;
            !file("BANCOS03.NTX") .OR. !file("BANCOS04.NTX") .OR. ;
            Arg1)
         if (Select("BANCOS") == 0)
            if (!netuse("BANCOS", Nil, "E", "NEW", 5))
               return
            endif
         else
            select BANCOS
         endif
         set index to 
         pack
         index on NR_BANCO+NR_AGENCIA+NR_CONTA to BANCOS01
         index on upper(NOME_BAN) to BANCOS02
         index on NR_CONTA+NR_BANCO to BANCOS03
         index on COD_NOSSO to BANCOS04
         closedata("BANCOS")
      endif
      if (!netuse("BANCOS", Nil, "S", "NEW", 5))
         return
      endif
      set index to BANCOS01, BANCOS02, BANCOS03, BANCOS04
   endif
   if (Arg2 = "TODOS" .OR. "CLIENTES" $ Arg2)
      if (!file("CLIENT01.NTX") .OR. !file("CLIENT02.NTX") .OR. ;
            !file("CLIENT03.NTX") .OR. !file("CLIENT04.NTX") .OR. ;
            !file("CLIENT05.NTX") .OR. !file("CLIENT06.NTX") .OR. ;
            !file("CLIENT07.NTX") .OR. !file("CLIENT08.NTX") .OR. ;
            !file("CLIENT09.NTX") .OR. !file("CLIENT10.NTX") .OR. ;
            !file("CLIENT11.NTX") .OR. Arg1)
         if (Select("CLIENTES") == 0)
            if (!netuse("CLIENTES", Nil, "E", "NEW", 5))
               return
            endif
         else
            select CLIENTES
         endif
         set index to 
         pack
         index on Cod_CL to CLIENT01
         index on upper(NOME_CL) to CLIENT02
         index on END_CL to CLIENT03
         index on CPF_CL to CLIENT04
         index on CGC_CL to CLIENT05
         index on INSC_ESTC to CLIENT06
         index on COD_VEND+EST_CL+CID_CL to CLIENT07
         index on EST_CL+CID_CL+NOME_CL to CLIENT08
         index on COD_COND to CLIENT09
         index on CID_CL to CLIENT10
         index on FANTASIA to CLIENT11
         closedata("CLIENTES")
      endif
      if (!netuse("CLIENTES", Nil, "S", "NEW", 5))
         return
      endif
      set index to CLIENT01, CLIENT02, CLIENT03, CLIENT04, CLIENT05, ;
         CLIENT06, CLIENT07, CLIENT08, CLIENT09, CLIENT10, CLIENT11
   endif
   if (Arg3 != Nil)
      close databases
   endif
   if (Arg2 = "TODOS" .OR. "CONTATOS" $ Arg2)
      if (!file("CONTAT01.NTX") .OR. !file("CONTAT02.NTX") .OR. ;
            !file("CONTAT03.NTX") .OR. Arg1)
         if (Select("CONTATOS") == 0)
            if (!netuse("CONTATOS", Nil, "E", "NEW", 5))
               return
            endif
         else
            select CONTATOS
         endif
         set index to 
         pack
         index on Cod_CL+upper(CONTATO) to CONTAT01
         index on CONTATO to CONTAT02
         index on DATA_NASC to CONTAT03
         index on Cod_CL + NIVEL + CONTATO to CONTAT04
         closedata("CONTATOS")
      endif
      if (!netuse("CONTATOS", Nil, "S", "NEW", 5))
         return
      endif
      set index to CONTAT01, CONTAT02, CONTAT03, CONTAT04
   endif
   if (Arg2 = "TODOS" .OR. "FORNECED" $ Arg2)
      if (!file("FORNEC01.NTX") .OR. !file("FORNEC02.NTX") .OR. ;
            !file("FORNEC03.NTX") .OR. !file("FORNEC04.NTX") .OR. ;
            !file("FORNEC05.NTX") .OR. !file("FORNEC06.NTX") .OR. ;
            !file("FORNEC07.NTX") .OR. Arg1)
         if (Select("FORNECED") == 0)
            if (!netuse("FORNECED", Nil, "E", "NEW", 5))
               return
            endif
         else
            select FORNECED
         endif
         set index to 
         pack
         index on COD_FO to FORNEC01
         index on upper(NOME_FO) to FORNEC02
         index on upper(END_FO) to FORNEC03
         index on PR_FO to FORNEC04
         index on CGC_FO to FORNEC05
         index on INSC_ESTF to FORNEC06
         index on PR_FO to FORNEC07
         closedata("FORNECED")
      endif
      if (!netuse("FORNECED", Nil, "S", "NEW", 5))
         return
      endif
      set index to FORNEC01, FORNEC02, FORNEC03, FORNEC04, FORNEC05, ;
         FORNEC06, FORNEC07
   endif
   if (Arg3 != Nil)
      close databases
   endif
   if (Arg2 = "TODOS" .OR. "HELP" $ Arg2)
      if (!file("HELP.NTX"))
         if (Select("HELP") == 0)
            if (!netuse("HELP", Nil, "E", "NEW", 5))
               return
            endif
         else
            select HELP
         endif
         set index to 
         pack
         index on TRIM(PROGRAMA)+VARIAVEL to HELP
         closedata("HELP")
      endif
      if (!netuse("HELP", Nil, "S", "NEW", 5))
         return
      endif
      set index to HELP
   endif
   if (Arg2 = "TODOS" .OR. "HELP" $ Arg2)
      if (!file("HELP1.NTX") .OR. !file("HELP2.NTX"))
         if (Select("HELP1") == 0)
            if (!netuse("HELP1", Nil, "E", "NEW", 5))
               return
            endif
         else
            select HELP1
         endif
         set index to 
         pack
         index on VARIAVEL to HELP1
         index on ALIAS to HELP2
         closedata("HELP1")
      endif
      if (!netuse("HELP1", Nil, "S", "NEW", 5))
         return
      endif
      set index to HELP1, HELP2
   endif
   if (Arg3 != Nil)
      close databases
   endif
   if (Arg2 = "TODOS" .OR. "EXTRATO" $ Arg2)
      if (!file("EXTRAT01.NTX") .OR. !file("EXTRAT02.NTX") .OR. Arg1)
         if (Select("EXTRATO") == 0)
            if (!netuse("EXTRATO", Nil, "E", "NEW", 5))
               return
            endif
         else
            select EXTRATO
         endif
         set index to 
         pack
         index on COD_NOSSO+dtos(DAT_LANCA) to EXTRAT01
         index on COD_NOSSO+NR_DOC to EXTRAT02
         closedata("EXTRATO")
      endif
      if (!netuse("EXTRATO", Nil, "S", "NEW", 5))
         return
      endif
      set index to EXTRAT01, EXTRAT02
   endif
   if (Arg2 = "TODOS" .OR. "SALDO" $ Arg2)
      if (!file("SALDO01.NTX") .OR. !file("SALDO02.NTX") .OR. ;
            !file("SALDO03.NTX") .OR. Arg1)
         if (Select("SALDO") == 0)
            if (!netuse("SALDO", Nil, "E", "NEW", 5))
               return
            endif
         else
            select SALDO
         endif
         set index to 
         pack
         index on COD_NOSSO+dtos(DAT_SALDO) to SALDO01
         index on DAT_SALDO to SALDO02
         index on COD_NOSSO + descend(dtos(DAT_SALDO)) to SALDO03
         closedata("SALDO")
      endif
      if (!netuse("SALDO", Nil, "S", "NEW", 5))
         return
      endif
      set index to SALDO01, SALDO02, SALDO03
   endif
   if (Arg2 = "TODOS" .OR. "CONT_REF" $ Arg2)
      if (!file("CONTREF1.NTX") .OR. !file("CONTREF2.NTX") .OR. ;
            !file("CONTREF3.NTX") .OR. Arg1)
         if (Select("CONT_REF") == 0)
            if (!netuse("CONT_REF", Nil, "E", "NEW", 5))
               return
            endif
         else
            select CONT_REF
         endif
         set index to 
         pack
         index on Cod_CL+descend(NR_DOC_RE) to CONTREF1
         index on descend(NR_DOC_RE) to CONTREF2
         index on descend(dtos(DT_VEN_DOC)) to CONTREF3
         closedata("CONT_REF")
      endif
      if (!netuse("CONT_REF", Nil, "S", "NEW", 5))
         return
      endif
      set index to CONTREF1, CONTREF2, CONTREF3
   endif
   if (Arg2 = "TODOS" .OR. "CONT_PGF" $ Arg2)
      if (!file("CONTPGF1.NTX") .OR. !file("CONTPGF2.NTX") .OR. ;
            !file("CONTPGF3.NTX") .OR. !file("CONTPGF4.NTX") .OR. ;
            Arg1)
         if (Select("CONT_PGF") == 0)
            if (!netuse("CONT_PGF", Nil, "E", "NEW", 5))
               return
            endif
         else
            select CONT_PGF
         endif
         set index to 
         pack
         index on COD_FO+descend(NR_DOC_CP) to CONTPGF1
         index on descend(NR_DOC_CP) to CONTPGF2
         index on descend(dtos(DT_VEN_CP)) to CONTPGF3
         index on DT_VEN_CP to CONTPGF4
         closedata("CONT_PGF")
      endif
      if (!netuse("CONT_PGF", Nil, "S", "NEW", 5))
         return
      endif
      set index to CONTPGF1, CONTPGF2, CONTPGF3, CONTPGF4
   endif
   if (Arg2 = "TODOS" .OR. "CONT_PGR" $ Arg2)
      Local1:= xpathdbf + "CTPG.0__"
      Local2:= xpathdbf + "CTPG.1__"
      Local3:= xpathdbf + "CTPG.2__"
      Local4:= xpathdbf + "CTPG.3__"
      Local5:= xpathdbf + "CTPG.4__"
      if (!file(Local2) .OR. !file(Local3) .OR. !file(Local4) .OR. ;
            !file(Local5) .OR. Arg1)
         if (Select("CONT_PGR") == 0)
            if (!netuse(Local1, "CONT_PGR", "E", "NEW", 5))
               return
            endif
         else
            select CONT_PGR
         endif
         set index to 
         pack
         index on COD_FO+descend(NR_DOC_CP) to (Local2)
         index on descend(NR_DOC_CP) to (Local3)
         index on descend(dtos(DT_VEN_CP)) to (Local4)
         index on DT_VEN_CP to (Local5)
         closedata("CONT_PGR")
      endif
      if (!netuse(Local1, "CONT_PGR", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3), (Local4), (Local5)
   endif
   if (Arg2 = "TODOS" .OR. "CONT_RER" $ Arg2)
      Local1:= xpathdbf + "CTRE.0__"
      Local2:= xpathdbf + "CTRE.1__"
      Local3:= xpathdbf + "CTRE.2__"
      Local4:= xpathdbf + "CTRE.3__"
      if (!file(Local2) .OR. !file(Local3) .OR. !file(Local4) .OR. ;
            Arg1)
         if (Select("CONT_RER") == 0)
            if (!netuse(Local1, "CONT_RER", "E", "NEW", 5))
               return
            endif
         else
            select CONT_RER
         endif
         set index to 
         pack
         index on Cod_CL+descend(NR_DOC_RE) to (Local2)
         index on descend(NR_DOC_RE) to (Local3)
         index on descend(dtos(DT_VEN_DOC)) to (Local4)
         closedata("CONT_RER")
      endif
      if (!netuse(Local1, "CONT_RER", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3), (Local4)
   endif
   if (Arg2 = "TODOS" .OR. "ENTREGAS" $ Arg2)
      Local1:= xpathdbf + "CTEN.0__"
      Local2:= xpathdbf + "CTEN.1__"
      Local3:= xpathdbf + "CTEN.2__"
      Local4:= xpathdbf + "CTEN.3__"
      Local5:= xpathdbf + "CTEN.4__"
      Local6:= xpathdbf + "CTEN.5__"
      Local7:= xpathdbf + "CTEN.6__"
      if (!file(Local2) .OR. !file(Local3) .OR. !file(Local4) .OR. ;
            !file(Local5) .OR. !file(Local6) .OR. !file(Local7) .OR. ;
            Arg1)
         if (Select("ENTREGAS") == 0)
            if (!netuse(Local1, "ENTREGAS", "E", "NEW", 5))
               return
            endif
         else
            select ENTREGAS
         endif
         set index to 
         pack
         index on descend(NUM_OS) to (Local2)
         index on descend(NUM_DOC) to (Local3)
         index on COD_CAR+descend(NUM_OS) to (Local4)
         index on COD_CAR+COD_FO+descend(dtos(DAT_ENTRE)) to (Local5)
         index on descend(dtos(DAT_ENTRE))+NUM_OS to (Local6)
         index on Cod_CL + descend(dtos(DAT_ENTRE)) to (Local7)
         closedata("ENTREGAS")
      endif
      if (!netuse(Local1, "ENTREGAS", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3), (Local4), (Local5), (Local6), ;
         (Local7)
   endif
   if (Arg2 = "TODOS" .OR. "LOCAL" $ Arg2)
      if (!file("LOCAL1.NTX") .OR. !file("LOCAL2.NTX") .OR. Arg1)
         if (Select("LOCAL") == 0)
            if (!netuse("LOCAL", Nil, "E", "NEW", 5))
               return
            endif
         else
            select LOCAL
         endif
         set index to 
         pack
         index on Cod_CL+DESCEND(COD_LOCAL) to LOCAL1
         index on Cod_CL+COD_LOCAL to LOCAL2
         closedata("LOCAL")
      endif
      if (!netuse("LOCAL", Nil, "S", "NEW", 5))
         return
      endif
      set index to LOCAL1, LOCAL2
   endif
   if (Arg2 = "TODOS" .OR. "TAB_VEN" $ Arg2)
      Local1:= xpathdbf + "TAB_VEN.DBF"
      Local2:= xpathdbf + "TAB_VEN1.NTX"
      Local3:= xpathdbf + "TAB_VEN2.NTX"
      Local4:= xpathdbf + "TAB_VEN3.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. !file(Local4) .OR. ;
            Arg1)
         if (Select("TAB_VEN") == 0)
            if (!netuse(Local1, "TAB_VEN", "E", "NEW", 5))
               return
            endif
         else
            select TAB_VEN
         endif
         set index to 
         pack
         index on COD_VEN to (Local2)
         index on NOME_VEN to (Local3)
         index on CPF_VEN to (Local4)
         closedata("TAB_VEN")
      endif
      if (!netuse(Local1, "TAB_VEN", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3), (Local4)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_VEI" $ Arg2)
      Local1:= xpathdbf + "TAB_VEI.DBF"
      Local2:= xpathdbf + "TAB_VEI1.NTX"
      Local3:= xpathdbf + "TAB_VEI2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_VEI") == 0)
            if (!netuse(Local1, "TAB_VEI", "E", "NEW", 5))
               return
            endif
         else
            select TAB_VEI
         endif
         set index to 
         pack
         index on COD_VEI to (Local2)
         index on PLACA_VEI to (Local3)
         closedata("TAB_VEI")
      endif
      if (!netuse(Local1, "TAB_VEI", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_MOE" $ Arg2)
      Local1:= xpathdbf + "TAB_MOE.DBF"
      Local2:= xpathdbf + "TAB_MOE1.NTX"
      Local3:= xpathdbf + "TAB_MOE2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_MOE") == 0)
            if (!netuse(Local1, "TAB_MOE", "E", "NEW", 5))
               return
            endif
         else
            select TAB_MOE
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_MOE")
      endif
      if (!netuse(Local1, "TAB_MOE", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_IND" $ Arg2)
      Local1:= xpathdbf + "TAB_IND.DBF"
      Local2:= xpathdbf + "TAB_IND1.NTX"
      Local3:= xpathdbf + "TAB_IND2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_IND") == 0)
            if (!netuse(Local1, "TAB_IND", "E", "NEW", 5))
               return
            endif
         else
            select TAB_IND
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_IND")
      endif
      if (!netuse(Local1, "TAB_IND", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_CGF" $ Arg2)
      Local1:= xpathdbf + "TAB_CGF.DBF"
      Local2:= xpathdbf + "TAB_CGF1.NTX"
      Local3:= xpathdbf + "TAB_CGF2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_CGF") == 0)
            if (!netuse(Local1, "TAB_CGF", "E", "NEW", 5))
               return
            endif
         else
            select TAB_CGF
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_CGF")
      endif
      if (!netuse(Local1, "TAB_CGF", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_CCL" $ Arg2)
      Local1:= xpathdbf + "TAB_CCL.DBF"
      Local2:= xpathdbf + "TAB_CCL1.NTX"
      Local3:= xpathdbf + "TAB_CCL2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_CCL") == 0)
            if (!netuse(Local1, "TAB_CCL", "E", "NEW", 5))
               return
            endif
         else
            select TAB_CCL
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_CCL")
      endif
      if (!netuse(Local1, "TAB_CCL", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_UNI" $ Arg2)
      Local1:= xpathdbf + "TAB_UNI.DBF"
      Local2:= xpathdbf + "TAB_UNI1.NTX"
      Local3:= xpathdbf + "TAB_UNI2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_UNI") == 0)
            if (!netuse(Local1, "TAB_UNI", "E", "NEW", 5))
               return
            endif
         else
            select TAB_UNI
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_UNI")
      endif
      if (!netuse(Local1, "TAB_UNI", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_CPA" $ Arg2)
      Local1:= xpathdbf + "TAB_CPA.DBF"
      Local2:= xpathdbf + "TAB_CPA1.NTX"
      Local3:= xpathdbf + "TAB_CPA2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_CPA") == 0)
            if (!netuse(Local1, "TAB_CPA", "E", "NEW", 5))
               return
            endif
         else
            select TAB_CPA
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_CPA")
      endif
      if (!netuse(Local1, "TAB_CPA", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_TRA" $ Arg2)
      Local1:= xpathdbf + "TAB_TRA.DBF"
      Local2:= xpathdbf + "TAB_TRA1.NTX"
      Local3:= xpathdbf + "TAB_TRA2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_TRA") == 0)
            if (!netuse(Local1, "TAB_TRA", "E", "NEW", 5))
               return
            endif
         else
            select TAB_TRA
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_TRA")
      endif
      if (!netuse(Local1, "TAB_TRA", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_UF" $ Arg2)
      Local1:= xpathdbf + "TAB_UF.DBF"
      Local2:= xpathdbf + "TAB_UF1.NTX"
      Local3:= xpathdbf + "TAB_UF2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_UF") == 0)
            if (!netuse(Local1, "TAB_UF", "E", "NEW", 5))
               return
            endif
         else
            select TAB_UF
         endif
         set index to 
         pack
         index on COD_UF to (Local2)
         index on NOME_UF to (Local3)
         closedata("TAB_UF")
      endif
      if (!netuse(Local1, "TAB_UF", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "TAB_SET" $ Arg2)
      Local1:= xpathdbf + "TAB_SET.DBF"
      Local2:= xpathdbf + "TAB_SET1.NTX"
      Local3:= xpathdbf + "TAB_SET2.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. !file(Local3) .OR. Arg1)
         if (Select("TAB_SET") == 0)
            if (!netuse(Local1, "TAB_SET", "E", "NEW", 5))
               return
            endif
         else
            select TAB_SET
         endif
         set index to 
         pack
         index on CODIGO to (Local2)
         index on DESCRICAO to (Local3)
         closedata("TAB_SET")
      endif
      if (!netuse(Local1, "TAB_SET", "S", "NEW", 5))
         return
      endif
      set index to (Local2), (Local3)
   endif
   if (Arg2 = "TODOS" .OR. "MP_R" $ Arg2)
      if (!file("MP_R01.NTX") .OR. !file("MP_R02.NTX") .OR. Arg1)
         if (Select("MP_R") == 0)
            if (!netuse("MP_R", Nil, "E", "NEW", 5))
               return
            endif
         else
            select MP_R
         endif
         set index to 
         pack
         index on CO_MP to MP_R01
         index on DE_MP to MP_R02
         closedata("MP_R")
      endif
      if (!netuse("MP_R", Nil, "S", "NEW", 5))
         return
      endif
      set index to MP_R01, MP_R02
   endif
   if (Arg2 = "TODOS" .OR. "CUSTO_GF" $ Arg2)
      if (!file("CGF01.NTX") .OR. Arg1)
         if (Select("CUSTO_GF") == 0)
            if (!netuse("CUSTO_GF", Nil, "E", "NEW", 5))
               return
            endif
         else
            select CUSTO_GF
         endif
         set index to 
         pack
         index on CO_CUSTO+CO_SET+descend(ma_to_s(MES_ANO)) to CGF01
         closedata("CUSTO_GF")
      endif
      if (!netuse("CUSTO_GF", Nil, "S", "NEW", 5))
         return
      endif
      set index to CGF01
   endif
   if (Arg2 = "TODOS" .OR. "PROD_ACA" $ Arg2)
      if (!file("PAC01.NTX") .OR. !file("PAC02.NTX") .OR. Arg1)
         if (Select("PROD_ACA") == 0)
            if (!netuse("PROD_ACA", Nil, "E", "NEW", 5))
               return
            endif
         else
            select PROD_ACA
         endif
         set index to 
         pack
         index on CO_PROD to PAC01
         index on DE_PROD to PAC02
         closedata("PROD_ACA")
      endif
      if (!netuse("PROD_ACA", Nil, "S", "NEW", 5))
         return
      endif
      set index to PAC01, PAC02
   endif
   if (Arg2 = "TODOS" .OR. "FORMULA" $ Arg2)
      if (!file("FORMULA1.NTX") .OR. Arg1)
         if (Select("FORMULA") == 0)
            if (!netuse("FORMULA", Nil, "E", "NEW", 5))
               return
            endif
         else
            select FORMULA
         endif
         set index to 
         pack
         index on CO_PROD+CO_MP to FORMULA1
         closedata("FORMULA")
      endif
      if (!netuse("FORMULA", Nil, "S", "NEW", 5))
         return
      endif
      set index to FORMULA1
   endif
   if (Arg2 = "TODOS" .OR. "PRODUCAO" $ Arg2)
      if (!file("PRODUC1.NTX") .OR. Arg1)
         if (Select("PRODUCAO") == 0)
            if (!netuse("PRODUCAO", Nil, "E", "NEW", 5))
               return
            endif
         else
            select PRODUCAO
         endif
         set index to 
         pack
         index on CO_PROD+CO_SET+dtos(DT_PROD) to PRODUC1
         closedata("PRODUCAO")
      endif
      if (!netuse("PRODUCAO", Nil, "S", "NEW", 5))
         return
      endif
      set index to PRODUC1
   endif
   if (Arg2 = "TODOS" .OR. "MP_INT" $ Arg2)
      if (!file("MP_INT1.NTX") .OR. Arg1)
         if (Select("MP_INT") == 0)
            if (!netuse("MP_INT", Nil, "E", "NEW", 5))
               return
            endif
         else
            select MP_INT
         endif
         set index to 
         pack
         index on CO_MP+CO_SET+dtos(DT_MP) to MP_INT1
         closedata("MP_INT")
      endif
      if (!netuse("MP_INT", Nil, "S", "NEW", 5))
         return
      endif
      set index to MP_INT1
   endif
   if (Arg2 = "TODOS" .OR. "EMPRESTI" $ Arg2)
      if (!file("EMPREST1.NTX") .OR. !file("EMPREST2.NTX") .OR. Arg1)
         if (Select("EMPRESTI") == 0)
            if (!netuse("EMPRESTI", Nil, "E", "NEW", 5))
               return
            endif
         else
            select EMPRESTI
         endif
         set index to 
         pack
         index on NOME_EMP to EMPREST1
         index on DT_PR_LIQ to EMPREST2
         closedata("EMPRESTI")
      endif
      if (!netuse("EMPRESTI", Nil, "S", "NEW", 5))
         return
      endif
      set index to EMPREST1, EMPREST2
   endif
   if (Arg2 = "TODOS" .OR. "PED_MP_R" $ Arg2)
      if (!file("PE_MP_R1.NTX") .OR. !file("PE_MP_R2.NTX") .OR. Arg1)
         if (Select("PED_MP_R") == 0)
            if (!netuse("PED_MP_R", Nil, "E", "NEW", 5))
               return
            endif
         else
            select PED_MP_R
         endif
         set index to 
         pack
         index on NR_PED to PE_MP_R1
         index on COD_FO+NR_PED to PE_MP_R2
         closedata("PED_MP_R")
      endif
      if (!netuse("PED_MP_R", Nil, "S", "NEW", 5))
         return
      endif
      set index to PE_MP_R1, PE_MP_R2
   endif
   if (Arg2 = "TODOS" .OR. "PED_MP_F" $ Arg2)
      if (!file("PE_MP_F1.NTX") .OR. !file("PE_MP_F2.NTX") .OR. Arg1)
         if (Select("PED_MP_F") == 0)
            if (!netuse("PED_MP_F", Nil, "E", "NEW", 5))
               return
            endif
         else
            select PED_MP_F
         endif
         set index to 
         pack
         index on NR_PED to PE_MP_F1
         index on COD_FO+NR_PED to PE_MP_F2
         closedata("PED_MP_F")
      endif
      if (!netuse("PED_MP_F", Nil, "S", "NEW", 5))
         return
      endif
      set index to PE_MP_F1, PE_MP_F2
   endif
   if (Arg2 = "TODOS" .OR. "IT_P_MPF" $ Arg2)
      if (!file("ITP_MPF1.NTX") .OR. !file("ITP_MPF2.NTX") .OR. Arg1)
         if (Select("IT_P_MPF") == 0)
            if (!netuse("IT_P_MPF", Nil, "E", "NEW", 5))
               return
            endif
         else
            select IT_P_MPF
         endif
         set index to 
         pack
         index on NR_PED+NR_ITEM_PD to ITP_MPF1
         index on CO_MP+NR_PED to ITP_MPF2
         closedata("IT_P_MPF")
      endif
      if (!netuse("IT_P_MPF", Nil, "S", "NEW", 5))
         return
      endif
      set index to ITP_MPF1, ITP_MPF2
   endif
   if (Arg2 = "TODOS" .OR. "IT_P_MPR" $ Arg2)
      if (!file("ITP_MPR1.NTX") .OR. !file("ITP_MPR2.NTX") .OR. Arg1)
         if (Select("IT_P_MPR") == 0)
            if (!netuse("IT_P_MPR", Nil, "E", "NEW", 5))
               return
            endif
         else
            select IT_P_MPR
         endif
         set index to 
         pack
         index on NR_PED+NR_ITEM_PD to ITP_MPR1
         index on CO_MP+NR_PED to ITP_MPR2
         closedata("IT_P_MPR")
      endif
      if (!netuse("IT_P_MPR", Nil, "S", "NEW", 5))
         return
      endif
      set index to ITP_MPR1, ITP_MPR2
   endif
   if (Arg2 = "TODOS" .OR. "MOV_MP" $ Arg2)
      if (!file("MOV_MP01.NTX") .OR. !file("MOV_MP02.NTX") .OR. ;
            !file("MOV_MP03.NTX") .OR. !file("MOV_MP04.NTX") .OR. ;
            Arg1)
         if (Select("MOV_MP") == 0)
            if (!netuse("MOV_MP", "MOV_MP", "E", "NEW", 5))
               return
            endif
         else
            select MOV_MP
         endif
         set index to 
         pack
         index on CO_MP+CO_SET+DTOS(DT_MOV_MP) to MOV_MP01
         index on CO_MP+DTOS(DT_MOV_MP) to MOV_MP02
         index on CO_MP+REFER to MOV_MP03
         index on CO_SET+DTOS(DT_MOV_MP)+CO_MP to MOV_MP04
         closedata("MOV_MP")
      endif
      if (!netuse("MOV_MP", "MOV_MP", "S", "NEW", 5))
         return
      endif
      set index to MOV_MP01, MOV_MP02, MOV_MP03, MOV_MP04
   endif
   if (Arg2 = "TODOS" .OR. "VENDAS_F" $ Arg2)
      if (!file("VENDASF1.NTX") .OR. !file("VENDASF2.NTX") .OR. ;
            !file("VENDASF3.NTX") .OR. !file("VENDASF4.NTX") .OR. ;
            !file("VENDASF5.NTX") .OR. Arg1)
         if (Select("VENDAS_F") == 0)
            if (!netuse("VENDAS_F", Nil, "E", "NEW", 5))
               return
            endif
         else
            select VENDAS_F
         endif
         set index to 
         pack
         index on NR_PED to VENDASF1
         index on Cod_CL+NR_PED to VENDASF2
         index on NR_CARGA+Cod_CL to VENDASF3
         index on CO_VEN+Cod_CL to VENDASF4
         index on DT_PED to VENDASF5
         closedata("VENDAS_F")
      endif
      if (!netuse("VENDAS_F", Nil, "S", "NEW", 5))
         return
      endif
      set index to VENDASF1, VENDASF2, VENDASF3, VENDASF4, VENDASF5
   endif
   if (Arg2 = "TODOS" .OR. "VENDAS_R" $ Arg2)
      if (!file("VENDASR1.NTX") .OR. !file("VENDASR2.NTX") .OR. ;
            !file("VENDASR3.NTX") .OR. !file("VENDASR4.NTX") .OR. ;
            !file("VENDASR5.NTX") .OR. Arg1)
         if (Select("VENDAS_R") == 0)
            if (!netuse("VENDAS_R", Nil, "E", "NEW", 5))
               return
            endif
         else
            select VENDAS_R
         endif
         set index to 
         pack
         index on NR_PED to VENDASR1
         index on Cod_CL+NR_PED to VENDASR2
         index on NR_CARGA+Cod_CL to VENDASR3
         index on CO_VEN+Cod_CL to VENDASR4
         index on DT_PED to VENDASR5
         closedata("VENDAS_R")
      endif
      if (!netuse("VENDAS_R", Nil, "S", "NEW", 5))
         return
      endif
      set index to VENDASR1, VENDASR2, VENDASR3, VENDASR4, VENDASR5
   endif
   if (Arg2 = "TODOS" .OR. "ITEM_VER" $ Arg2)
      if (!file("ITEMVER1.NTX") .OR. !file("ITEMVER2.NTX") .OR. Arg1)
         if (Select("ITEM_VER") == 0)
            if (!netuse("ITEM_VER", Nil, "E", "NEW", 5))
               return
            endif
         else
            select ITEM_VER
         endif
         set index to 
         pack
         index on NR_PED+NR_ITEM_PD to ITEMVER1
         index on CO_PROD+NR_PED to ITEMVER2
         closedata("ITEM_VER")
      endif
      if (!netuse("ITEM_VER", Nil, "S", "NEW", 5))
         return
      endif
      set index to ITEMVER1, ITEMVER2
   endif
   if (Arg2 = "TODOS" .OR. "ITEM_VEF" $ Arg2)
      if (!file("ITEMVEF1.NTX") .OR. !file("ITEMVEF2.NTX") .OR. Arg1)
         if (Select("ITEM_VEF") == 0)
            if (!netuse("ITEM_VEF", Nil, "E", "NEW", 5))
               return
            endif
         else
            select ITEM_VEF
         endif
         set index to 
         pack
         index on NR_PED+NR_ITEM_PD to ITEMVEF1
         index on CO_PROD+NR_PED to ITEMVEF2
         closedata("ITEM_VEF")
      endif
      if (!netuse("ITEM_VEF", Nil, "S", "NEW", 5))
         return
      endif
      set index to ITEMVEF1, ITEMVEF2
   endif
   if (Arg2 = "TODOS" .OR. "IMPOSTOS" $ Arg2)
      if (!file("IMPOSTO1.NTX") .OR. Arg1)
         if (Select("IMPOSTOS") == 0)
            if (!netuse("IMPOSTOS", Nil, "E", "NEW", 5))
               return
            endif
         else
            select IMPOSTOS
         endif
         set index to 
         pack
         index on CO_IMPOS to IMPOSTO1
         closedata("IMPOSTOS")
      endif
      if (!netuse("IMPOSTOS", Nil, "S", "NEW", 5))
         return
      endif
      set index to IMPOSTO1
   endif
   if (Arg2 = "TODOS" .OR. "INSERE" $ Arg2)
      Local1:= xpathdbf + "INSERE.DBF"
      Local2:= xpathdbf + "INSERE.NTX"
      if (!file(Local1))
         erro_file()
      endif
      if (!file(Local2) .OR. Arg1)
         if (Select("INSERE") == 0)
            if (!netuse(Local1, "INSERE", "E", "NEW", 5))
               return
            endif
         else
            select INSERE
         endif
         set index to 
         pack
         index on INSERE->APELIDO to (Local2)
         closedata("INSERE")
      endif
      if (!netuse(Local1, "INSERE", "S", "NEW", 5))
         return
      endif
      set index to (Local2)
   endif
   if (Arg2 = "TODOS" .OR. "VALOR_TA" $ Arg2)
      if (!file("VALOR_T1.NTX") .OR. Arg1)
         if (Select("VALOR_TA") == 0)
            if (!netuse("VALOR_TA", Nil, "E", "NEW", 5))
               return
            endif
         else
            select VALOR_TA
         endif
         set index to 
         pack
         index on COD_PROD+NOME_PROD+DTOS(DATA_PROD) to VALOR_T1
         closedata("VALOR_TA")
      endif
      if (!netuse("VALOR_TA", Nil, "S", "NEW", 5))
         return
      endif
      set index to VALOR_T1
   endif
   if (Arg3 != Nil)
      close databases
   endif

********************************
function ESCOLHA(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
   Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9, Local10, Local11, Local12
   Static8:= iif(Arg14 != Nil, Arg14, Static8)
   Arg15:= iif(Arg15 = Nil, .F., .T.)
   Arg6:= iif(ISNIL(Arg6), "Ŀ", iif(ValType(Arg6) = "N", ;
      iif(Arg6 = 1, "Ŀ", "ͻȺ"), Arg6)) + " "
   Local12:= readvar()
   if (Arg4 != Nil)
      Static8:= ascan(Arg4, &Local12)
   endif
   Local1:= Len(Arg3)
   Local2:= 0
   for Local3:= 1 to Local1
      Local7:= Len(Arg3[Local3])
      Local2:= iif(Local7 > Local2, Local7, Local2)
   next
   Local4:= savescr(Arg1, Arg2, Arg1 + Local1 + 2, Arg2 + Local2 + 2)
   Local5:= SetColor()
   set color to (Arg5)
   Local6:= setcursor()
   Local8:= Set(_SET_MESSAGE)
   Local9:= Set(_SET_MCENTER)
   set message to 
   Local10:= SaveScreen(Set(_SET_MESSAGE), 0, Set(_SET_MESSAGE), 79)
   window(Arg1, Arg2, Arg1 + Local1 + 1, Arg2 + Local2 + 1, Arg6, ;
      Arg15)
   @ Arg1, Arg2 + 1 say iif(Arg8 = Nil, "", Arg8)
   for Local3:= 1 to Local1
      @ Arg1 + Local3, Arg2 + 1 prompt Arg3[Local3] message iif(Arg9 ;
         != Nil, padc(Arg9[Local3], iif(Arg11 = Nil, ;
         Len(Arg9[Local3]), Arg11)), "")
   next
   menu to Static8
   if (Arg13 = Nil)
      restscr(Local4)
   endif
   set color to (Local5)
   setcursor(Local6)
   RestScreen(Set(_SET_MESSAGE), 0, Set(_SET_MESSAGE), 79, Local10)
   set message to 
   Local11:= LastKey()
   if (Arg4 != Nil)
      if (Local11 = 27)
         keyboard Chr(27)
      elseif (Local11 = 18)
         keyboard Chr(5)
      else
         keyboard Arg4[Static8]
      endif
   endif
   if (Arg7 = .T.)
      if (Local11 == 27)
         return .F.
      else
         return .T.
      endif
   else
      return Static8
   endif
   return Nil

********************************
procedure FUNC0003


********************************
function NAV(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9)

   local Local1, Local2, Local3, Local4
   private n_a_v_e_g_:= .T.
   Local3:= iif(Arg6 = Nil, Nil, &Arg6)
   Local4:= Arg7
   do while (.T.)
      if (Arg9 == "NUC211")
         m_clientes:= iif(clientes->jur_fis = "J", 1, 2)
         set color to (cor[1])
         t_clientes(.F.)
      endif
      &Arg4()
      &Arg5()
      if (Arg3 != Nil)
         Local2:= &Arg3
         @ Arg1, Arg2 get chave
      endif
      if (Arg8 != Nil)
         keyboard Replicate(Chr(13), Len(getlist))
         read
         clear typeahead
      else
         readkill(.T.)
         getlist:= {}
      endif
      @ 23,  0 clear to 24, 79
      setcursor(0)
      set color to (cor[9])
      @ 24,  0 say " PgUp Anterior "
      @ 24, 16 say " PgDn Proximo  "
      @ 24, 32 say "  F2 Alterar   "
      @ 24, 48 say "  F3 Excluir   "
      @ 24, 64 say "    Esc Sai     "
      set color to (cor[10])
      @ 24,  1 say "PgUp"
      @ 24, 17 say "PgDn"
      @ 24, 34 say "F2"
      @ 24, 50 say "F3"
      @ 24, 68 say "Esc"
      set color to 
      Local1:= InKey(0)
      if (Local1 == -3)
         ver_contat()
      elseif (Local1 == -4)
         edita_obs()
      endif
      if (Local1 = 3)
         skip 
         if (EOF() .OR. iif(Arg6 = Nil, Nil, &Arg6) != Arg7)
            tone(2000, 1)
            mensagem("Final de Arquivo !", 0.5)
            skip -1
         endif
      elseif (Local1 = 18)
         skip -1
         if (BOF() .OR. iif(Arg6 = Nil, Nil, &Arg6) != Arg7)
            if (iif(Arg6 = Nil, Nil, &Arg6) != Arg7)
               skip 
            endif
            tone(2000, 1)
            mensagem("Inicio de Arquivo !", 0.5)
         endif
      elseif (Local1 = -1 .OR. Local1 = -2 .OR. Local1 = 27)
         setcursor(1)
         n_a_v_e_g_:= .F.
         return Local1
      endif
   enddo
   return Local1

********************************
function CHECA_CGC(Arg1)

   local Local1[12], Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9
   for Local2:= 1 to 12
      Local1[Local2]:= Val(SubStr(Arg1, Local2, 1))
   next
   Local3:= 5 * Local1[1] + 4 * Local1[2] + 3 * Local1[3] + 2 * ;
      Local1[4] + 9 * Local1[5] + 8 * Local1[6] + 7 * Local1[7] + 6 ;
      * Local1[8] + 5 * Local1[9] + 4 * Local1[10] + 3 * Local1[11] ;
      + 2 * Local1[12]
   Local4:= Local3 / 11
   Local5:= Int(Local4) * 11
   Local6:= Local3 - Local5
   if (Local6 = 0 .OR. Local6 = 1)
      Local8:= 0
   else
      Local8:= 11 - Local6
   endif
   Local3:= 6 * Local1[1] + 5 * Local1[2] + 4 * Local1[3] + 3 * ;
      Local1[4] + 2 * Local1[5] + 9 * Local1[6] + 8 * Local1[7] + 7 ;
      * Local1[8] + 6 * Local1[9] + 5 * Local1[10] + 4 * Local1[11] ;
      + 3 * Local1[12] + 2 * Local8
   Local4:= Local3 / 11
   Local5:= Int(Local4) * 11
   Local7:= Local3 - Local5
   if (Local7 = 0 .OR. Local7 = 1)
      Local9:= 0
   else
      Local9:= 11 - Local7
   endif
   if (Local8 != Val(SubStr(Arg1, 13, 1)) .OR. Local9 != ;
         Val(SubStr(Arg1, 14, 1)))
      ms250("Nmero do CGC incorreto, tecle [ESC] para continuar.", ;
         24, 0, cor[6], cor[7], {27, 0}, Nil, 80, "C")
      return .F.
   else
      return .T.
   endif

********************************
function DIA_EXT

   parameters dia, tipo
   private tab_dia
   tab_dia:= ;
      "domingo   segunda   terca     quarta    quinta    sexta     sabado"
   if (PCount() < 2)
      return Trim(Upper(SubStr(tab_dia, dia * 10 - 9, 10)))
   elseif (tipo = 1)
      return Upper(SubStr(tab_dia, dia * 10 - 9, 1)) + ;
         Trim(SubStr(tab_dia, dia * 10 - 8, 9))
   elseif (tipo = 2)
      return Trim(SubStr(tab_dia, dia * 10 - 9, 10))
   else
      return Trim(Upper(SubStr(tab_dia, dia * 10 - 9, 10)))
   endif

********************************
function __GETSETPI(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[3]:= Arg1
   endif
   return qself()[3]

********************************
function CONTR_EXCL(Arg1)

   local Local1, Local2, Local3, Local4, Local5
   Local1:= alias()
   if ("" != Local1)
      Local2:= indexord()
   endif
   if (!file("CONTROLE.NTX"))
      if (!netuse("CONTROLE", Nil, "E", "NEW", 5))
         if ("" != Local1)
            select (Local1)
         endif
         return .F.
      else
         set index to 
         index on ALIAS_EXC to CONTROLE
         closedata("CONTROLE")
      endif
   endif
   if (!netuse("CONTROLE", Nil, "S", "NEW", 5))
      if ("" != Local1)
         select (Local1)
      endif
      return .F.
   endif
   set index to CONTROLE
   controle->(dbSeek(Arg1))
   if (EOF())
      if ("" != Local1)
         select (Local1)
         closedata("CONTROLE")
      endif
      return .T.
   endif
   do while (controle->alias_exc = Arg1)
      if ("" != alias(controle->alias_dep))
         select (controle->alias_dep)
         Local3:= indexord()
         set order to controle->ord_dep
         Local4:= Trim(controle->alias_exc) + "->" + ;
            Trim(controle->var_exc)
         seek &Local4
         set order to Local3
         if (Found())
            tone(800, 5)
            ms250("Existe outro arquivo dependente deste registro. Tecle <ESC> p/ continuar.", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
            closedata("CONTROLE")
            if ("" != Local1)
               select (Local1)
            endif
            return .F.
         endif
      else
         if (!netuse(controle->arquivod, Nil, "S", "NEW", 5))
            closedata("CONTROLE")
            if ("" != Local1)
               select (Local1)
            endif
            return .F.
         endif
         dbSetIndex(controle->arquivoi)
         Local4:= Trim(controle->alias_exc) + "->" + ;
            Trim(controle->var_exc)
         seek &Local4
         if (Found())
            tone(800, 5)
            ms250("Existe outro arquivo dependente deste registro. Tecle <ESC> p/ continuar.", ;
               24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
            closedata(controle->arquivod)
            closedata("CONTROLE")
            if ("" != Local1)
               select (Local1)
            endif
            return .F.
         else
            closedata(controle->arquivod)
         endif
      endif
      select CONTROLE
      skip 
   enddo
   if ("" != Local1)
      select (Local1)
   endif
   closedata("CONTROLE")
   return .T.

********************************
function LER_TECL

   parameters quant, linha, coluna
   private i, tecla, vetor[quant], string
   set color to I
   coluna:= coluna - 1
   string:= Space(0)
   for i:= 1 to quant
      vetor[i]:= 32
      @ linha, coluna + i say " "
   next
   i:= 0
   tecla:= 0
   do while (tecla != 13 .AND. tecla != 27)
      if (i == 0)
         setcursor(0)
         set color to n*/w
         @ linha, coluna + 1 say ""
      else
         setcursor(1)
         set color to I
      endif
      tecla:= InKey(0)
      if (tecla > 31 .AND. tecla < 127 .AND. i < quant)
         set color to I
         i:= i + 1
         vetor[i]:= tecla
         @ linha, coluna + i say Chr(tecla)
      elseif (tecla = 8)
         if (i > 0)
            i:= i - 1
         endif
         vetor[i + 1]:= 32
         if (i == 0)
            @ linha, coluna + 1 say " "
         else
            @ linha, coluna + i + 1 say " "
            @ linha, coluna + i say Chr(vetor[i])
         endif
      elseif (tecla = 13)
         for i:= 1 to quant
            string:= string + Chr(vetor[i])
         next
      endif
   enddo
   setcursor(1)
   set color to 
   return string

********************************
function DB_HELP

   parameters l1, c1, l2, c2, m1, m2, m3, m4, m5, m6, m7
   private sh_buffer, sh_letra, sh_letras, sh_subtela
   sh_buffer:= s123456789(1000)
   sh_letras:= Space(0)
   sh_letra:= .F.
   sh_subtela:= SaveScreen(l2 + 1, c1 - 1, l2 + 1, c2 + 1)
   dbedit(l1, c1, l2, c2, m1, "S123456789", m2, m3, m4, m5, m6, m7)
   RestScreen(l2 + 1, c1 - 1, l2 + 1, c2 + 1, sh_subtela)
   if (sh_buffer)
      return .T.
   else
      return .F.
   endif
   return Nil

********************************
init procedure CLIPINIT

   public getlist:= {}
   errorsys()
   return

********************************
procedure CABE(Arg1, Arg2, Arg3, Arg4)

   local Local1
   if (Arg4 = Nil)
      Local1:= iif(Arg2 = Nil, 56, 45)
      if (Arg1 $ "366/367")
         Local1:= 108
      endif
   else
      Local1:= Arg4
   endif
   if (i_m_p_r_ee = "ARQUIVO.TXT")
      xvid_imp:= 86
   endif
   if (xvid_imp == 73)
      @  0,  0 say prt->imp_reset + prt->imp_10cpp
      if ("366" = Arg1)
         if (_resultado = 6 .AND. xvid_imp = 73)
            @ PRow(), PCol() say prt->imp_reset + prt->imp_20cpp + ;
               prt->imp_land
         endif
      endif
      @ PRow() + 1, Local1 say "Data emissao: " + DToC(Date())
      @ PRow() + 1, Local1 say "Hora emissao: " + Time()
      @ PRow() + 1, Local1 say "Pagina nr.  : " + strzero(++pg, 3)
      if (Arg2 != Nil)
         @ PRow() + 1, Local1 say "Periodo de  : " + DToC(Arg2) + ;
            " a " + DToC(Arg3)
      endif
      @ PRow() + 1,  2 say prt->imp_lenfat
      @ PRow() + 1,  2 say _xempresa + prt->imp_denfat
      @ PRow() + 1,  2 say nome_rel
      @ PRow() + 1,  2 say Replicate("_", Local1 + iif(Arg2 = Nil, ;
         20, 31))
   else
      @  0,  0 say " "
      if (pg == 0)
         @ PRow() + 1, Local1 say "Data emissao: " + DToC(Date())
         @ PRow() + 1, Local1 say "Hora emissao: " + Time()
         @ PRow() + 1, Local1 say "Pagina nr.  : " + strzero(++pg, 3)
         if (Arg2 != Nil)
            @ PRow() + 1, Local1 say "Periodo de  : " + DToC(Arg2) + ;
               " a " + DToC(Arg3)
            @ PRow() + 2,  2 say _xempresa
         endif
         @ PRow() + 1,  2 say nome_rel
         @ PRow() + 1,  2 say Replicate("_", Local1 + iif(Arg2 = ;
            Nil, 20, 31))
         pg:= 2
      endif
   endif
   do case
   case Arg1 = "311"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say ;
         "Codigo   Nome do Cliente                             CGC / CFF" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "312"
      @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_20cpp, "")
   case Arg1 = "315"
      @ PRow() + 2,  0 say iif(xvid_imp = 73, prt->imp_12cpp + ;
         prt->imp_lenfat, "")
      @ PRow() + 1,  3 say ;
         "Codigo  Endereco Local de Entrega                 Bairro                Cidade" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "316A"
      @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_16cpp, "")
   case Arg1 = "316"
      @ PRow() + 2,  0 say iif(xvid_imp = 73, prt->imp_12cpp + ;
         prt->imp_16cpp + prt->imp_enfat, "")
      @ PRow() + 1,  5 say ;
         "Cidade Cliente             Nome Cliente                                     Endereco Cliente                               Bairro Cliente" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "317"
      @ PRow() + 2,  0 say iif(xvid_imp = 73, prt->imp_12cpp + ;
         prt->imp_16cpp + prt->imp_lenfat, "")
      @ PRow() + 1,  5 say ;
         "UF  Cidade Cliente             Nome Cliente                                     Endereco Cliente                               Bairro Cliente" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "321"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say ;
         "Codigo   Nome do Fornecedor                          Nr. CGC " ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "322"
      @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_16cpp, "")
   case Arg1 = "332"
      @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_12cpp + ;
         prt->imp_16cpp, "")
   case Arg1 = "34"
      @ PRow() + 2,  0 say iif(xvid_imp = 73, prt->imp_12cpp, "")
      @ PRow() + 1,  2 say "Banco: " + xnome_ban + "  " + ;
         bancos->nr_agencia + "  " + bancos->nr_conta
      @ PRow(),  9 say xnome_ban
      @ PRow(),  9 say xnome_ban
      @ PRow() + 2,  2 say ;
         "Data      Historico                        Documento  D/C          Valor              Saldo"
      @ PRow(),  2 say ;
         "Data      Historico                        Documento  D/C          Valor              Saldo"
   case Arg1 = "351"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say ;
         "Nome do Contato                         Data"
      @ PRow() + 1, 42 say "Aniversario" + iif(xvid_imp = 73, ;
         prt->imp_denfat, "")
   case Arg1 = "352"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say ;
         "Codigo    Nome do Contato                         Data  de"
      @ PRow() + 1,  2 say ;
         "Cliente                                          Nascimento" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "353"
      @ PRow(), PCol() say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 2,  2 say "Cliente: " + Trim(xnome_cl) + " - (" + ;
         xcod_cl + ")"
      @ PRow() + 3,  2 say ;
         "Nome do Contato                       Data Aniv." + ;
         iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "355"
      @ PRow() + 1,  3 say iif(xvid_imp = 73, prt->imp_12cpp + ;
         prt->imp_16cpp, "")
      @ PRow() + 2,  3 say ;
         "Origem / Destino                          Referencia                                                    Credito  Data  da          Valor da  Moeda da      Indice de     Perc.  de  Data Prov.  Valor Atualizado  Origem  do        Valor   de  Data  da"
      @ PRow() + 1,  3 say ;
         "                                                                                                         Debito  Operacao          Operacao  Operacao      Correcao      Acrescimo  Liquidacao     da Operacao    Emprestimo        Liquidacao  Liquidacao"
   case Arg1 = "361B"
      @ PRow() + 1,  0 say iif(xvid_imp = 73, prt->imp_16cpp, "")
      @ PRow() + 2,  2 say ;
         "Cod.  Nome Fornecedor                           Tipo/Numero Documento     Vencimento              Valor   Complemento/Referencia                    Data  Pag.         Valor Pago    Nr. Cheque"
   case Arg1 = "361"
      @ PRow() + 1,  0 say iif(xvid_imp = 73, prt->imp_16cpp, "")
      @ PRow() + 1,  2 say ;
         "Cod.  Nome Fornecedor                           Tipo/Numero Documento     Vencimento              Valor   Complemento/Referencia"
   case Arg1 = "363"
      select FORNECED
      set order to 1
      seek xcod_fo
      @ PRow() + 2,  2 say "Nome do Fornecedor: " + iif(xvid_imp = ;
         73, prt->imp_lenfat, "") + Trim(nome_fo) + " (" + xcod_fo + ;
         ")" + iif(xvid_imp = 73, prt->imp_denfat, "")
      @ PRow() + 2,  2 say ;
         "Tipo/Numero Documento     Vencimento              Valor   Complemento/Referencia"
   case "365" = Arg1
      @ PRow() + 2,  2 say "Numero da Carga : " + xnr_carga
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_16cpp + ;
         prt->imp_lenfat, "")
      @ PRow() + 1,  4 say ;
         "Quantidade  Unid.  Descricao                                  Codigo      Q.Caixa         Peso"
      @ PRow() + 1,  4 say ;
         "______________________________________________________________________________________________" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case "366" = Arg1
      @ PRow() + 2,  2 say "Entregador : " + tab_tra->descricao + ;
         "  Data Saida: ___/___/___  Odometro Saida : __________  Odometro Retorno : __________ " ;
         + iif(xvid_imp = 73, prt->imp_16cpp + prt->imp_lenfat, "")
      @ PRow() + 2,  2 say ;
         "Cliente                                      Cidade-Estado                Pedido   Vendedor           Total a Receber   Prazo(s)              Desconto        Observacao(es)" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
      @ PRow() + 1,  2 say ;
         "_______________________________________________________________________________________________________________________________________________________________________________________________________________________"
   case "366A1" = Arg1
      @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_20cpp, "")
      @ PRow() + 1,  5 say "Materia Prima.: " + cco_mp + "  " + ;
         mp_r->de_mp + "  " + mp_r->co_unid
      @ PRow() + 2,  5 say ;
         "Setor                                                  Referencia                                    Movimento            Quantidade         Data      "
      @ PRow() + 1,  5 say ;
         "_______________________________________________________________________________________________________________________________________________________"
   case "366A2" = Arg1
      @ PRow(), PCol() + 1 say iif(xvid_imp = 73, prt->imp_20cpp, "")
      @ PRow() + 1,  5 say "Setor.: " + cco_set + "  " + ;
         tab_set->descricao
      @ PRow() + 2,  5 say ;
         "Materia Prima                                          Referencia                                    Movimento           Quantidade          Data      "
      @ PRow() + 1,  5 say ;
         "_______________________________________________________________________________________________________________________________________________________"
   case "368A" = Arg1
      @ PRow() + 1,  0 say iif(xvid_imp = 73, prt->imp_16cpp + ;
         prt->imp_lenfat, "")
      @ PRow() + 1,  3 say "Mes/Ano: " + xmes_ano
      @ PRow() + 2,  3 say ;
         "Cod.Custo   Descricao                          Setor                               Valor" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case "368B" = Arg1
      @ PRow() + 1,  0 say iif(xvid_imp = 73, prt->imp_12cpp + ;
         prt->imp_lenfat, "")
      @ PRow() + 1,  3 say "Descricao Custo: " + xdesc_cust
      @ PRow() + 2,  3 say ;
         "Mes/Ano     Setor                                      Valor" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case "371" = Arg1
      @ PRow() + 1,  0 say iif(xvid_imp = 73, prt->imp_16cpp, "")
      @ PRow() + 2,  3 say ;
         "Cod.     Nome                                        Num.    Data      Data                  Valor                        Valor"
      @ PRow() + 1,  3 say ;
         "Cliente  Cliente                                     Dupl.   Vencim.   Liquid.           Duplicata                     Recebido"
   case "373" = Arg1
      select CLIENTES
      set order to 1
      seek xcod_cl
      @ PRow(), PCol() say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 2,  2 say "Nome do Cliente: " + Trim(nome_cl) + ;
         " (" + xcod_cl + ")"
      @ PRow() + 2,  2 say "Num.    Data                 Valor"
      @ PRow() + 1,  2 say "Dupl.   Vencim.          Duplicata" + ;
         iif(xvid_imp = 73, prt->imp_denfat, "")
   case "373B" = Arg1
      select CLIENTES
      set order to 1
      seek xcod_cl
      @ PRow(), PCol() say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 2,  2 say "Nome do Cliente: " + Trim(nome_cl) + ;
         " (" + xcod_cl + ")"
      @ PRow() + 2,  2 say ;
         "Num.    Data      Data                  Valor              Valor"
      @ PRow() + 1,  2 say ;
         "Dupl.   Vencim.   Liquid.           Duplicata           Recebido" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case "38" = Arg1
      @ PRow() + 2,  0 say iif(xvid_imp = 73, prt->imp_16cpp, "")
      @ PRow() + 1,  5 say "CODIGO  DOCUMENTO   FORNECEDOR / CLIENTE"
      @ PRow(), 82 say "DEBITO"
      @ PRow(), 101 say "CREDITO"
      @ PRow(), 127 say "SALDO"
      @ PRow(),  5 say "CODIGO  DOCUMENTO   FORNECEDOR / CLIENTE"
      @ PRow(), 82 say "DEBITO"
      @ PRow(), 101 say "CREDITO"
      @ PRow(), 127 say "SALDO"
   case Arg1 = "331"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say ;
         "Cod.  Descricao                       Complemento" + ;
         iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "3811"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say "Pedido  Ped.Orig  Dt.Pedido  Fornecedor" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "3812"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat + ;
         prt->imp_12cpp, "")
      @ PRow() + 1,  2 say ;
         "Pedido  Ped.Orig  Dt.Pedido  Fornecedor                           Dt.Rec.MP  Dt.En.NF  Nr.NF" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "3821"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say "Pedido  Ped.Orig  Dt.Pedido   Cliente" + ;
         iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "3822"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat + ;
         prt->imp_12cpp, "")
      @ PRow() + 1,  2 say ;
         "Pedido  Ped.Orig  Dt.Pedido   Cliente                              Dt.Rec.MP  Nr.NF" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "3911"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat + ;
         prt->imp_12cpp, "")
      @ PRow() + 1, 48 say "Estoque    Custo mat.         Valor"
      @ PRow() + 1,  2 say ;
         "Cod.  Descricao do Produto            Un        Atual         Prima       produto" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   case Arg1 = "3921"
      if (xcx2)
         @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat + ;
            prt->imp_16cpp, "")
         @ PRow() + 1,  2 say ;
            "                                                        Estoque       Estoque             Ultimo       Estoque"
         @ PRow() + 1,  2 say ;
            "Cod.  Descricao da Materia Prima                Un        Atual        Minimo              Preco          Real" ;
            + iif(xvid_imp = 73, prt->imp_denfat, "")
      else
         @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat + ;
            prt->imp_12cpp, "")
         @ PRow() + 1,  2 say ;
            "                                                        Estoque       Estoque             Ultimo"
         @ PRow() + 1,  2 say ;
            "Cod.  Descricao da Materia Prima                Un        Atual        Minimo              Preco" ;
            + iif(xvid_imp = 73, prt->imp_denfat, "")
      endif
   case Arg1 = "393"
      @ PRow() + 1,  2 say prt->imp_lenfat
      @ PRow() + 1,  2 say "Descricao do Produto Acabado" + ;
         prt->imp_denfat
   case Arg1 = "394"
      @ PRow() + 1,  2 say iif(xvid_imp = 73, prt->imp_lenfat, "")
      @ PRow() + 1,  2 say ;
         "Data      Produto Acabado                      Un     Producao" ;
         + iif(xvid_imp = 73, prt->imp_denfat, "")
   endcase
   @ PRow() + 1,  1 say " "
   return

********************************
procedure LIN_NAVE2

   local Local1
   Local1:= SetColor()
   set color to 
   @ 23,  0 clear to 24, 79
   setcursor(0)
   set color to (cor[9])
   @ 24,  0 say " ENTER Altera      "
   @ 24, 20 say " F3 Exclui         "
   @ 24, 40 say " F4 Inclui         "
   @ 24, 60 say " ESC Termina       "
   set color to 
   set color to (cor[10])
   @ 24,  1 say "ENTER"
   @ 24, 21 say "F3"
   @ 24, 41 say "F4"
   @ 24, 61 say "ESC"
   set color to (Local1)
   return

********************************
procedure ALFA2(Arg1, Arg2, Arg3, Arg4)

   private a1, a2, a3, a4, a5, a6, a7, b1, b2, b3, b4, b5, b6, b7, ;
      c1, c2, c3, c4, c5, c6, c7
   private d1, d2, d3, d4, d5, d6, d7, e1, e2, e3, e4, e5, e6, e7, ;
      f1, f2, f3, f4, f5, f6, f7
   private g1, g2, g3, g4, g5, g6, g7, h1, h2, h3, h4, h5, h6, h7, ;
      i1, i2, i3, i4, i5, i6, i7
   private j1, j2, j3, j4, j5, j6, j7, k1, k2, k3, k4, k5, k6, k7, ;
      l1, l2, l3, l4, l5, l6, l7
   private m1, m2, m3, m4, m5, m6, m7, n1, n2, n3, n4, n5, n6, n7, ;
      o1, o2, o3, o4, o5, o6, o7
   private p1, p2, p3, p4, p5, p6, p7, q1, q2, q3, q4, q5, q6, q7, ;
      r1, r2, r3, r4, r5, r6, r7
   private s1, s2, s3, s4, s5, s6, s7, t1, t2, t3, t4, t5, t6, t7, ;
      u1, u2, u3, u4, u5, u6, u7
   private v1, v2, v3, v4, v5, v6, v7, w1, w2, w3, w4, w5, w6, w7, ;
      x1, x2, x3, x4, x5, x6, x7
   private y1, y2, y3, y4, y5, y6, y7, z1, z2, z3, z4, z5, z6, z7
   private aa1, aa2, aa3, aa4, aa5, aa6, aa7, ab1, ab2, ab3, ab4, ;
      ab5, ab6, ab7
   private ac1, ac2, ac3, ac4, ac5, ac6, ac7, ad1, ad2, ad3, ad4, ;
      ad5, ad6, ad7
   private _limite, _i, _bunda, _j
   Arg1:= Trim(Arg1)
   _limite:= Len(Arg1)
   Arg4:= iif(Arg4 = Nil, 0, Arg4)
   a1:= ""
   a2:= "߱"
   a3:= ""
   a4:= "߱"
   a5:= "  "
   a6:= "   "
   b1:= ""
   b2:= "߱"
   b3:= ""
   b4:= "߱"
   b5:= ""
   b6:= " "
   c1:= ""
   c2:= ""
   c3:= "     "
   c4:= "     "
   c5:= ""
   c6:= " "
   d1:= ""
   d2:= "߱"
   d3:= "   "
   d4:= "   "
   d5:= ""
   d6:= " "
   e1:= ""
   e2:= ""
   e3:= "  "
   e4:= "  "
   e5:= ""
   e6:= " "
   f1:= ""
   f2:= ""
   f3:= "  "
   f4:= "  "
   f5:= "     "
   f6:= "      "
   g1:= ""
   g2:= ""
   g3:= " "
   g4:= "  "
   g5:= ""
   g6:= " "
   h1:= "  "
   h2:= "  "
   h3:= ""
   h4:= "߱"
   h5:= "  "
   h6:= "   "
   i1:= ""
   i2:= " ߱"
   i3:= "    "
   i4:= "    "
   i5:= ""
   i6:= " "
   j1:= "  "
   j2:= "   ߱"
   j3:= "     "
   j4:= "  "
   j5:= ""
   j6:= " "
   k1:= "  "
   k2:= "  "
   k3:= ""
   k4:= "߱"
   k5:= "  "
   k6:= "   "
   l1:= "     "
   l2:= "     "
   l3:= "     "
   l4:= "     "
   l5:= ""
   l6:= " "
   n1:= "  "
   n2:= " "
   n3:= "۱ܱ"
   n4:= " "
   n5:= "  "
   n6:= "    "
   m1:= "  "
   m2:= "ܱ"
   m3:= ""
   m4:= "۱߱"
   m5:= "  "
   m6:= "    "
   o1:= ""
   o2:= "߱"
   o3:= "  "
   o4:= "  "
   o5:= ""
   o6:= " "
   p1:= ""
   p2:= "߱"
   p3:= ""
   p4:= ""
   p5:= "     "
   p6:= "      "
   q1:= " "
   q2:= "߱ "
   q3:= "  "
   q4:= "  "
   q5:= ""
   q6:= " "
   r1:= ""
   r2:= "߱"
   r3:= ""
   r4:= "  "
   r5:= " "
   r6:= "   "
   s1:= ""
   s2:= ""
   s3:= ""
   s4:= " ߱"
   s5:= ""
   s6:= " "
   t1:= ""
   t2:= "  "
   t3:= "    "
   t4:= "    "
   t5:= "    "
   t6:= "     "
   u1:= "  "
   u2:= "  "
   u3:= "  "
   u4:= "  "
   u5:= ""
   u6:= " "
   v1:= "  "
   v2:= "  "
   v3:= "ܱ"
   v4:= "  "
   v5:= "    "
   v6:= "     "
   w1:= "  "
   w2:= "۱ܱ"
   w3:= ""
   w4:= "۱"
   w5:= " "
   w6:= "   "
   x1:= "  "
   x2:= " ܱ"
   x3:= "   "
   x4:= " ۱ "
   x5:= " "
   x6:= "    "
   y1:= "  "
   y2:= "  "
   y3:= " ܱ"
   y4:= "   "
   y5:= "    "
   y6:= "     "
   z1:= ""
   z2:= " ߱"
   z3:= "  "
   z4:= "  "
   z5:= ""
   z6:= " "
   aa1:= "    "
   aa2:= "   "
   aa3:= "   "
   aa4:= "   "
   aa5:= "   "
   aa6:= "     "
   ab1:= ""
   ab2:= ""
   ab3:= ""
   ab4:= " "
   ab5:= ""
   ab6:= ""
   ac1:= ""
   ac2:= ""
   ac3:= ""
   ac4:= ""
   ac5:= ""
   ac6:= " "
   ad1:= ""
   ad2:= ""
   ad3:= ""
   ad4:= ""
   ad5:= ""
   ad6:= ""
   for _i:= 1 to _limite
      imp_alfa(SubStr(Arg1, _i, 1), Arg2 + Arg4 * _i + Arg4 * -1, ;
         Arg3 + _i * 9 - 9)
   next
   return

********************************
function DIG11R(Arg1)

   local Local1:= 0, Local2:= Len(Arg1), Local3
   for Local3:= 1 to 3
      Local1:= Local1 + Val(SubStr(Arg1, Local3, 1)) * (5 - Local3)
   next
   for Local3:= 4 to 9
      Local1:= Local1 + Val(SubStr(Arg1, Local3, 1)) * (11 - Local3)
   next
   Local3:= 11 - Local1 % 11
   return iif(Local3 < 10, Str(Local3, 1), iif(Local3 = 10, "X", "0"))

********************************
function NEWFILE(Arg1)

   local Local1
   if (Arg1 = Nil)
      Arg1:= "DBF"
   endif
   Local1:= "TEM" + strzero(Seconds(), 5) + "." + Arg1
   do while (file(Local1))
      Local1:= "TEM" + strzero(Seconds(), 5) + "." + Arg1
   enddo
   return Local1

********************************
procedure ALFA6(Arg1, Arg2, Arg3, Arg4)

   private a1, a2, a3, a4, a5, a6, b1, b2, b3, b4, b5, b6, c1, c2, ;
      c3, c4, c5, c6
   private d1, d2, d3, d4, d5, d6, e1, e2, e3, e4, e5, e6, f1, f2, ;
      f3, f4, f5, f6
   private g1, g2, g3, g4, g5, g6, h1, h2, h3, h4, h5, h6, i1, i2, ;
      i3, i4, i5, i6
   private j1, j2, j3, j4, j5, j6, k1, k2, k3, k4, k5, k6, l1, l2, ;
      l3, l4, l5, l6
   private m1, m2, m3, m4, m5, m6, n1, n2, n3, n4, n5, n6, o1, o2, ;
      o3, o4, o5, o6
   private p1, p2, p3, p4, p5, p6, q1, q2, q3, q4, q5, q6, r1, r2, ;
      r3, r4, r5, r6
   private s1, s2, s3, s4, s5, s6, t1, t2, t3, t4, t5, t6, u1, u2, ;
      u3, u4, u5, u6
   private v1, v2, v3, v4, v5, v6, w1, w2, w3, w4, w5, w6, x1, x2, ;
      x3, x4, x5, x6
   private y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6
   private aa1, aa2, aa3, aa4, aa5, aa6, ab1, ab2, ab3, ab4, ab5, ab6
   private ac1, ac2, ac3, ac4, ac5, ac6, ad1, ad2, ad3, ad4, ad5, ad6
   private _limite, _i, _bunda, _j
   Arg1:= Trim(Arg1)
   _limite:= Len(Arg1)
   a1:= "Ŀ"
   a2:= "Ŀ"
   a3:= "ٳ"
   a4:= "Ŀ"
   a5:= "  "
   a6:= "  "
   b1:= "Ŀ"
   b2:= " Ŀ"
   b3:= " ٳ"
   b4:= " Ŀ"
   b5:= " ٳ"
   b6:= ""
   c1:= "Ŀ"
   c2:= ""
   c3:= "    "
   c4:= "    "
   c5:= "Ŀ"
   c6:= ""
   d1:= "Ŀ"
   d2:= " Ŀ"
   d3:= "  "
   d4:= "  "
   d5:= " ٳ"
   d6:= ""
   e1:= "Ŀ"
   e2:= ""
   e3:= "Ŀ  "
   e4:= "  "
   e5:= "Ŀ"
   e6:= ""
   f1:= "Ŀ"
   f2:= ""
   f3:= "Ŀ  "
   f4:= "  "
   f5:= "    "
   f6:= "    "
   g1:= "Ŀ"
   g2:= ""
   g3:= " Ŀ"
   g4:= " "
   g5:= "ٳ"
   g6:= ""
   h1:= "ڿ  ڿ"
   h2:= "  "
   h3:= "ٳ"
   h4:= "Ŀ"
   h5:= "  "
   h6:= "  "
   i1:= "Ŀ"
   i2:= "Ŀ"
   i3:= "    "
   i4:= "    "
   i5:= "Ŀ"
   i6:= ""
   j1:= "  Ŀ"
   j2:= "  Ŀ"
   j3:= "    "
   j4:= "ڿ  "
   j5:= "ٳ"
   j6:= ""
   k1:= "ڿ Ŀ"
   k2:= ""
   k3:= " "
   k4:= "ڿ "
   k5:= ""
   k6:= " "
   l1:= "ڿ    "
   l2:= "    "
   l3:= "    "
   l4:= "    "
   l5:= "Ŀ"
   l6:= ""
   m1:= "Ŀ"
   m2:= "ڿڿ"
   m3:= ""
   m4:= "ٳ"
   m5:= "  "
   m6:= "  "
   n1:= "Ŀڿ"
   n2:= "ڿ"
   n3:= ""
   n4:= ""
   n5:= "ٳ"
   n6:= ""
   o1:= "Ŀ"
   o2:= "Ŀ"
   o3:= "  "
   o4:= "  "
   o5:= "ٳ"
   o6:= ""
   p1:= "Ŀ"
   p2:= "Ŀ"
   p3:= "ٳ"
   p4:= ""
   p5:= "    "
   p6:= "    "
   q1:= "Ŀ"
   q2:= "Ŀ"
   q3:= "  "
   q4:= " ٳ"
   q5:= " "
   q6:= ""
   r1:= "Ŀ"
   r2:= "Ŀ"
   r3:= "ٳ"
   r4:= "Ŀ"
   r5:= " "
   r6:= " "
   s1:= "Ŀ"
   s2:= ""
   s3:= "Ŀ"
   s4:= "Ŀ"
   s5:= "ٳ"
   s6:= ""
   t1:= "Ŀ"
   t2:= "Ŀ"
   t3:= "    "
   t4:= "    "
   t5:= "    "
   t6:= "    "
   u1:= "ڿ  ڿ"
   u2:= "  "
   u3:= "  "
   u4:= "  "
   u5:= "ٳ"
   u6:= ""
   v1:= "ڿ  ڿ"
   v2:= "  "
   v3:= "ٳ"
   v4:= ""
   v5:= "  "
   v6:= "    "
   w1:= "ڿ  ڿ"
   w2:= "  "
   w3:= "ڿ"
   w4:= ""
   w5:= "ٳ"
   w6:= ""
   x1:= "ڿ  ڿ"
   x2:= "ٳ"
   x3:= ""
   x4:= "ڿ"
   x5:= ""
   x6:= "  "
   y1:= "ڿ  ڿ"
   y2:= "  "
   y3:= "ٳ"
   y4:= "Ŀ"
   y5:= "    "
   y6:= "    "
   z1:= "Ŀ"
   z2:= "Ŀ"
   z3:= " ٳ "
   z4:= "  "
   z5:= "Ŀ"
   z6:= ""
   aa1:= "   Ŀ"
   aa2:= "   "
   aa3:= " ٳ "
   aa4:= "  "
   aa5:= "ٳ   "
   aa6:= "   "
   ab1:= ""
   ab2:= ""
   ab3:= "Ŀ"
   ab4:= ""
   ab5:= ""
   ab6:= ""
   ac1:= ""
   ac2:= ""
   ac3:= ""
   ac4:= ""
   ac5:= "Ŀ  "
   ac6:= "  "
   ad1:= ""
   ad2:= ""
   ad3:= ""
   ad4:= ""
   ad5:= ""
   ad6:= ""
   for _i:= 1 to _limite
      imp_alfa(SubStr(Arg1, _i, 1), Arg2 + Arg4 * _i + Arg4 * -1, ;
         Arg3 + _i * 7 - 7)
   next
   return

********************************
function WHEN250(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9, Local10, Local11, Local12
   Local12:= "C"
   if (PCount() < 3)
      return ""
   endif
   Local6:= .F.
   Local7:= SetColor()
   Local4:= iif(Arg4 != Nil, setacor(Arg4), iif(Arg5 != Nil, ;
      setacor(Arg5), SetColor()))
   Local5:= iif(Arg5 != Nil, setacor(Arg5), setacor(Arg4))
   Arg1:= iif(Arg6 != Nil, pad250(Arg1, Arg6, iif(Local12 != Nil, ;
      iif(Local12 $ "LlRrCc", Upper(Local12), "R"), "R")), Arg1)
   if (SubStr(Arg1, 1, 1) == "")
      Arg1:= SubStr(Arg1, 1)
      set color to (Local5)
   else
      set color to (Local4)
   endif
   SetPos(Arg2, Arg3)
   do while (.T.)
      Local2:= At("", Arg1)
      if (Local2 == 0)
         @ Row(), Col() say SubStr(Arg1, 1)
         exit
      else
         @ Row(), Col() say SubStr(Arg1, 1, Local2 - 1)
         Arg1:= SubStr(Arg1, Local2 + 1)
         set color to (iif(SetColor() = Local4, Local5, Local4))
      endif
   enddo
   set color to (Local7)
   return

********************************
static function PAD250(Arg1, Arg2, Arg3)

   local Local1:= 0, Local2, Local3:= Len(Arg1)
   if (Len(Arg3) = 1 .AND. Upper(Arg3) $ "CLR")
      for Local2:= 1 to Local3
         if (SubStr(Arg1, Local2, 1) = "")
            Local1++
         endif
      next
   endif
   if (Upper(Arg3) = "C")
      return padc(Arg1, Arg2 + Local1)
   elseif (Upper(Arg3) = "L")
      return padl(Arg1, Arg2 + Local1)
   elseif (Upper(Arg3) = "R")
      return padr(Arg1, Arg2 + Local1)
   endif
   return Nil

********************************
procedure RESTSCR(Arg1)

   RestScreen(Val(SubStr(Arg1, 1, 2)), Val(SubStr(Arg1, 3, 2)), ;
      Val(SubStr(Arg1, 5, 2)), Val(SubStr(Arg1, 7, 2)), SubStr(Arg1, ;
      9))
   return

********************************
function READINSERT(Arg1)

   return Set(_SET_INSERT, Arg1)

********************************
function CPF

   local Local1[11]
   parameters xcpf
   private xi, xdv1, xdv2, xsaida
   xsaida:= .F.
   for xi:= 1 to 11
      Local1[xi]:= Val(SubStr(xcpf, xi, 1))
   next
   xdv1:= 0
   for xi:= 1 to 9
      xdv1:= xdv1 + (11 - xi) * Local1[xi]
   next
   xdv1:= xdv1 - Int(xdv1 / 11) * 11
   if (xdv1 <= 1)
      xdv1:= 0
   else
      xdv1:= 11 - xdv1
   endif
   xdv2:= 2 * xdv1
   for xi:= 1 to 9
      xdv2:= xdv2 + (12 - xi) * Local1[xi]
   next
   xdv2:= xdv2 - Int(xdv2 / 11) * 11
   if (xdv2 <= 1)
      xdv2:= 0
   else
      xdv2:= 11 - xdv2
   endif
   if (LTrim(Str(xdv1)) + LTrim(Str(xdv2)) = LTrim(Str(Local1[10])) ;
         + LTrim(Str(Local1[11])))
      xsaida:= .T.
   endif
   return xsaida

********************************
function MES_EXT

   parameters mes, tipo
   private tab_mes
   tab_mes:= ;
      "janeiro   fevereiro marco     abril     maio      junho     julho     agosto    setembro  outubro   novembro  dezembro"
   if (PCount() = 0 .OR. PCount() > 2 .OR. mes < 1 .OR. mes > 12)
      return "Erro na passagem de parametro na funcao MES_EXT."
   endif
   if (PCount() < 2)
      return Trim(Upper(SubStr(tab_mes, mes * 10 - 9, 10)))
   elseif (tipo = 1)
      return Upper(SubStr(tab_mes, mes * 10 - 9, 1)) + ;
         Trim(SubStr(tab_mes, mes * 10 - 8, 9))
   elseif (tipo = 2)
      return Trim(SubStr(tab_mes, mes * 10 - 9, 10))
   else
      return Trim(Upper(SubStr(tab_mes, mes * 10 - 9, 10)))
   endif

********************************
function ADDREC(Arg1)

   local Local1, Local2
   Local2:= .T.
   append blank
   if (!neterr())
      return .T.
   endif
   Local1:= (Arg1:= iif(ISNIL(Arg1), 0, Arg1)) == 0
   do while ((Local1 .OR. Arg1 > 0) .AND. Local2)
      append blank
      if (!neterr())
         return .T.
      endif
      Local2:= InKey(0.5) != K_ESC
      Arg1:= Arg1 - 0.5
   enddo
   mostrauser(alias())
   return .F.

********************************
function __TCARGO

   return qself()[1]

********************************
function VALOR_EXT

   parameters a__xv
   private a__xd, tab100, tab010, tab020, tab001
   a__xd:= Space(0)
   tab100:= ;
      "CENTO       DUZENTOS    TREZENTOS   QUATROCENTOSQUINHENTOS  SEISCENTOS  SETECENTOS  OITOCENTOS  NOVECENTOS"
   tab010:= ;
      "            VINTE       TRINTA      QUARENTA    CINQUENTA   SESSENTA    SETENTA     OITENTA     NOVENTA"
   tab020:= ;
      "ONZE        DOZE        TREZE       QUATORZE    QUINZE      DEZESEIS    DEZESSETE   DEZOITO     DEZENOVE"
   tab001:= ;
      "HUM         DOIS        TREIS       QUATRO      CINCO       SEIS        SETE        OITO        NOVE"
   if (a__xv > 99)
      if (a__xv == 100)
         return "CEM"
      else
         a__xd:= Trim(SubStr(tab100, Int(a__xv / 100) * 12 - 11, 12))
      endif
   endif
   a__xv:= a__xv - Int(a__xv / 100) * 100
   if (a__xv > 9)
      if (!Empty(a__xd))
         a__xd:= a__xd + " E "
      endif
      if (a__xv == 10)
         return a__xd + "DEZ"
      elseif (a__xv < 20)
         a__xd:= a__xd + Trim(SubStr(tab020, Int(a__xv - 10) * 12 - ;
            11, 12))
         return a__xd
      else
         a__xd:= a__xd + Trim(SubStr(tab010, Int(a__xv / 10) * 12 - ;
            11, 12))
      endif
   endif
   a__xv:= a__xv - Int(a__xv / 10) * 10
   if (a__xv > 0)
      if (!Empty(a__xd))
         a__xd:= a__xd + " E "
      endif
      a__xd:= a__xd + Trim(SubStr(tab001, Int(a__xv) * 12 - 11, 12))
   endif
   return a__xd

********************************
function FILLOCK(Arg1)

   local Local1, Local2
   Local2:= .T.
   if (FLock())
      return .T.
   endif
   Local1:= (Arg1:= iif(ISNIL(Arg1), 0, Arg1)) == 0
   do while ((Local1 .OR. Arg1 > 0) .AND. Local2)
      Local2:= InKey(0.5) != K_ESC
      Arg1:= Arg1 - 0.5
      if (FLock())
         return .T.
      endif
   enddo
   mostrauser(alias())
   return .F.

********************************
procedure FUNC0027


********************************
function NETUSE(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7)

   local Local1, Local2, Local3
   Local2:= .T.
   Arg3:= iif(ISNIL(Arg3), .F., Upper(Arg3) == "E")
   Arg2:= iif(ISNIL(Arg2), namealias(Arg1), Arg2)
   Arg4:= iif(ISNIL(Arg4), .F., Upper(Arg4) == "NEW")
   Arg6:= iif(ISNIL(Arg6), .F., Upper(Arg6) == "RO")
   Arg7:= iif(ISNIL(Arg7), .T., .F.)
   Local1:= (Arg5:= iif(ISNIL(Arg5), 0, Arg5)) == 0
   do while ((Local1 .OR. Arg5 > 0) .AND. Local2)
      use (Arg1) alias (Arg2) exclusive
      if (!neterr())
         if (Arg7)
            writeuser(Arg1, Arg2)
         endif
         return .T.
      endif
      Local2:= InKey(1) != K_ESC
      Arg5:= Arg5 - 1
   enddo
   if (namedbf(Arg1) = "SHARED.SYS" .AND. !Arg3)
      tone(800, 5)
      tone(230, 3)
      tone(800, 5)
      Scroll(11, 8, 18, 71)
      @ 11,  8 to 18, 71 double
      @ 12, 10 say padc("ATENCAO", 60)
      @ 13, 10 say ;
         padc("Sr(a). Usuario(a), nao foi possivel acessar o arquivo", ;
         60)
      @ 14, 10 say ;
         padc("de controle da rede, aguarde 2 minutos e tente", 60)
      @ 15, 10 say padc("acessar o sistema novamente.", 60)
      @ 17, 10 say ;
         padc("Pressione qualquer tecla para cancelar o programa", 60)
      setcursor(0)
      InKey(0)
      setcursor(1)
      quit
   elseif (namedbf(Arg1) != "SHARED.SYS")
      mostrauser(namedbf(Arg1), "FILE")
   endif
   return .F.

********************************
static function NAMEDBF(Arg1)

   local Local1
   Arg1:= SubStr(Arg1, iif((Local1:= rat("\", Arg1)) == 0, 1, Local1 ;
      + 1))
   Arg1:= SubStr(Arg1, iif((Local1:= rat(":", Arg1)) == 0, 1, Local1 ;
      + 1))
   return Arg1

********************************
function __TSETSKIP(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[11]:= _einstvar(qself(), "SKIPBLOCK", Arg1, "B", 1001)
   endif
   return qself()[11]

********************************
static procedure WRITEUSER(Arg1, Arg2)

   local Local1
   Local1:= alias()
   Arg1:= namedbf(Arg1)
   if (Select("CLAN") == 0)
      abreclan()
   endif
   select CLAN
   if (addrec(5))
      replace clan->hardware with config[1]
      replace clan->user with config[2]
      replace clan->database with Upper(Arg1)
      replace clan->alias with Upper(Arg2)
      replace clan->system with config[3]
      replace clan->date with DToC(Date())
      replace clan->time with Time()
      unlock
   else
   endif
   select (Local1)
   return

********************************
procedure CLOSEDATA(Arg1)

   local Local1
   Local1:= alias()
   Arg1:= Upper(iif(ISNIL(Arg1), alias(), Arg1))
   if (Arg1 == "ALL")
      select CLAN
      set order to 3
      seek config[1]
      do while (Trim(clan->hardware) == Trim(config[1]))
         Arg1:= clan->alias
         if (reclock(2))
            delete
            unlock
         else
         endif
         if (Select(Arg1) != 0)
            if (Arg1 != "CLAN")
               select (Arg1)
               close
            endif
         endif
         select CLAN
         skip 
      enddo
   else
      select CLAN
      set order to 1
      seek padr(Arg1, 8) + config[1]
      if (Found())
         if (reclock(2))
            delete
            unlock
         else
         endif
      else
      endif
      if (Select(Arg1) != 0)
         select (Arg1)
         close
      endif
   endif
   if (Select(Local1) != 0)
      select (Local1)
   endif
   return

********************************
static function NAMEALIAS(Arg1)

   local Local1
   Arg1:= SubStr(Arg1, iif((Local1:= rat("\", Arg1)) == 0, 1, Local1 ;
      + 1))
   Arg1:= SubStr(Arg1, iif((Local1:= rat(":", Arg1)) == 0, 1, Local1 ;
      + 1))
   Arg1:= SubStr(Arg1, 1, iif((Local1:= rat(".", Arg1)) == 0, ;
      Len(Arg1), Local1 - 1))
   return Arg1

********************************
static function PAD250(Arg1, Arg2, Arg3)

   local Local1:= 0, Local2, Local3:= Len(Arg1)
   if (Len(Arg3) = 1 .AND. Upper(Arg3) $ "CLR")
      for Local2:= 1 to Local3
         if (SubStr(Arg1, Local2, 1) = "")
            Local1++
         endif
      next
   endif
   if (Upper(Arg3) = "C")
      return padc(Arg1, Arg2 + Local1)
   elseif (Upper(Arg3) = "L")
      return padl(Arg1, Arg2 + Local1)
   elseif (Upper(Arg3) = "R")
      return padr(Arg1, Arg2 + Local1)
   endif
   return Nil

********************************
procedure MOSTRAUSER(Arg1, Arg2)

   local Local1:= alias(), Local2, Local3, Local4, Local5, Local6:= ;
      SaveScreen(7, 0, 24, 79)
   if (Select("CLAN") == 0)
      abreclan()
   endif
   Local5:= SetColor("n/w")
   Local4:= setcursor(0)
   Arg2:= iif(ISNIL(Arg2), .F., .T.)
   select CLAN
   Arg1:= Upper(Arg1)
   if (!Arg2)
      set order to 1
      seek padr(Local1, 8) + config[1]
      Arg1:= clan->database
   endif
   set order to 2
   seek Arg1
   if (Found())
      tone(880, 5)
      tone(300, 4)
      tone(880, 5)
      @  8,  4 say padc("ATENCAO", 71)
      @  9,  4 say ;
         padc("Os usuarios abaixo estao usando os arquivos", 71)
      @ 10,  4 say padc("necessarios para esta operacao.", 71)
      @ 11,  4 say Space(71)
      @ 12,  4 say ;
         "  Estacao          Usuario               Sistema     Data      Hora    "
      @ 13,  4 to 13, 74
      Local3:= 13
      do while (clan->database = Arg1)
         @ ++Local3,  4 say "  " + clan->hardware + "  " + ;
            clan->user + "  " + clan->system + "  " + clan->date + ;
            "  " + clan->time + "  "
         skip 
      enddo
      @ ++Local3,  4 to Local3, 74
      @ ++Local3,  4 say ;
         padc("Pressione qualquer tecla p/ cancelar a operacao", 71)
      @  7,  4 to ++Local3, 74 double
      InKey(0)
   endif
   RestScreen(7, 0, 24, 79, Local6)
   if (Select(Local1) != 0)
      select (Local1)
   endif
   set color to (Local5)
   setcursor(Local4)
   return

********************************
procedure CLOSEALL

   local Local1, Local2, Local3
   for Local1:= 1 to 255
      Local2:= alias(Local1)
      if ("" != Local2 .AND. Local2 != "CLAN")
         closedata(Local2)
      endif
   next
   return

********************************
procedure ABRECLAN

   private cfileind1:= config[6] + "SHARED.SX1", cfileind2:= ;
      config[6] + "SHARED.SX2", cfileind3:= config[6] + "SHARED.SX3"
   if (netuse(config[6] + "SHARED.SYS", "CLAN", "E", "NEW", 3, "RW", ;
         .F.))
      zap
      index on CLAN->alias + CLAN->hardware to (cfileind1)
      index on CLAN->database to (cfileind2)
      index on CLAN->hardware to (cfileind3)
      close
   endif
   netuse(config[6] + "SHARED.SYS", "CLAN", "S", "NEW", 15, "RW", .F.)
   set index to (cfileind1), (cfileind2), (cfileind3)
   return

********************************
procedure READCOR(Arg1)

   local Local1, Local2, Local3:= "", Local4, Local5:= iif(config[8] ;
      != Nil, config[8], "") + "cores.cf_"
   if ((Local1:= fopen(Local5, 0)) == -1)
      afill(Arg1, SetColor(), 1, 12)
      Arg1[13]:= 128
      afill(Arg1, SetColor(), 14, 6)
      Arg1[20]:= ""
      writecor(@Arg1)
   else
      Local2:= fseek(Local1, 0, 2)
      Local3:= Space(Local2)
      fseek(Local1, 0, 0)
      fread(Local1, @Local3, Local2)
      fclose(Local1)
      for Local4:= 1 to 12
         Arg1[Local4]:= SubStr(Local3, 1, At("", Local3) - 1)
         Local3:= SubStr(Local3, At("", Local3) + 1)
      next
      Arg1[13]:= Val(SubStr(Local3, 1, 3))
      Local3:= SubStr(Local3, At("", Local3) + 1)
      for Local4:= 14 to 19
         Arg1[Local4]:= SubStr(Local3, 1, At("", Local3) - 1)
         Local3:= SubStr(Local3, At("", Local3) + 1)
      next
      Arg1[20]:= Local3
   endif

********************************
function CHOICEPANO(Arg1, Arg2, Arg3)

   set color to (cor[12])
   @ 19, 56 say Replicate(SubStr(carpano[Arg2], 8, 1), 16)
   @ 20, 56 say Replicate(SubStr(carpano[Arg2], 8, 1), 16)
   set color to (cor[1])
   if (LastKey() = K_ESC)
      return 0
   elseif (LastKey() = K_ENTER)
      return 1
   else
      return 2
   endif

********************************
function MS250(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9)

   private msg_tams, msg_ind, msg_byte, msg_cor_n, msg_cor_s, ;
      msg_cor, msg_setcol, msg_reduca, msg_tabela, msg_qtecla, tela
   if (Arg1 != Nil)
      tela:= SaveScreen(Arg2, Arg3, Arg2, 79)
      if (PCount() < 3)
         return ""
      endif
      msg_cor:= .F.
      msg_setcol:= SetColor()
      msg_cor_n:= iif(Arg4 != Nil, setacor(Arg4), iif(Arg5 != Nil, ;
         setacor(Arg5), SetColor()))
      msg_cor_s:= iif(Arg5 != Nil, setacor(Arg5), setacor(Arg4))
      Arg1:= iif(Arg8 != Nil, pad250(Arg1, Arg8, iif(Arg9 != Nil, ;
         iif(Arg9 $ "LlRrCc", Upper(Arg9), "R"), "R")), Arg1)
      msg_tabela:= Space(0)
      set color to (msg_cor_n)
      msg_tams:= Len(Arg1)
      msg_reduca:= 1
      msg_ind:= 0
      do while (msg_ind++ <= msg_tams)
         msg_byte:= SubStr(Arg1, msg_ind, 1)
         if (msg_byte = "")
            set color to (iif(SetColor() = msg_cor_n, msg_cor_s, ;
               msg_cor_n))
            msg_reduca:= msg_reduca + 1
            loop
         endif
         if (SetColor() = msg_cor_s)
            msg_tabela:= msg_tabela + Upper(msg_byte)
         endif
         @ Arg2, Arg3 - msg_reduca + msg_ind say msg_byte
      enddo
   endif
   if (Arg6 != Nil)
      msg_qtecla:= Len(Arg6)
      if (msg_qtecla > 1)
         msg_tabela:= ""
         for msg_ind:= 1 to msg_qtecla
            msg_tabela:= msg_tabela + Upper(Chr(Arg6[msg_ind]))
         next
         do while (!(Upper(Chr(InKey(0))) $ msg_tabela))
         enddo
      else
         if (Arg4 == cor[6])
            tone(800, 4)
            tone(1500, 2)
         endif
         if (Arg6[1] = 0 .AND. Arg7 = Nil)
            do while (!(Upper(Chr(InKey(0))) $ msg_tabela))
            enddo
         elseif (Arg7 != Nil)
            InKey(Arg6[1])
         else
            do while (InKey(0) != Arg6[1])
            enddo
         endif
      endif
      if (Arg1 != Nil)
         RestScreen(Arg2, Arg3, Arg2, 79, tela)
      endif
   endif
   set color to (msg_setcol)
   if (LastKey() < 0)
      return LastKey()
   else
      return Asc(Upper(Chr(LastKey())))
   endif

********************************
static function CALC_COR(Arg1)

   local Local1:= Len(Arg1), Local2, Local3:= 0
   for Local2:= 1 to Local1
      Local3:= Local3 + iif(SubStr(Arg1, Local2, 1) == "1", 2 ^ ;
         (Local2 - 1), 0)
   next
   return Local3

********************************
function HD_TO_HH(Arg1, Arg2)

   local Local1, Local2
   Local1:= Int(Arg1)
   Local2:= Arg1 - Local1
   return iif(ISNIL(Arg2), strzero(Local1, 2), Str(Local1, Arg2)) + ;
      ":" + strzero(Local2 * 60, 2)

********************************
function __GETHASFO

   return Len(qself()) == 13

********************************
procedure CTRL_COR

   local Local1, Local2, Local3, Local4, Local5
   private op_cor, opc_cor, cop_cor
   mold:= "Ŀ"
   tb:= {{"N", 0, "N"}, {"B", 1, "B"}, {"G", 2, "G"}, {"BG", 3, ;
      "BG"}, {"R", 4, "R"}, {"RB", 5, "RB"}, {"GR", 6, "GR"}, {"W", ;
      7, "W"}, {"N+", 8, "N*"}, {"B+", 9, "B*"}, {"G+", 10, "G*"}, ;
      {"BG+", 11, "BG*"}, {"R+", 12, "R*"}, {"RB+", 13, "rb*"}, ;
      {"GR+", 14, "GR*"}, {"W+", 15, "W*"}}
   Local4:= SaveScreen(0, 0, 24, 79)
   Local5:= SaveScreen(4, 55, 21, 79)
   setcursor(0)
   set color to bg+/n
   @  4,  0, 21, 50 box "Ŀ "
   for t:= 0 to 15
      for i:= 0 to 15
         cor_cor:= Str(i, 2) + "/" + Str(t, 2)
         set color to (cor_cor)
         @ 5 + i, 2 + t * 3 say Str(i, 2)
      next
   next
   impcur:= {|_1| (SetPos((SetPos((pos:= 3 + Local2 * 3, 5 + ;
      Local1), pos - 2), QQOut(iif(_1, " ", " ")), 5 + Local1), pos ;
      + 1), QQOut(iif(_1, " ", " ")))}
   op_cor:= 1
   do while (.T.)
      set color to (cor[8])
      msg:= {"       Cor Padrao      ", "    Padrao Destacada   ", ;
         "   Digitacao Corrente  ", "   Digitacao Pendente  ", ;
         "    Mensagem de Aviso  ", " Mens. Aviso Destacada ", ;
         "    Mensagem de Erro   ", "  Mens. Erro Destacada ", ;
         "  Opcoes Menu Vertical ", "     Opcao Corrente    ", ;
         "  Opcoes Menu de Barra ", " Opcao Corrente  Barra ", ;
         "    Janela Superior    ", "  Cor do Pano de Fundo ", ;
         "     Cor da Sombra     ", "     Opcoes Menu 1     ", ;
         " Destaq. Opcoes Menu 1 ", "      Barra Menu 1     ", ;
         " Destaq. Barra Menu 1  ", "     Opcoes Menu 2     ", ;
         " Destaq. Opcoes Menu 2 ", "      Barra Menu 2     ", ;
         " Destaq. Barra Menu 2  ", "     Help de Dados     ", ;
         "  Barra Help de Dados  ", "     Help de Texto     ", ;
         "  Setas Help de Texto  ", "     Pano de Fundo     "}
      @  4, 55, 21, 79 box "ĕӺ"
      op_cor:= achoice(5, 56, 20, 78, msg, Nil, Nil, op_cor)
      do case
      case op_cor == 0
         exit
      case op_cor < 4
         opc_cor:= op_cor
      case op_cor < 10
         opc_cor:= op_cor - 1
      case op_cor < 17
         opc_cor:= op_cor - 2
      case op_cor < 19
         opc_cor:= op_cor - 3
      case op_cor < 21
         opc_cor:= op_cor - 4
      case op_cor < 23
         opc_cor:= op_cor - 5
      case op_cor < 25
         opc_cor:= op_cor - 6
      case op_cor < 27
         opc_cor:= op_cor - 7
      otherwise
         opc_cor:= op_cor - 8
      endcase
      RestScreen(4, 55, 21, 79, Local5)
      cop_cor:= strzero(op_cor, 2)
      if (cop_cor $ ;
            "01/02/05/06/07/08/09/11/12/13/14/16/18/20/22/24/26")
         cormodif:= SubStr(cor[opc_cor], 1, At(",", cor[opc_cor]) - 1)
      elseif (cop_cor $ "03/10/17/19/21/23/25/27")
         cormodif:= SubStr(SubStr(cor[opc_cor], At(",", ;
            cor[opc_cor]) + 1), 1, At(",", SubStr(cor[opc_cor], ;
            At(",", cor[opc_cor]) + 1)) - 1)
      elseif (cop_cor = "04")
         cormodif:= SubStr(cor[opc_cor], rat(",", cor[opc_cor]) + 1)
      else
         cormodif:= cor[opc_cor]
      endif
      if (op_cor < 15 .OR. op_cor > 15 .AND. op_cor < 28)
         Local1:= Left(cormodif, At("/", cormodif) - 1)
         Local2:= right(cormodif, Len(cormodif) - At("/", cormodif))
         Local1:= tb[ascan(tb, {|_1| Local1 == _1[1]})][2]
         Local2:= tb[ascan(tb, {|_1| Local2 == _1[3]})][2]
      elseif (op_cor == 15)
         corbin:= dectobin(cor[opc_cor])
         Local1:= calc_cor(Trim(SubStr(corbin, 1, 4)))
         Local2:= calc_cor(SubStr(corbin, 5))
      else
         RestScreen(4, 55, 21, 79, Local5)
         set color to (cor[1])
         Scroll(4, 55, 21, 72)
         carpano:= array(119)
         for ind:= 1 to 31
            carpano[ind]:= "       " + Chr(ind) + "       "
         next
         for ind:= 32 to 118
            carpano[ind]:= "       " + Chr(ind + 137) + "       "
         next
         op_pano:= ascan(carpano, "       " + cor[20] + "       ")
         @  4, 55, 17, 72 box "ĕӺ"
         @ 18, 55, 21, 72 box "ͻȺ"
         @  6, 56,  6, 71 box "Ŀ"
         @  5, 56 say " Pano de  Fundo "
         @ 19, 56 say Replicate(cor[20], 16)
         @ 20, 56 say Replicate(cor[20], 16)
         op_pano:= achoice(7, 56, 16, 71, carpano, Nil, ;
            "ChoicePano", op_pano)
         if (LastKey() == K_ENTER)
            cor[20]:= SubStr(carpano[op_pano], 8, 1)
         endif
         loop
      endif
      tela_cor:= SaveScreen(0, 0, 24, 79)
      cormodifan:= cor[opc_cor]
      do while (.T.)
         if (op_cor == 15)
            set color to (cor[1])
            for ind:= 8 to 18
               @ ind, 53 say cor[20] + cor[20]
            next
            for ind:= 17 to 18
               @ ind, 53 say Replicate(cor[20], 27)
            next
            fundoparas:= Replicate(cor[20] + Chr(Local1 + Local2 * ;
               16), 8)
            RestScreen(9, 54, 16, 54, fundoparas)
            fundoparas:= Replicate(cor[20] + Chr(Local1 + Local2 * ;
               16), 25)
            RestScreen(17, 54, 17, 78, fundoparas)
            cormodif:= cor[1]
         else
            if (cop_cor $ "03/10/17/19/21/23/25/27")
               cormodif:= SubStr(SubStr(cor[opc_cor], At(",", ;
                  cor[opc_cor]) + 1), 1, At(",", ;
                  SubStr(cor[opc_cor], At(",", cor[opc_cor]) + 1)) - ;
                  1)
            elseif (cop_cor = "04")
               cormodif:= SubStr(cor[opc_cor], rat(",", ;
                  cor[opc_cor]) + 1)
            else
               cormodif:= cor[opc_cor]
            endif
            set color to (cormodif)
         endif
         @  8, 55, 16, 79 box "Ŀ"
         @ 11, 56 say Replicate("", 23)
         @ 12, 56 say Space(23)
         @ 13, 56 say padc("  e   muda frente", 23)
         @ 14, 56 say padc("ENTER aceita esquema", 23)
         @ 15, 56 say padc("ESC para terminar", 23)
         if (cop_cor $ "01/03/04/05/07/09/10/11/13/14/15")
            @ 12, 56 say padc("  e " + Chr(26) + " muda fundo", 23)
         endif
         if (strzero(Local2, 2) $ "03/10/11/14/15")
            set color to ("R" + SubStr(cormodif, At("/", cormodif)))
         else
            set color to ("GR+" + SubStr(cormodif, At("/", cormodif)))
         endif
         @  9, 56 say padc("EXEMPLO DO ESQUEMA", 23)
         @ 10, 56 say padc("SELECIONADO", 23)
         set color to GR+/N
         eval(impcur, .T.)
         tec:= InKey(0)
         eval(impcur, .F.)
         do case
         case tec = 27
            cor[opc_cor]:= cormodifan
            exit
         case tec = 13
            exit
         case tec = 24
            Local1:= iif(Local1 < 15, Local1 + 1, 0)
         case tec = 5
            Local1:= iif(Local1 > 0, Local1 - 1, 15)
         case tec = 19 .AND. !(cop_cor $ "02/06/08/12")
            Local2:= iif(Local2 > 0, Local2 - 1, 15)
         case tec = 4 .AND. !(cop_cor $ "02/06/08/12")
            Local2:= iif(Local2 < 15, Local2 + 1, 0)
         case tec = 28
            eval(SetKey(K_F1))
         endcase
         do case
         case cop_cor = "15"
            cor[13]:= Local1 + Local2 * 16
         case cop_cor $ "01"
            cor[1]:= tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" ;
               + tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[1], At(",", cor[1]))
            cor[2]:= Left(cor[2], At("/", cor[2])) + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[1], At(",", cor[1]))
            cor[3]:= tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" ;
               + tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[3], At(",", cor[3]))
         case cop_cor $ "05/07/11"
            cor[opc_cor]:= tb[ascan(tb, {|_1| Local1 == _1[2]})][1] ;
               + "/" + tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
            cor[opc_cor + 1]:= Left(cor[opc_cor + 1], At("/", ;
               cor[opc_cor + 1])) + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
         case cop_cor $ "09/13/14/24"
            cor[opc_cor]:= tb[ascan(tb, {|_1| Local1 == _1[2]})][1] ;
               + "/" + tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
         case cop_cor $ "02/06/08/12"
            cor[opc_cor]:= tb[ascan(tb, {|_1| Local1 == _1[2]})][1] ;
               + SubStr(cor[opc_cor], At("/", cor[opc_cor]))
         case cop_cor $ "16/18/20/22/26"
            cor[opc_cor]:= tb[ascan(tb, {|_1| Local1 == _1[2]})][1] ;
               + "/" + tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
            cormodif:= SubStr(cor[opc_cor], 1, At(",", cor[opc_cor]) ;
               - 1)
            cor[opc_cor]:= SubStr(cor[opc_cor], At(",", ;
               cor[opc_cor]) + 1)
            cor[opc_cor]:= cormodif + "," + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
         case cop_cor $ "10/17/19/21/23/25/27"
            cormodif:= SubStr(cor[opc_cor], 1, At(",", cor[opc_cor]) ;
               - 1)
            cor[opc_cor]:= SubStr(cor[opc_cor], At(",", ;
               cor[opc_cor]) + 1)
            cor[opc_cor]:= cormodif + "," + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
         case cop_cor $ "03"
            cormodif:= SubStr(cor[opc_cor], 1, At(",", cor[opc_cor]) ;
               - 1)
            cor[opc_cor]:= SubStr(cor[opc_cor], At(",", ;
               cor[opc_cor]) + 1)
            cor[opc_cor]:= cormodif + "," + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[opc_cor], At(",", cor[opc_cor]))
            cormodif:= SubStr(cor[1], 1, At(",", cor[1]) - 1)
            cor[1]:= SubStr(cor[1], At(",", cor[1]) + 1)
            cor[1]:= cormodif + "," + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[1], At(",", cor[1]))
            cormodif:= SubStr(cor[2], 1, At(",", cor[2]) - 1)
            cor[2]:= SubStr(cor[2], At(",", cor[2]) + 1)
            cor[2]:= cormodif + "," + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3] + ;
               SubStr(cor[2], At(",", cor[2]))
         case cop_cor $ "04"
            cor[3]:= SubStr(cor[3], 1, rat(",", cor[3])) + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3]
            cor[1]:= SubStr(cor[1], 1, rat(",", cor[1])) + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3]
            cor[2]:= SubStr(cor[2], 1, rat(",", cor[2])) + ;
               tb[ascan(tb, {|_1| Local1 == _1[2]})][1] + "/" + ;
               tb[ascan(tb, {|_1| Local2 == _1[2]})][3]
         endcase
      enddo
      RestScreen(0, 0, 24, 79, tela_cor)
   enddo
   RestScreen(0, 0, 24, 79, Local4)
   setcursor(1)
   writecor(@cor)

********************************
static procedure WRITECOR(Arg1)

   local Local1, Local2, Local3:= "", Local4, Local5:= iif(config[8] ;
      != Nil, config[8], "") + "cores.cf_"
   erase (Local5)
   Local1:= fcreate(Local5, 0)
   for Local4:= 1 to 12
      fwrite(Local1, Arg1[Local4] + "")
   next
   fwrite(Local1, strzero(Arg1[13], 3) + "")
   for Local4:= 14 to 19
      fwrite(Local1, Arg1[Local4] + "")
   next
   fwrite(Local1, Arg1[20])
   fclose(Local1)

********************************
function CONFIRME(Arg1)

   local Local1:= Space(1), Local2:= SetColor(), Local3:= setcursor(1)
   set color to 
   @ 24,  0 clear
   tone(1100, 2)
   if (Arg1 = Nil)
      Local1:= ms250(" Confirme (S/N) ? ", 24, 61, cor[4], cor[5], ;
         {78, 83})
   else
      Arg1:= " " + Arg1 + " "
      Local1:= ms250(Arg1, 24, 79 - Len(Arg1), cor[4], cor[5], {78, ;
         83})
   endif
   set color to (cor[4])
   @ 24, 62 say iif(Local1 = 83, "   Confirmado !   ", ;
      " Nao Confirmado ! ")
   InKey(1)
   set color to (Local2)
   @ 24, 62 clear
   setcursor(Local3)
   return iif(Local1 = 83, .T., .F.)

********************************
function MIN_TO_HD(Arg1)

   return Val(strzero(Int(Arg1 / 60), 2) + "." + strzero(Arg1 % 60, ;
      2))

********************************
procedure FUNC0047


********************************
function EXCLUIR

   local Local1:= {}, Local2:= SetColor(""), Local3:= Space(1), ;
      Local4:= setcursor(1)
   @ 24,  0 clear
   set color to (cor[4])
   @ 24, 62 say "  Exclui  (S/N) ? "
   set color to (cor[5])
   @ 24, 73 say "S"
   @ 24, 75 say "N"
   set confirm on
   SetPos(24, 79)
   AAdd(Local1, __Get({|_1| iif(ISNIL(_1), Local3, Local3:= _1)}, ;
      "VCONF", "@! A", {|| Local3 $ "SN"}, Nil):display())
   ReadModal(Local1)
   Local1:= {}
   set confirm off
   if (Local3 = "S")
      @ 24, 62 say "   Excluido   !   "
      InKey(0.4)
      set color to 
      @ 24, 62 clear
      set color to (Local2)
      setcursor(Local4)
      return .T.
   else
      @ 24, 62 say "  Nao Excluido  ! "
      InKey(0.4)
      set color to 
      @ 24, 62 clear
      set color to (Local2)
      setcursor(Local4)
      return .F.
   endif

********************************
function GRA

   @ 24,  0 say Space(80) color "N/N"
   tone(1100, 1)
   gra:= ms250(" <G>ravar, <R>ecusar ou <A>lterar ? ", 24, 44, ;
      cor[4], cor[5], {71, 82, 65, 27})
   if (gra == 71)
      @ 24, 44 say "              GRAVANDO              " color cor[4]
   elseif (gra = 82 .OR. gra = 27)
      @ 24, 44 say "              RECUSADO              " color cor[4]
   elseif (gra == 65)
      @ 24, 44 say "              ALTERAR               " color cor[4]
   endif
   InKey(0.5)
   @ 24,  0 say Space(80) color "N/N"
   return gra:= Chr(gra)

********************************
function __GETSETEX(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[9]:= Arg1
   endif
   return qself()[9]

********************************
procedure SDF

   return

********************************
procedure INS_OVR

   local Local1
   Local1:= SetColor(cor[11])
   if (readinsert())
      readinsert(.F.)
      @  0, 76 say "OVR"
   else
      readinsert(.T.)
      @  0, 76 say "INS"
   endif
   set color to (Local1)
   return

********************************
procedure SINAL(Arg1, Arg2)

   local Local1
   Local1:= SetColor(cor[11])
   @  0, 51 say padc(Trim(SubStr(Arg1, 1, 11)), 11)
   @  0, 63 say padc(Trim(SubStr(Arg2, 1, 11)), 11)
   set color to (Local1)
   return

********************************
function WINMENU(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9, Local10
   Local4:= wselect()
   Local5:= Len(Arg2)
   Local6:= 1
   if (Arg3 != Nil)
      Local5:= Local5 + 3 + Len(Arg3)
      if (Arg4 != Nil)
         Local5:= Local5 + 3 + Len(Arg4)
         if (Arg5 != Nil)
            Local5:= Local5 + 3 + Len(Arg5)
         endif
      endif
   endif
   Local2:= Local5
   Local3:= numtoken(Arg1, ";")
   for Local1:= 1 to Local3
      Local2:= Max(Local2, Len(token(Arg1, ";", Local1)))
   next
   Local9:= 3 + Local3
   Local10:= 3 + Local2
   wselect(0)
   Local7:= wfrow() + (wflastrow() - wfrow() - Local9) / 2
   Local9:= Local9 + Local7
   Local8:= wfcol() + (wflastcol() - wfcol() - Local10) / 2
   Local10:= Local10 + Local8
   wopen(Local7, Local8, Local9, Local10)
   if (Arg6 != Nil)
      set color to (Arg6)
   elseif (iscolor())
      set color to W+/R, W+/B
   else
      set color to N/W, W/N
   endif
   wbox(1)
   wformat(0, 1, 0, 1)
   for Local1:= 1 to Local3
      dispout(center(token(Arg1, ";", Local1), .T.))
      SetPos(Local1, 0)
   next
   @ Row() + 1, (MaxCol() - Local5) / 2 prompt Arg2
   if (Arg3 != Nil)
      @ Row(), Col() + 3 prompt Arg3
      if (Arg4 != Nil)
         @ Row(), Col() + 3 prompt Arg4
         if (Arg5 != Nil)
            @ Row(), Col() + 3 prompt Arg5
         endif
      endif
   endif
   menu to Local6
   wclose()
   wselect(Local4)
   return Local6

********************************
function DBSETORDER(Arg1)

   if (ISCHARACTER(Arg1) .AND. !Empty(Val(Arg1)))
      Arg1:= Val(Arg1)
   endif
   set order to Arg1
   return Nil

********************************
procedure BARRA_OP(Arg1, Arg2, Arg3, Arg4)

   local Local1
   Local1:= SetColor("")
   Arg1:= iif(Arg1 = Nil, 24, Arg1)
   Arg2:= iif(Arg2 = Nil, cor[9], Arg2)
   Arg3:= iif(Arg3 = Nil, cor[10], Arg3)
   @ Arg1,  0 say Space(80)
   if (Arg4 = Nil)
      set color to (Arg2)
      @ Arg1,  0 say "      Anterior "
      @ Arg1, 16 say "      Prximo  "
      @ Arg1, 32 say "       Alterar  "
      @ Arg1, 49 say "     Excluir   "
      @ Arg1, 65 say "     Finalizar "
      set color to (Arg3)
      @ Arg1,  1 say "PGUP"
      @ Arg1, 17 say "PGDN"
      @ Arg1, 33 say "ENTER"
      @ Arg1, 50 say "DEL"
      @ Arg1, 66 say "ESC"
   else
      set color to (Arg2)
      @ Arg1,  0 say "      Anterior "
      @ Arg1, 16 say "      Prximo "
      @ Arg1, 31 say "       Alterar "
      @ Arg1, 47 say "     Excluir "
      @ Arg1, 61 say "     Fim "
      @ Arg1, 71 say "    Menu "
      set color to (Arg3)
      @ Arg1,  1 say "PGUP"
      @ Arg1, 17 say "PGDN"
      @ Arg1, 32 say "ENTER"
      @ Arg1, 48 say "DEL"
      @ Arg1, 62 say "ESC"
      @ Arg1, 72 say "F3"
   endif
   set color to (Local1)
   return

********************************
function MONTA(Arg1, Arg2, Arg3, Arg4)

   local Local1, Local2:= Len(Arg1), Local3:= {}
   for Local1:= 1 to Local2
      if (acesso(Arg1[Local1][Arg2], .F.))
         if (Arg3 != Nil)
            AAdd(Local3, {Arg3, Arg4, Arg1[Local1][3], ;
               Arg1[Local1][4], Arg1[Local1][5]})
            Arg3++
         else
            AAdd(Local3, Arg1[Local1])
         endif
      endif
   next
   return Local3

********************************
function __GETSETRE(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[10]:= Arg1
   endif
   return qself()[10]

********************************
procedure DBFONLY

   return

********************************
function WINDOW(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7)

   Arg7:= iif(Arg7 = Nil, .T., Arg7)
   Arg6:= iif(Arg6 = Nil, .F., Arg6)
   private dif_col, dif_row, dif_prop, dif_range, dif_delay, ;
      dif_limite, dif_passo, linesombra, colsombra, lensombra, ;
      sombraline, sombracol, cursorat:= setcursor(0), x, var_row, ;
      var_col, ind, xtela
   if (Arg6)
      xtela:= Str(Arg1, 2) + Str(Arg2, 2) + Str(Arg3 + 1, 2) + ;
         Str(Arg4 + 1, 2) + SaveScreen(Arg1, Arg2, Arg3 + 1, Arg4 + 1)
   else
      xtela:= Str(Arg1, 2) + Str(Arg2, 2) + Str(Arg3, 2) + Str(Arg4, ;
         2) + SaveScreen(Arg1, Arg2, Arg3, Arg4)
   endif
   if ("" != getenv("WINFAST") .OR. !Arg7)
      @ Arg1, Arg2, Arg3, Arg4 box Arg5
      if (Arg6)
         sombra(Arg3 + 1, Arg2 + 1, Arg3 + 1, Arg4 + 1)
         sombra(Arg1 + 1, Arg4 + 1, Arg3 + 1, Arg4 + 1)
      endif
      setcursor(cursorat)
      return xtela
   endif
   dif_col:= Arg4 - Arg2
   dif_row:= Arg3 - Arg1
   dif_prop:= iif(dif_col > dif_row, dif_col / dif_row, dif_row / ;
      dif_col)
   dif_range:= iif(dif_col > dif_row, dif_row / 2, dif_col / 2)
   dif_delay:= iif(dif_col < dif_row, dif_row / 2, dif_col / 2)
   dif_delay:= dif_delay + iif(dif_delay < 30, 15, 0)
   for x:= Int(dif_range) to 0 step -1
      if (dif_col > dif_row)
         var_row:= x
         var_col:= Int(x * dif_prop)
      else
         var_col:= x
         var_row:= Int(x * dif_prop)
      endif
      @ Arg1 + var_row, Arg2 + var_col, Arg3 - var_row, Arg4 - ;
         var_col box Arg5
      if (Arg6)
         sombra(Arg3 - var_row + 1, Arg2 + var_col + 1, Arg3 - ;
            var_row + 1, Arg4 - var_col + 1)
         sombra(Arg1 + var_row + 1, Arg4 - var_col + 1, Arg3 - ;
            var_row + 1, Arg4 - var_col + 1)
         InKey(0.6 / dif_delay)
      else
         InKey(1 / dif_delay)
      endif
   next
   setcursor(cursorat)
   return xtela

********************************
static procedure SOMBRA(Arg1, Arg2, Arg3, Arg4)

   linesombra:= SaveScreen(Arg1, Arg2, Arg3, Arg4)
   lensombra:= Len(linesombra)
   sombraline:= ""
   for ind:= 1 to lensombra step 2
      sombraline:= sombraline + (SubStr(linesombra, ind, 1) + ;
         Chr(cor[13]))
   next
   RestScreen(Arg1, Arg2, Arg3, Arg4, sombraline)
   return

********************************
function __TADDCOLU(Arg1)

   AAdd(qself()[6], Arg1)
   qself():configure(2)
   return qself()

********************************
function NAVEGA(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8)

   local Local1, Local2, Local3, Local4
   private n_a_v_e_g_:= .T.
   Local3:= iif(Arg6 = Nil, Nil, &Arg6)
   Local4:= Arg7
   do while (.T.)
      &Arg4()
      set color to (cor[3])
      &Arg5()
      if (Arg3 != Nil)
         Local2:= &Arg3
         @ Arg1, Arg2 get chave
      endif
      keyboard Replicate(Chr(13), Len(getlist))
      read
      clear typeahead
      set color to 
      @ 24,  0
      setcursor(0)
      set color to (cor[9])
      @ 24,  0 say " PgUp Anterior "
      @ 24, 16 say " PgDn Proximo  "
      @ 24, 32 say "  F2 Alterar   "
      @ 24, 48 say "  F3 Excluir   "
      @ 24, 64 say "    Esc Sai     "
      set color to (cor[10])
      @ 24,  1 say "PgUp"
      @ 24, 17 say "PgDn"
      @ 24, 34 say "F2"
      @ 24, 50 say "F3"
      @ 24, 68 say "Esc"
      set color to 
      Local1:= InKey(0)
      if (Local1 = 3)
         skip 
         if (EOF() .OR. iif(Arg6 = Nil, Nil, &Arg6) != Arg7)
            tone(2000, 1)
            tone(200, 1)
            ms250("Final de Arquivo !", 24, 0, cor[7], Nil, {0.5}, ;
               0, 80, "C")
            skip -1
         endif
      elseif (Local1 = 18)
         skip -1
         if (BOF() .OR. iif(Arg6 = Nil, Nil, &Arg6) != Arg7)
            if (iif(Arg6 = Nil, Nil, &Arg6) != Arg7)
               skip 
            endif
            tone(2000, 1)
            tone(200, 1)
            ms250("Inicio de Arquivo !", 24, 0, cor[7], Nil, {0.5}, ;
               0, 80, "C")
         endif
      elseif (Local1 = -1 .OR. Local1 = -2 .OR. Local1 = 27)
         setcursor(1)
         n_a_v_e_g_:= .F.
         return Local1
      endif
   enddo
   return Local1

********************************
function CHEC_PSW(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)

   local Local1, Local2, Local3
   Local3:= 0
   private ckey:= ""
   if (iif(Arg1 != Nil, Upper(Arg1), "") = "IMPORTAR")
      cusu:= "MASTER"
      menu_psw(Arg2, Arg3, Arg4)
   endif
   Local1:= Arg2 + "PSW.SY2"
   if (!file(Local1))
      if (netuse(Arg2 + "PSW.", "PSW", "E", "NEW", 5))
         index on crypt(usuario,cKEY)+crypt(sequencia,cKEY) to ;
            (Local1)
         closedata("PSW")
      endif
   endif
   if (netuse(Arg2 + "PSW.", "PSW", "S", "NEW", 10))
      dbSetIndex(Local1)
   else
      return .F.
   endif
   if (Arg6 != Nil)
      localiza("MASTER              ", "PSW", 2, "M", Nil, Nil, Nil, ;
         Nil, "Usuario nao Cadastrado no Sistema")
      DBEval({|| AAdd(vdireitos, crypt(psw->programa, ckey))}, {|| ;
         iif(SubStr(crypt(psw->autorizado, SubStr(psw->programa, 5, ;
         5)), 1, 1) = "T", .T., .F.) .AND. crypt(psw->usuario, ckey) ;
         = cusu})
      closedata("PSW")
   else
      Local2:= savescr(16, 22, 21, 61)
      do while (Local3 < 3)
         set color to (cor[1])
         if (Arg5 = Nil)
            window(16, 22, 20, 60, "Ŀ ", .T.)
         else
            jan3d(16, 22, 20, 60)
         endif
         @ 17, 24 say "Nome usuario.: "
         @ 18, 23 to 18, 59
         @ 19, 24 say "Senha Usuario: "
         cusu:= Space(20)
         set color to (cor[3])
         @ 17, 39 get cUSU picture "@!" valid !Empty(cusu) when ;
            mens_when("Digite o Nome do Usuario ou tecle <ESC> p/ sair")
         read
         set color to 
         if (LastKey() == K_ESC)
            clear screen
            readkill(.T.)
            getlist:= {}
            @  0,  0 say padc("Pointer Informatica Ltda", 80) color ;
               "BG/B"
            ? 
            ? 
            quit
         elseif (!localiza(cusu, "PSW", 2, "M", Nil, Nil, Nil, Nil, ;
               "Usuario nao Cadastrado no Sistema"))
            Local3++
            loop
         endif
         do while (Local3 < 3)
            csenha:= Space(20)
            ms250("Digite a Senha de acesso ou tecle <ESC> para retornar.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            csenha:= Upper(getsecret(csenha, 19, 39))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            if (psw->(crypt(senha, ckey)) != csenha)
               ms250("Usuario nao autorizado.", 24, 0, cor[6], ;
                  cor[7], {1}, "T", 80, "C")
               set color to 
               @ 23,  0 clear
               Local3++
               loop
            endif
            exit
         enddo
         if (LastKey() == K_ESC)
            set color to (cor[1])
            @ 19, 39 say Space(20)
            set color to 
            @ 23,  0 clear
            loop
         endif
         exit
      enddo
      if (Local3 < 3)
         ms250("Aguarde um momento... Liberando usu rio...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         DBEval({|| AAdd(vdireitos, crypt(psw->programa, ckey))}, ;
            {|| iif(SubStr(crypt(psw->autorizado, ;
            SubStr(psw->programa, 5, 5)), 1, 1) = "T", .T., .F.) ;
            .AND. crypt(psw->usuario, ckey) = cusu})
      endif
      if (Len(vdireitos) == 0)
         clear screen
         readkill(.T.)
         getlist:= {}
         @  0,  0 say padc("Pointer Informatica Ltda", 80) color ;
            "BG/B"
         ? 
         ? 
         quit
      endif
      closedata("PSW")
      restscr(Local2)
      return
   endif

********************************
function VAL_HORA(Arg1)

   local Local1:= Val(SubStr(Arg1, 1, 2)), Local2:= Val(SubStr(Arg1, ;
      4, 2))
   return Local1 >= 0 .AND. Local1 < 24 .AND. Local2 >= 0 .AND. ;
      Local2 < 60

********************************
function __GETSETCA(Arg1)

   if (PCount() == 1)
      qself()[6]:= Arg1
   endif
   return qself()[6]

********************************
procedure MENU_PSW(Arg1, Arg2, Arg3, Arg4)

   local Local1:= {}, Local2, Local3:= Arg1 + "PSW.", Local4:= Arg1 ;
      + "PSW.SY1", Local5:= Arg1 + "PSW.SY2", Local6:= Arg1 + ;
      "PSW.SY3"
   private ckey:= ""
   if (!file(Local3))
      dbcreate(Local3, {{"DESCRICAO ", "C", 50, 0}, {"PROGRAMA  ", ;
         "C", 15, 0}, {"USUARIO   ", "C", 20, 0}, {"SENHA     ", ;
         "C", 20, 0}, {"AUTORIZADO", "C", 10, 0}, {"SEQUENCIA ", ;
         "C", 5, 0}})
   endif
   erase (Local4)
   erase (Local5)
   erase (Local6)
   if (!file(Local4) .OR. !file(Local5) .OR. !file(Local6))
      if (netuse(Local3, "PSW", "E", "NEW", 5))
         pack
         index on crypt(usuario,cKEY)+crypt(programa,cKEY) to (Local4)
         index on crypt(usuario,cKEY)+crypt(sequencia,cKEY) to ;
            (Local5)
         index on crypt(usuario,cKEY) to (Local6) unique
         closedata("PSW")
      endif
   endif
   if (netuse(Local3, "PSW", "S", "NEW", 10))
      dbSetIndex(Local4)
      dbSetIndex(Local5)
      dbSetIndex(Local6)
   endif
   AAdd(Local1, {Arg2 + 0, Arg3, " Cadastro      ", ;
      padc("Cadastro de Senhas para Usuarios", 80)})
   AAdd(Local1, {Arg2 + 1, Arg3, " Manutencao    ", ;
      padc("Manutencao de Acessos ao Sistema", 80)})
   AAdd(Local1, {Arg2 + 2, Arg3, " Exclusao      ", ;
      padc("Exclusao de usuarios", 80)})
   AAdd(Local1, {Arg2 + 3, Arg3, " Importacao    ", ;
      padc("Importacao de dados de acessos", 80)})
   AAdd(Local1, {Arg2 + 4, Arg3, " Altera Senha  ", ;
      padc("Alteracao de Senha pelo usuario", 80)})
   AAdd(Local1, {Arg2 + 5, Arg3, " Troca Usu rio ", ;
      padc("Troca de usu rio que esta acessando o Sistema", 80)})
   save screen to Local2
   sinal("SUB-MENU", "SENHAS")
   m_senhas:= 1
   do while (.T.)
      set color to (cor[14])
      if (Arg4 = Nil)
         window(Arg2 - 1, Arg3 - 1, Arg2 + 6, Arg3 + 15, ;
            "Ŀ ", .T.)
      else
         jan3d(Arg2 - 1, Arg3 - 1, Arg2 + 6, Arg3 + 15)
      endif
      m_senhas:= menu_prt(Local1, m_senhas, cor[14], ;
         SubStr(SubStr(cor[14], At(",", cor[14]) + 1), 1, At(",", ;
         SubStr(cor[14], At(",", cor[14]) + 1)) - 1), cor[15], ;
         SubStr(SubStr(cor[15], At(",", cor[15]) + 1), 1, At(",", ;
         SubStr(cor[15], At(",", cor[15]) + 1)) - 1), 80)
      set color to 
      do case
      case m_senhas = 1 .AND. acesso("CTRLPSW1")
         ctrlpsw1(Arg1, Arg4)
      case m_senhas = 2 .AND. acesso("CTRLPSW2")
         ctrlpsw2(Arg1, Arg4)
      case m_senhas = 3 .AND. acesso("CTRLPSW3")
         ctrlpsw3(Arg1, Arg4)
      case m_senhas = 4
         ctrlpsw4(Arg1, Arg4)
      case m_senhas = 5 .AND. acesso("CTRLPSW5")
         ctrlpsw5(Arg1, Arg4)
      case m_senhas = 6 .AND. acesso("CTRLPSW6")
         ctrlpsw6(Arg1, Arg4)
      case m_senhas = 0
         restore screen from Local2
         closedata("PSW")
         return
      endcase
   enddo
   return

********************************
function __GETTODEC

   local Local1
   if (Len(qself()) == 13)
      if (qself():clear())
         qself():delend()
      endif
      qself():reform()
      qself():pos(qself():decpos())
      qself():changed(.T.)
      if (qself():untransfor() == 0 .AND. qself():minus())
         qself():backspace()
         qself():overstrike("-")
      endif
      qself():display()
   endif
   return qself()

********************************
function READUPDATE(Arg1)

   local Local1
   Local1:= Static22
   if (PCount() > 0)
      Static22:= Arg1
   endif
   return Local1

********************************
function __TCOLCOUN

   return Len(qself()[6])

********************************
procedure CTRLPSW1(Arg1, Arg2)

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> p/ sair"}
   private cusuario, csenha, cconf, nelem, nposi, lcont_ach
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("CADASTRO", "USUARIOS")
   select PSW
   set order to 2
   do while (.T.)
      nelem:= nposi:= 1
      vacessos:= {}
      cusuario:= Space(20)
      csenha:= Space(20)
      cconf:= Space(20)
      set color to (cor[1])
      if (Arg2 = Nil)
         window(4, 1, 9, 39, "ͻȺ ", .T.)
      else
         jan3d(4, 1, 9, 39)
      endif
      @  5,  3 say "Nome usuario.: "
      @  7,  3 say "Senha Usuario: "
      @  8,  3 say "  Confirmacao: "
      set color to (cor[3])
      @  5, 18 get cUSUARIO picture "@!" valid !Empty(cusuario) when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      seek cusuario
      if (Found())
         ms250("Usuario ja cadastrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      do while (.T.)
         csenha:= Space(20)
         cconf:= Space(20)
         ms250("Digite a Senha do Usuario ou tecle <ESC> para sair.", ;
            24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
         set color to (cor[3])
         csenha:= Upper(getsecret(csenha, 7, 18))
         if (LastKey() != K_ESC)
            ms250("Digite novamente a Senha para confirmacao.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            cconf:= Upper(getsecret(cconf, 8, 18))
            set color to 
            if (csenha != cconf)
               ms250("Senha nao confere, favor digitar novamente. Tecle <ESC> para sair.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               set color to (cor[1])
               @  7, 17 clear to  8, 38
               set color to 
               loop
            endif
         endif
         exit
      enddo
      if (LastKey() == K_ESC)
         loop
      endif
      ms250("Aguarde um momento... Gerando arquivo...", 24, 0, ;
         cor[4], cor[5], Nil, Nil, 80, "C")
      psw->(dbGoTop())
      DBEval({|| AAdd(vacessos, "  " + crypt(descricao, ckey) + " " ;
         + crypt(programa, ckey))}, {|| crypt(usuario, ckey) = ;
         "MASTER"})
      @ 23,  0
      ms250("[ENTER] Setar Item    [F10] Setar Grupo    [Shift+F10] Grava    [ESC] Cancela", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      set color to (cor[19])
      if (Arg2 = Nil)
         window(11, 1, 20, 54, "Ŀ ", .T.)
      else
         jan3d(11, 1, 20, 54)
      endif
      lcont_ach:= .T.
      do while (lcont_ach)
         achoice(12, 2, 19, 53, vacessos, Nil, "ACHOPSW2", nelem, ;
            nposi)
      enddo
      set color to 
      if (!fillock(5))
         ms250("Nao foi possivel travar o arquivo. Operacao sera cancelada.", ;
            24, 0, cor[6], cor[7], {27}, "T", 80, "c")
         restore screen from Local1
         return
      endif
      if (LastKey() = K_SH_F10 .AND. confirme())
         ni:= 0
         ms250("Aguarde um momento... Gravando arquivo...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         for ni:= 1 to Len(vacessos)
            psw->(dbAppend())
            replace psw->descricao with crypt(SubStr(vacessos[ni], ;
               3, 50), ckey)
            replace psw->sequencia with crypt(strzero(RecNo(), 5), ;
               ckey)
            replace psw->programa with crypt(SubStr(vacessos[ni], ;
               54, 15), ckey)
            replace psw->usuario with crypt(cusuario, ckey)
            replace psw->senha with crypt(csenha, ckey)
            replace psw->autorizado with ;
               crypt(iif(SubStr(vacessos[ni], 1, 1) = "", "T", ;
               "F"), SubStr(psw->programa, 5, 5))
         next
      endif
      set color to (cor[12])
      @ 11,  1 clear to 21, 78
      set color to 
      psw->(dbUnlock())
   enddo
   return

********************************
function ACHOPSW2(Arg1, Arg2, Arg3)

   local Local1:= LastKey(), Local2:= 2, Local3:= " ", Local4, ;
      Local5:= Len(vacessos), Local6
   if (Local1 = 27 .OR. Local1 = -19)
      lcont_ach:= .F.
      Local2:= 0
   elseif (Local1 = 13)
      vacessos[Arg2]:= iif(SubStr(vacessos[Arg2], 1, 1) = " ", "" + ;
         SubStr(vacessos[Arg2], 2), " " + SubStr(vacessos[Arg2], 2))
   elseif (Local1 = -9)
      nelem:= Arg2
      nposi:= Arg3
      vacessos[Arg2]:= iif(SubStr(vacessos[Arg2], 1, 1) = " ", "" + ;
         SubStr(vacessos[Arg2], 2), " " + SubStr(vacessos[Arg2], 2))
      Local4:= countleft(SubStr(vacessos[Arg2], 2), " ")
      Local3:= SubStr(vacessos[Arg2], 1, 1)
      Arg2++
      do while (Arg2 <= Local5)
         if (countleft(SubStr(vacessos[Arg2], 2), " ") > Local4)
            vacessos[Arg2]:= Local3 + SubStr(vacessos[Arg2], 2)
         else
            exit
         endif
         Arg2++
      enddo
      Local2:= 0
   endif
   return Local2

********************************
function ACESSO(Arg1, Arg2)

   local Local1, Local2
   Local1:= ascan(vdireitos, Arg1)
   Local2:= iif(Arg2 = Nil, .T., Arg2)
   if (iif(Local1 != 0, iif(Trim(vdireitos[Local1]) == Arg1, .T., ;
         .F.), .F.))
      return .T.
   else
      if (Local2)
         set color to 
         @ 23,  0
         ms250("Acesso nao autorizado. " + Arg1, 24, 0, cor[6], ;
            cor[7], {2}, "T", 80, "C")
      endif
      return .F.
   endif

********************************
function DIF_HHMM(Arg1, Arg2)

   Arg1:= hh_to_hd(Arg1)
   Arg2:= hh_to_hd(Arg2)
   Arg2:= Arg2 + iif(Arg1 > Arg2, 24, 0)
   return hd_to_hh(Arg2 - Arg1)

********************************
procedure CTRLPSW2(Arg1, Arg2)

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> p/ sair"}
   private cusuario, nelem, nposi, lcont_ach
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("MANUTENCAO", "SENHAS")
   select PSW
   do while (.T.)
      nelem:= nposi:= 1
      vacessos:= {}
      cusuario:= Space(20)
      set color to (cor[1])
      if (Arg2 = Nil)
         window(4, 1, 6, 38, "ͻȺ ", .T.)
      else
         jan3d(4, 1, 6, 38)
      endif
      @  5,  3 say "Nome usuario: "
      set color to (cor[3])
      @  5, 17 get cUSUARIO picture "@!" valid !Empty(cusuario) when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      if (Trim(cusuario) = "MASTER")
         loop
      endif
      psw->(dbSetOrder(2))
      seek Trim(cusuario)
      if (!Found())
         ms250("Usuario nao encontrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      cusuario:= psw->usuario
      ms250("Aguarde um momento... Gerando arquivo...", 24, 0, ;
         cor[4], cor[5], Nil, Nil, 80, "C")
      DBEval({|| AAdd(vacessos, iif(crypt(autorizado, ;
         SubStr(psw->programa, 5, 5)) = "T", " " + crypt(descricao, ;
         ckey) + " " + crypt(programa, ckey), "  " + ;
         crypt(descricao, ckey) + " " + crypt(programa, ckey)))}, ;
         {|| Trim(usuario) = Trim(cusuario)})
      @ 23,  0
      ms250("[ENTER] Setar Item    [F10] Setar Grupo    [Shift+F10] Grava    [ESC] Cancela", ;
         24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
      set color to (cor[19])
      if (Arg2 = Nil)
         window(8, 1, 20, 54, "Ŀ ", .T.)
      else
         jan3d(8, 1, 20, 54)
      endif
      lcont_ach:= .T.
      do while (lcont_ach)
         achoice(9, 2, 19, 53, vacessos, Nil, "ACHOPSW2", nelem, ;
            nposi)
      enddo
      set color to 
      if (!fillock(5))
         ms250("Nao foi possivel travar o arquivo. Operacao sera cancelada.", ;
            24, 0, cor[6], cor[7], {27}, "T", 80, "c")
         restore screen from Local1
         return
      endif
      if (LastKey() = K_SH_F10 .AND. confirme())
         psw->(dbSetOrder(1))
         ms250("Aguarde um momento... Atualizando arquivo...", 24, ;
            0, cor[4], cor[5], Nil, Nil, 80, "C")
         ni:= 0
         for ni:= 1 to Len(vacessos)
            psw->(dbSeek(crypt(cusuario, ckey) + ;
               SubStr(vacessos[ni], 54, 15)))
            if (psw->(Found()))
               replace psw->autorizado with ;
                  crypt(iif(SubStr(vacessos[ni], 1, 1) = "", "T", ;
                  "F"), SubStr(psw->programa, 5, 5))
            endif
         next
         psw->(dbUnlock())
         if (crypt(cusuario, ckey) = cusu)
            vdireitos:= {}
            DBEval({|| AAdd(vdireitos, crypt(psw->programa, ckey))}, ;
               {|| iif(crypt(psw->autorizado, SubStr(psw->programa, ;
               5, 5)) = "T", .T., .F.) .AND. crypt(psw->usuario, ;
               ckey) = cusu})
         endif
      endif
      set color to (cor[12])
      @  8,  1 clear to 21, 78
      set color to 
   enddo
   return

********************************
function GETNEW(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)

   local Local1[10]
   default Arg4 to ""
   default Arg6 to .T.
   __toget(Local1)
   Local1:row(Arg1)
   Local1:col(Arg2)
   Local1[1]:= Arg3
   Local1[7]:= Arg4
   Local1[3]:= Arg5
   Local1:colorspec(Arg6)
   return Local1

********************************
procedure CTRLPSW3(Arg1, Arg2)

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> p/ sair"}
   private cusuario
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("EXCLUSAO", "USUARIO")
   select PSW
   set order to 2
   do while (.T.)
      vacessos:= {}
      cusuario:= Space(20)
      set color to (cor[1])
      if (Arg2 = Nil)
         window(4, 1, 6, 38, "ͻȺ ", .T.)
      else
         jan3d(4, 1, 6, 38)
      endif
      @  5,  3 say "Nome usuario: "
      set color to (cor[3])
      @  5, 17 get cUSUARIO picture "@!" valid !Empty(cusuario) when ;
         mens_when(mens1[1])
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local1
         return
      endif
      if (Trim(cusuario) = "MASTER")
         loop
      endif
      seek cusuario
      if (!Found())
         ms250("Usuario nao encontrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      cusuario:= crypt(psw->usuario, ckey)
      if (cusu = cusuario)
         ms250("Usuario corrente nao pode ser excluido. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      if (!fillock(5))
         ms250("Nao foi possivel travar o arquivo. Operacao sera cancelada.", ;
            24, 0, cor[6], cor[7], {27}, "T", 80, "c")
         restore screen from Local1
         return
      endif
      if (confirme())
         ms250("Aguarde um momento... Eliminando Usuario...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         DBEval({|| dbDelete()}, {|| crypt(usuario, ckey) = cusuario})
      endif
      psw->(dbUnlock())
   enddo
   return

********************************
function LOCALIZA(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
   Arg9, Arg10)

   local Local1, Local2, Local3, Local4
   Arg8:= iif(Arg8 = Nil, cor[2], Arg8)
   Local2:= alias()
   if ("" != Local2)
      Local1:= indexord()
   endif
   select (Arg2)
   set order to Arg3
   seek Arg1
   Local4:= SaveScreen(23, 0, 24, 79)
   @ 23,  0 say Space(80) color "N/N"
   if (EOF())
      if (Arg4 = "M" .AND. Arg10 = Nil)
         tone(800, 5)
         ms250(iif(Arg9 != Nil, Arg9, ;
            "Ateno ! Chave de pequisa no encontrada, verificar.  Tecle <ESC> p/ continuar."), ;
            24, 0, cor[6], cor[7], {27, 0}, Nil, 80, "C")
         Local3:= .F.
         Arg1:= iif(ValType(Arg1) = "C", Space(Len(Arg1)), ;
            iif(ValType(Arg1) = "N", 0, iif(ValType(Arg1) = "D", ;
            CToD(""), iif(ValType(Arg1) = "L", .F., Nil))))
      else
         if (Arg5 != Nil)
            xvar_:= &Arg5
            @ Arg6, Arg7 say Space(Len(xvar_)) color Arg8
         endif
         Local3:= .T.
      endif
   elseif (Arg4 = "I" .AND. Arg10 = Nil)
      tone(800, 5)
      ms250(iif(Arg9 != Nil, Arg9, ;
         "Ateno ! Dado(s) j  cadastrado(s), favor verificar. Tecle <ESC> para continuar."), ;
         24, 0, cor[6], cor[7], {27, 0}, Nil, 80, "C")
      Arg1:= iif(ValType(Arg1) != "N", Space(Len(Arg1)), 0)
      Local3:= .F.
   else
      if (Arg5 != Nil)
         xvar_:= &Arg5
         @ Arg6, Arg7 say xvar_ color Arg8
      endif
      Local3:= .T.
   endif
   if ("" != Local2)
      select (Local2)
      set order to Local1
   endif
   RestScreen(23, 0, 24, 79, Local4)
   return Local3

********************************
function __TSETFOOT(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[9]:= _einstvar(qself(), "FOOTSEP", Arg1, "C", 1001)
   endif
   return qself()[9]

********************************
procedure CTRLPSW4(Arg1, Arg2)

   local Local1:= {}, Local2, Local3, Local4, Local5:= Arg1 + ;
      "PSW.TXT", Local6, Local7
   if (cusu != "MASTER")
   else
      Local6:= SaveScreen(23, 0, 24, 79)
      set color to 
      @ 23,  0 clear
      select PSW
      if (!fillock(5))
         ms250("Nao foi possivel travar o arquivo. Operacao sera cancelada.", ;
            24, 0, cor[6], cor[7], {27}, "T", 80, "c")
         RestScreen(23, 0, 24, 79, Local6)
      elseif (!confirme())
         RestScreen(23, 0, 24, 79, Local6)
      else
         ms250("Aguarde um momento... Importando arquivo...", 24, 0, ;
            cor[4], cor[5], Nil, Nil, 80, "C")
         DBEval({|| dbDelete()}, {|| crypt(usuario, ckey) = ;
            "MASTER"}, Nil, Nil, Nil, .F.)
         psw->(dbGoTop())
         do while (!psw->(EOF()))
            if (ascan(Local1, crypt(psw->usuario, ckey)) == 0)
               AAdd(Local1, crypt(psw->usuario, ckey))
            endif
            psw->(dbSkip())
         enddo
         set order to 2
         Local3:= newfile()
         copy to (Local3) all
         use (Local3) alias PSW_TMP new
         DBEval({|| (field->usuario:= crypt(usuario, ckey), ;
            field->programa:= crypt(programa, ckey))}, Nil, Nil, ;
            Nil, Nil, .F.)
         Local4:= newfile("NTX")
         index on usuario+programa to (Local4)
         select PSW
         goto top
         DBEval({|| dbDelete()})
         append from (Local5) sdf all
         psw->(dbGoTop())
         psw->(dbSetOrder(0))
         DBEval({|| (field->usuario:= crypt("MASTER              ", ;
            ckey), field->senha:= crypt("PCOIIW              ", ;
            ckey), field->programa:= crypt(programa, ckey), ;
            field->descricao:= crypt(descricao, ckey), ;
            field->sequencia:= crypt(strzero(RecNo(), 5), ckey))}, ;
            Nil, Nil, Nil, Nil, .F.)
         DBEval({|| field->autorizado:= crypt("T", ;
            SubStr(psw->programa, 5, 5)) + ;
            Chr(Val(SubStr(psw->sequencia, 1, 1)) + 1) + ;
            SubStr(psw->sequencia, 2, 2)}, Nil, Nil, Nil, Nil, .F.)
         Local7:= psw->(RecNo())
         for Local2:= 1 to Len(Local1)
            cusuario:= Local1[Local2]
            psw_tmp->(dbSeek(cusuario))
            append from (Local5) sdf all
            psw->(dbSetOrder(0))
            psw->(dbGoto(Local7))
            DBEval({|| field->usuario:= cusuario}, Nil, Nil, Nil, ;
               Nil, .T.)
            psw->(dbGoto(Local7))
            DBEval({|| (field->usuario:= crypt(usuario, ckey), ;
               field->programa:= crypt(programa, ckey), ;
               field->senha:= psw_tmp->senha, field->descricao:= ;
               crypt(descricao, ckey), field->sequencia:= ;
               crypt(strzero(RecNo(), 5), ckey))}, Nil, Nil, Nil, ;
               Nil, .T.)
            psw->(dbGoto(Local7))
            do while (!psw->(EOF()))
               psw_tmp->(dbSeek(crypt(psw->usuario, ckey) + ;
                  crypt(psw->programa, ckey)))
               replace psw->autorizado with psw_tmp->autorizado
               psw->(dbSkip())
            enddo
            Local7:= psw->(RecNo())
         next
         psw_tmp->(dbCloseArea())
         erase (Local3)
         erase (Local4)
         RestScreen(23, 0, 24, 79, Local6)
         psw->(dbUnlock())
         return
      endif
   endif

********************************
function GRAVAERRO(Arg1, Arg2)

   local Local1, Local2, Local3, Local4
   Local3:= adir("ERRO.*")
   Local3++
   Local1:= "ERRO." + strzero(Local3, 3)
   if ((Local4:= fcreate(Local1, 0)) == -1)
      return Nil
   endif
   for Local2:= 1 to 13
      fwrite(Local4, Arg2[Local2] + Chr(13) + Chr(10))
   next
   fclose(Local4)
   return Nil

********************************
static function ESCOLHE(Arg1)

   local Local1
   ind:= inicio
   if (Arg1 = 5 .OR. Arg1 = 24 .OR. Arg1 = 4 .OR. Arg1 = 19)
      inicio:= iif(Arg1 = 5 .OR. Arg1 = 19, iif(inicio = 1, tam, ;
         --inicio), iif(inicio = tam, 1, ++inicio))
      return 0
   endif
   return iif((Local1:= ascan(op_1, Upper(Chr(Arg1)))) != 0, ;
      op_2[Local1], -1)

********************************
function __GETBADDA

   local Local1
   if ((Local1:= qself():untransfor(), Len(qself()) == 13 .AND. ;
         qself():type() == "D" .AND. Local1 == CToD("") .AND. ;
         !(qself()[12] == Transform(Local1, qself()[3]))))
      return .T.
   endif
   return .F.

********************************
function __TINSCOLU(Arg1, Arg2)

   asize(qself()[6], Len(qself()[6]) + 1)
   ains(qself()[6], Arg1)
   qself()[6][Arg1]:= Arg2
   qself():configure(2)
   return Arg2

********************************
procedure CTRLPSW5(Arg1, Arg2)

   local Local1
   private mens1:= ;
      {"Digite o Nome do Usuario ou tecle <ESC> para sair"}
   private cusuario, csenha, cconf, csenha_n
   save screen to Local1
   set color to (cor[12])
   @  4,  1 clear to 21, 78
   set color to 
   @ 23,  0 clear to 24, 79
   sinal("ALTERA", "SENHA")
   select PSW
   set order to 2
   do while (.T.)
      cusuario:= Space(20)
      set color to (cor[1])
      if (Arg2 = Nil)
         window(4, 1, 11, 39, "ͻȺ ", .T.)
      else
         jan3d(4, 1, 11, 39)
      endif
      @  5,  3 say "Nome usuario.: "
      @  7,  3 say "Senha Usuario: "
      @  9,  3 say "Nova Senha...: "
      @ 10,  3 say "  Confirmacao: "
      if (ascan(vdireitos, "SENHAMASTER") > 0)
         set color to (cor[3])
         @  5, 18 get cUSUARIO picture "@!" valid !Empty(cusuario) ;
            when mens_when(mens1[1])
         read
         set color to 
         if (LastKey() == K_ESC)
            restore screen from Local1
            return
         endif
      else
         cusuario:= cusu
         set color to (cor[3])
         @  5, 18 get cUSUARIO picture "@!" valid !Empty(cusuario) ;
            when mens_when(mens1[1])
         readkill(.T.)
         getlist:= {}
         set color to 
      endif
      if (cusuario = "MASTER")
         loop
      endif
      seek cusuario
      if (!Found())
         ms250("Usuario nao encontrado. Tecle <ESC> para sair.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         loop
      endif
      cusuario:= crypt(usuario, ckey)
      do while (.T.)
         if (ascan(vdireitos, "SENHAMASTER") == 0)
            csenha:= Space(20)
            set color to (cor[3])
            ms250("Digite a Senha do Usuario ou tecle <ESC> para sair.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            csenha:= Upper(getsecret(csenha, 7, 18))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            if (psw->(crypt(senha, ckey)) != csenha)
               ms250("Senha incorreta. Tecle <ESC> para sair.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               loop
            endif
         endif
         do while (.T.)
            csenha_n:= Space(20)
            ms250("Digite a Nova Senha do Usuario ou tecle <ESC> para sair.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            csenha_n:= Upper(getsecret(csenha_n, 9, 18))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            cconf:= Space(20)
            ms250("Digite novamente a Senha para confirmacao.", ;
               24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
            set color to (cor[3])
            cconf:= Upper(getsecret(cconf, 10, 18))
            set color to 
            if (LastKey() == K_ESC)
               exit
            endif
            if (csenha_n != cconf)
               ms250("Senha nao confere. Tecle <ESC> para digitar novamente.", ;
                  24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
               set color to (cor[1])
               @ 10, 18 say Space(20)
               set color to 
               loop
            endif
            exit
         enddo
         if (!fillock(5))
            ms250("Nao foi possivel travar o arquivo. Operacao sera cancelada.", ;
               24, 0, cor[6], cor[7], {27}, "T", 80, "c")
            restore screen from Local1
            return
         endif
         if (LastKey() != K_ESC .AND. confirme())
            DBEval({|| psw}, {|| crypt(usuario, ckey) = cusuario})
         endif
         psw->(dbUnlock())
         set color to (cor[1])
         @  7, 17 clear to 10, 38
         set color to 
         exit
      enddo
      if (ascan(vdireitos, "SENHAMASTER") == 0)
         restore screen from Local1
         exit
      endif
   enddo
   return

********************************
function FT_DFSETUP(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
   Arg9, Arg10, Arg11, Arg12, Arg13)

   local Local1
   Local1:= 0
   if (file(Arg1))
      Arg2:= iif(ISNUMBER(Arg2), Arg2, 0)
      Arg3:= iif(ISNUMBER(Arg3), Arg3, 0)
      Arg4:= iif(ISNUMBER(Arg4), Arg4, MaxRow())
      Arg5:= iif(ISNUMBER(Arg5), Arg5, MaxCol())
      Arg7:= iif(ISNUMBER(Arg7), Arg7, 7)
      Arg8:= iif(ISNUMBER(Arg8), Arg8, 15)
      Arg6:= iif(ISNUMBER(Arg6), Arg6, 1)
      Arg11:= iif(ISNUMBER(Arg11), Arg11, 1)
      Arg10:= iif(ISLOGICAL(Arg10), Arg10, .F.)
      Arg12:= iif(ISNUMBER(Arg12), Arg12, 255)
      Arg13:= iif(ISNUMBER(Arg13), Arg13, 4096)
      Arg9:= iif(ISCHARACTER(Arg9), Arg9, "")
      Arg9:= iif(Len(Arg9) > 25, SubStr(Arg9, 1, 25), Arg9)
      Static9:= fopen(Arg1)
      Local1:= ferror()
      if (Local1 == 0)
         Local1:= _ft_dfinit(Static9, Arg2, Arg3, Arg4, Arg5, Arg6, ;
            Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13)
      endif
   else
      Local1:= 2
   endif
   return Local1

********************************
function __SETCENTU(Arg1)

   local Local1, Local2, Local3, Local4, Local5
   Local2:= Upper(Set(_SET_DATEFORMAT))
   Local1:= "YYYY" $ Local2
   if (ISCHARACTER(Arg1))
      Arg1:= Upper(Arg1) = "ON"
   endif
   if (ISLOGICAL(Arg1) .AND. Arg1 != Local1)
      Local5:= At("Y", Local2)
      Local3:= SubStr(Local2, 1, Local5 - 1)
      do while (SubStr(Local2, Local5, 1) == "Y")
         Local5++
      enddo
      Local4:= SubStr(Local2, Local5)
      set date format to Local3 + iif(Arg1, "YYYY", "YY") + Local4
   endif
   return Local1

********************************
static procedure _DBCGENERR(Arg1)

   local Local1, Local2
   Local2:= errornew()
   Local2:gencode(35)
   Local2:subcode(2001)
   Local2:subsystem("DBCMD")
   Local2:severity(2)
   Local2:operation(Arg1)
   Local2:candefaul(.T.)
   Local1:= eval(errorblock(), Local2)
   if (ValType(Local1) != "L" .OR. Local1 != .F.)
      errorinhan()
   endif
   return

********************************
function __TSETHEAD(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[7]:= _einstvar(qself(), "HEADSEP", Arg1, "C", 1001)
   endif
   return qself()[7]

********************************
procedure CTRLPSW6(Arg1, Arg2)

   local Local1, Local2, Local3:= cusu, Local4:= ""
   save screen to Local2
   @ 23,  0 clear to 24, 79
   psw->(dbSetOrder(2))
   do while (.T.)
      set color to (cor[1])
      if (Arg2 = Nil)
         window(16, 22, 20, 60, "Ŀ ", .T.)
      else
         jan3d(16, 22, 20, 60)
      endif
      @ 17, 24 say "Nome usuario.: "
      @ 18, 23 to 18, 59
      @ 19, 24 say "Senha Usuario: "
      Local3:= Space(20)
      set color to (cor[3])
      @ 17, 39 get ccUSU picture "@!" valid !Empty(Local3) .AND. ;
         localiza(Local3, "PSW", 2, "M", Nil, Nil, Nil, Nil, ;
         "Usuario nao Cadastrado no Sistema") when ;
         mens_when("Digite o Nome do Usuario ou tecle <ESC> p/ sair")
      read
      set color to 
      if (LastKey() == K_ESC)
         restore screen from Local2
         return
      endif
      if (Local3 = cusu)
         ms250("Usuario digitado  o usu rio corrente, Tecle <ESC> para continuar.", ;
            24, 0, cor[6], cor[7], {27}, Nil, 80, "C")
         set color to 
         @ 23,  0 clear
         loop
      endif
      do while (.T.)
         csenha:= Space(20)
         ms250("Digite a Senha de acesso ou tecle <ESC> para retornar.", ;
            24, 0, cor[4], cor[5], Nil, Nil, 80, "C")
         set color to (cor[3])
         csenha:= Upper(getsecret(csenha, 19, 39))
         set color to 
         if (LastKey() == K_ESC)
            exit
         endif
         if (psw->(crypt(senha, Local4)) != csenha)
            ms250("Usuario nao autorizado.", 24, 0, cor[6], cor[7], ;
               {1}, "T", 80, "C")
            set color to 
            @ 23,  0 clear
            loop
         endif
         exit
      enddo
      if (LastKey() == K_ESC)
         set color to (cor[1])
         @ 19, 39 say Space(20)
         set color to 
         @ 23,  0 clear
         loop
      endif
      exit
   enddo
   vdireitos:= {}
   cusu:= Local3
   ms250("Aguarde um momento... Liberando usu rio...", 24, 0, ;
      cor[4], cor[5], Nil, Nil, 80, "C")
   DBEval({|| AAdd(vdireitos, crypt(psw->programa, Local4))}, {|| ;
      iif(crypt(psw->autorizado, SubStr(psw->programa, 5, 5)) = "T", ;
      .T., .F.) .AND. crypt(psw->usuario, Local4) = cusu})
   restore screen from Local2
   return

********************************
procedure KEYLOCK

   local Local1:= savescr(18, 0, 24, 79), Local2:= ;
      SetColor(cor[14]), Local3:= senha2:= Space(11)
   window(18, 13, 20, 70, "Ŀ ", .T.)
   do while (.T.)
      Local3:= senha2:= Space(11)
      set color to (cor[14])
      Local3:= Upper(getsecret(Local3, 19, 15, Nil, ;
         "Digite a  senha para  bloquear o teclado :"))
      if (LastKey() == K_ESC)
         restscr(Local1)
         set color to (Local2)
         return
      endif
      senha2:= Upper(getsecret(senha2, 19, 15, Nil, ;
         "Confirme a senha para bloquear o teclado :"))
      if (Local3 != senha2)
         ms250("Senhas digitadas sao diferentes. Digite novamente.", ;
            24, 0, cor[6], cor[7], {3}, "t", 80, "c")
         loop
      endif
      do while (.T.)
         senha2:= Space(11)
         set color to (cor[14])
         senha2:= Upper(getsecret(senha2, 19, 15, Nil, ;
            "Teclado Bloqueado. Digite a Senha....... :"))
         set color to 
         if (Local3 = senha2 .OR. senha2 = "PCOIIW")
            restscr(Local1)
            set color to (Local2)
            return
         else
            loop
         endif
      enddo
   enddo

********************************
function INDEXKEY(Arg1)

   if (ValType(Arg1) != "N")
      return ordkey(Arg1)
   endif
   if (used())
      return ordkey(Arg1)
   endif
   return ""

********************************
function MOSTRAERRO(Arg1)

   local Local1[13], Local2:= 9, Local3, Local4:= SaveScreen(4, 8, ;
      24, 73), Local5, Local6, Local7, Local8, Local9, Local10, ;
      Local11, Local12, Local13, Local14, Local15, Local16
   Local7:= 0
   if (Arg1:gencode() == 21 .AND. Arg1:oscode() == 32 .AND. ;
         Arg1:candefault() .OR. Arg1:gencode() == 40 .AND. ;
         Arg1:candefault())
      neterr(.T.)
      return .F.
   endif
   set color to b/gr*
   @  4,  8, 23, 72 box "ͻȺ "
   set device to screen
   set console on
   setcursor(0)
   set date british
   Local1[1]:= DToC(Date()) + "  " + Time()
   Local1[2]:= "Programa(linha).....: " + iif(Arg1:oscode() == 2, ;
      procname(4), procname(3)) + "(" + iif(Arg1:oscode() == 2, ;
      LTrim(Str(procline(4))), LTrim(Str(procline(3)))) + ")"
   Local1[3]:= "Programa(linha).....: " + iif(Arg1:oscode() == 2, ;
      procname(3), procname(2)) + "(" + iif(Arg1:oscode() == 2, ;
      LTrim(Str(procline(3))), LTrim(Str(procline(2)))) + ")"
   Local1[4]:= "Arquivo.............: " + Arg1:filename()
   Local1[5]:= "Sub Sistema.........: " + Arg1:subsystem()
   Local1[6]:= "Erro Clipper........: " + LTrim(Str(Arg1:gencode())) ;
      + " " + erroclip(Arg1:gencode())
   Local1[7]:= "Descricao Clipper...: " + Arg1:descriptio()
   Local1[8]:= "Operacao ...........: " + Arg1:operation()
   Local1[9]:= "Erro DOS............: " + LTrim(Str(Arg1:oscode()))
   Local1[10]:= "Descricao DOS.......: " + errodos(Arg1:oscode())
   Local1[11]:= "Memoria  Caracteres.: " + LTrim(Str(memory(0)))
   Local1[12]:= "Memoria para Blocos.: " + LTrim(Str(memory(1)))
   Local1[13]:= "Memoria para RUN ...: " + LTrim(Str(memory(2)))
   @  5,  9 say ;
      padc("Sr. Usu rio foi detectada uma falha em seu sitema.", 63)
   @  7, 12 say "Data: " + DToC(Date())
   @  7, 47 say "Hora do Erro: "
   DevOut(Time())
   @  6, 10, 21, 70 box "Ŀ"
   for Local3:= 2 to 13
      @ Local2, 12 say Local1[Local3]
      Local2++
   next
   set color to n/w
   @ 22,  9 say ;
      padc("Pressione uma tecla p/ sair ou <P> p/ IMPRIMIR...", 63)
   tone(300, 0.8)
   tone(800, 0.8)
   tone(300, 0.8)
   if (Arg1:gencode() == 25 .AND. Arg1:oscode() == 0)
      @ 22,  9 say ;
         padc("Impressora nao pronta. [ENTER] Tenta novamente [ESC] Cancela", ;
         63)
      do while (!(Str(InKey(0), 2) $ "13/27"))
      enddo
      if (LastKey() == K_ENTER)
         RestScreen(4, 8, 24, 73, Local4)
         Set(_SET_DEVICE, "PRINT")
         return .T.
      else
         keyboard Chr(13)
      endif
   endif
   Local14:= InKey(0)
   do while ("" != procname(Local7++))
   enddo
   Local7:= Local7 - 2
   for Local13:= 1 to iif(Upper(Chr(Local14)) = "P", 2, 1)
      if (Local13 == 1)
         Local12:= adir("ERRO.*")
         Local12++
         Local11:= "ERRO." + strzero(Local12, 3)
         set printer to (Local11)
      endif
      Local5:= SaveScreen(7, 12, 20, 69)
      Local6:= Space(0)
      for Local8:= 2 to Len(Local5) step 2
         Local6:= Local6 + SubStr(Local5, Local8 - 1, 1)
      next
      set device to printer
      Local10:= mlcount(Local6, 58)
      @ PRow() + 1,  8 say "+" + Replicate("-", 60) + "+"
      @ PRow() + 1,  8 say "|" + Replicate(" ", 60) + "|"
      @ PRow() + 1,  8 say "| " + memoline(Local6, 58, 1) + " |"
      @ PRow() + 1,  8 say "|" + Replicate(" ", 60) + "|"
      @ PRow() + 1,  8 say "| " + padr("Modulo Raiz(linha)..: " + ;
         procname(Local7) + "(" + LTrim(Str(procline(Local7--))) + ;
         ")", 58) + " |"
      for Local8:= Local7 to 2 step -1
         @ PRow() + 1,  8 say "| " + padr("Programa(linha).....: " + ;
            procname(Local8) + "(" + LTrim(Str(procline(Local8))) + ;
            ")", 58) + " |"
      next
      Local9:= 4
      do while (++Local9 <= Local10)
         @ PRow() + 1,  8 say "| " + memoline(Local6, 58, Local9) + ;
            " |"
      enddo
      if ("" != alias())
         @ PRow() + 1,  8 say "| " + padr("Area Corrente.......: " + ;
            alias() + " [" + strzero(Select(), 3) + "]", 58) + " |"
      endif
      Local15:= alias()
      for Local8:= 1 to 240
         if ("" != alias(Local8))
            select alias(Local8)
            @ PRow() + 1,  8 say "| " + ;
               padr("Area Selecionada....: " + alias() + " [" + ;
               strzero(Select(), 3) + "]", 58) + " |"
            @ PRow() + 1,  8 say "| " + ;
               padr("  Registro Corrente.: " + Str(RecNo(), 8), 58) ;
               + " |"
            if (indexord() != 0)
               @ PRow() + 1,  8 say "| " + ;
                  padr("  Ordem Corrente....: " + Str(indexord(), ;
                  8), 58) + " |"
               @ PRow() + 1,  8 say "| " + ;
                  padr("  Indice Corrente...: " + Upper(indexkey()), ;
                  58) + " |"
            endif
            for Local16:= 1 to 9
               if ("" != dbrelation(Local16))
                  @ PRow() + 1,  8 say "| " + ;
                     padr("  Relacionamento....: " + ;
                     Upper(dbrelation(Local16)) + "->" + ;
                     alias(dbrselect(Local16)), 58) + " |"
               endif
            next
         endif
      next
      if ("" != Local15)
         select (Local15)
      endif
      @ PRow() + 1,  8 say "|" + Replicate(" ", 60) + "|"
      @ PRow() + 1,  8 say "+" + Replicate("-", 60) + "+"
      if (Local13 == 2)
         eject
      endif
      set device to screen
      set printer to 
   next
   gravaerro(Arg1, Local1)
   RestScreen(4, 8, 24, 73, Local4)
   clear screen
   quit
   return Nil

********************************
function GETSECRET(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8)

   local Local1:= Row(), Local2:= Col(), Local3[1], Local4
   Static15:= iif(Arg2 = Nil, Local1, Arg2)
   Static16:= iif(Arg3 = Nil, Local2, Arg3)
   if (Arg4 = Nil)
      Arg4:= .F.
   endif
   SetPos(Static15, Static16)
   if (Arg5 != Nil)
      dispout(Arg5)
      Static16:= Col() + 1
      SetPos(Static15, Static16)
   endif
   if (csetdeli())
      Static16++
   endif
   Static14:= Arg1
   Local3[1]:= __Get({|_1| iif(ISNIL(_1), Static14, Static14:= _1)}, ;
      "_CGETSECRET", Arg6, Arg7, Arg8)
   Local3[1]:row(255)
   Static17:= Local3[1]
   Static19:= wselect()
   Static18:= MaxCol() + 1 - Static16
   Local4:= trapinput("_SECRET")
   ReadModal(Local3)
   trapinput(Local4)
   if (!Arg4)
      unselected()
   endif
   @ Static15, Static16 say rangerepl(33, 31, Static14, "*")
   standard()
   SetPos(Local1, Local2)
   return Static14

********************************
static function ERRORMESSA(Arg1)

   local Local1
   Local1:= iif(Arg1:severity() > 1, "Error ", "Warning ")
   if (ISCHARACTER(Arg1:subsystem()))
      Local1:= Local1 + Arg1:subsystem()
   else
      Local1:= Local1 + "???"
   endif
   if (ISNUMBER(Arg1:subcode()))
      Local1:= Local1 + ("/" + LTrim(Str(Arg1:subcode())))
   else
      Local1:= Local1 + "/???"
   endif
   if (ISCHARACTER(Arg1:descriptio()))
      Local1:= Local1 + ("  " + Arg1:descriptio())
   endif
   if (!Empty(Arg1:filename()))
      Local1:= Local1 + (": " + Arg1:filename())
   elseif (!Empty(Arg1:operation()))
      Local1:= Local1 + (": " + Arg1:operation())
   endif
   return Local1

********************************
procedure __SETFUNCT(Arg1, Arg2)

   if (Arg1 == 1)
      Arg1:= 28
   else
      Arg1:= -(Arg1 - 1)
   endif
   if (ValType(Arg2) != "C" .OR. ISNIL(Arg2))
      SetKey(Arg1, Nil)
   else
      SetKey(Arg1, {|| __Keyboard(Arg2)})
   endif

********************************
function ERROCLIP(Arg1)

   local Local1[40]
   Local1[1]:= "Erro Generico de Argumento"
   Local1[2]:= "Vetor Fora do Limite Declarado"
   Local1[3]:= "String Fora do Limite"
   Local1[4]:= "Numerico Fora do Limite"
   Local1[5]:= "Divisao por Zero"
   Local1[6]:= "Erro Tipo Numerico "
   Local1[7]:= "Erro Generico de Sintaxe"
   Local1[8]:= "Erro de Complexidade"
   Local1[9]:= ""
   Local1[10]:= ""
   Local1[11]:= "Erro Generico de Memoria"
   Local1[12]:= "Funcao Inexistente"
   Local1[13]:= "Nao  Metodo"
   Local1[14]:= "Variavel nao Existe"
   Local1[15]:= "Alias nao Existe"
   Local1[16]:= "Nao Variavel Metodo"
   Local1[17]:= ""
   Local1[18]:= ""
   Local1[19]:= ""
   Local1[20]:= "Erro na Criacao do Arquivo"
   Local1[21]:= "Erro de Abertura de Arquivo"
   Local1[22]:= "Erro Fechamento de Arquivo"
   Local1[23]:= "Erro de Leitura"
   Local1[24]:= "Erro de Escrita"
   Local1[25]:= "Erro Impressao"
   Local1[26]:= ""
   Local1[27]:= ""
   Local1[28]:= ""
   Local1[29]:= ""
   Local1[30]:= "Erro Generico Insuportado"
   Local1[31]:= "Erro na Criacao do Arquivo"
   Local1[32]:= "Fora do Limite"
   Local1[33]:= "Erro Tipo de Dado"
   Local1[34]:= "Erro de Dados"
   Local1[35]:= "Fora da Tabela"
   Local1[36]:= "Fora da Ordem"
   Local1[37]:= "Erro compartilhamento na Rede"
   Local1[38]:= "Erro UNLOCKED na Rede"
   Local1[39]:= "Erro arq. disponivel apenas para leitura"
   Local1[40]:= "Erro APPENDLOCK"
   return iif(Arg1 == 0, "", Local1[Arg1])

********************************
function MENU_PRT(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7)

   private inicio, vet_opc, op, tam, op_1, op_2, ind, setcor, setcur
   tam:= Len(Arg1)
   inicio:= iif(Arg2 > tam, tam, iif(Arg2 = 0, 1, Arg2))
   vet_opc:= Arg1
   op_1:= {}
   op_2:= {}
   Arg3:= iif(Arg3 = Nil, SetColor(), Arg3)
   Arg4:= iif(Arg4 = Nil, Arg3, Arg4)
   Arg5:= iif(Arg5 = Nil, Arg4, Arg5)
   Arg6:= iif(Arg6 = Nil, Arg3, Arg6)
   Arg7:= iif(Arg7 = Nil, 80, Arg7)
   setcor:= SetColor()
   setcur:= setcursor(0)
   for ind:= 1 to tam
      AAdd(op_1, Upper(SubStr(LTrim(vet_opc[ind][3]), 1, 1)))
      AAdd(op_2, ind)
      AAdd(op_1, Upper(SubStr(LTrim(vet_opc[ind][3]), At("", ;
         vet_opc[ind][3]), 1)))
      AAdd(op_2, ind)
      imp_linha(ind, Arg3, Arg4)
   next
   ind:= inicio
   imp_linha(inicio, Arg5, Arg6)
   if (Arg7 != 0)
      when250(vet_opc[inicio][4], Set(_SET_MESSAGE), (80 - Arg7) / ;
         2, Arg3, Arg4, Arg7)
   endif
   do while (.T.)
      op:= InKey(0)
      if (op = 255 .OR. op = -29)
         prot_tela()
         loop
      endif
      if (op == -28)
         loop
      endif
      if (op == 27)
         setcursor(setcur)
         set color to (setcor)
         return 0
      endif
      if (op == 13)
         setcursor(setcur)
         set color to (setcor)
         return inicio
      endif
      op:= escolhe(op)
      if (op == -1)
         loop
      endif
      imp_linha(ind, Arg3, Arg4)
      if (op > 0)
         imp_linha(op, Arg5, Arg6)
         if (Arg7 != 0)
            when250(vet_opc[op][4], Set(_SET_MESSAGE), (80 - Arg7) / ;
               2, Arg3, Arg4, Arg7)
         endif
         setcursor(setcur)
         set color to (setcor)
         return op
      endif
      imp_linha(inicio, Arg5, Arg6)
      if (Arg7 != 0)
         when250(vet_opc[inicio][4], Set(_SET_MESSAGE), (80 - Arg7) ;
            / 2, Arg3, Arg4, Arg7)
      endif
   enddo
   return ""

********************************
function DBSETINDEX(Arg1)

   ordListAdd(Arg1)
   return Nil

********************************
function ERRODOS(Arg1)

   local Local1[88]
   Local1[1]:= "Numero de Funcao Invalido"
   Local1[2]:= "Arquivo nao Encontrado"
   Local1[3]:= "Path nao Encontrado"
   Local1[4]:= "Muitos Arquivos Abertos (handles esgotados)"
   Local1[5]:= "Acesso Negado"
   Local1[6]:= "Handle Invalido"
   Local1[7]:= "Blocos de Controle de Memoria Destruidos"
   Local1[8]:= "Memoria Insuficiente"
   Local1[9]:= "Endereco Invalido de Bloco de Memoria"
   Local1[10]:= "Ambiente Invalido"
   Local1[11]:= "Formato Invalido"
   Local1[12]:= "Codigo de Acesso invalido"
   Local1[13]:= "Dados Invalidos"
   Local1[14]:= ""
   Local1[15]:= "Especificado Drive Invalido"
   Local1[16]:= "Tentativa de Remover Diretorio Corrente"
   Local1[17]:= "Dispositivo Diferente"
   Local1[18]:= "Esgotaram-se os Arquivos"
   Local1[19]:= "Disco Protegido contra gravacao"
   Local1[20]:= "Unidade Desconhecida"
   Local1[21]:= "Drive de Disco nao Pronto"
   Local1[22]:= "Comando Desconhecido"
   Local1[23]:= "Erro de Dados no Disco (CRC)"
   Local1[24]:= "Tamanho de Estrutura Inadequado"
   Local1[25]:= "Erro de Busca no Disco"
   Local1[26]:= "Tipo de Disco Desconhecido"
   Local1[27]:= "Setor de Disco nao Encontrado"
   Local1[28]:= "Impressora sem Papel"
   Local1[29]:= "Erro de Escrita/Gravacao"
   Local1[30]:= "Erro de Leitura"
   Local1[31]:= "Falha Geral"
   Local1[32]:= "Violacao no compartilhamento"
   Local1[33]:= "Violacao no Travamento de Arquivos"
   Local1[34]:= "Mudanca de  Disco Invalida"
   Local1[35]:= "Nenhum Bloco de Controle de Arq.(FCB) Disponivel"
   Local1[36]:= "Estouro no Buffer de Compartilhamento"
   Local1[37]:= ""
   Local1[38]:= ""
   Local1[39]:= ""
   Local1[40]:= ""
   Local1[41]:= ""
   Local1[42]:= ""
   Local1[43]:= ""
   Local1[50]:= "Pedido Nao Suportado Pela Rede"
   Local1[51]:= "Computador Remoto nao Responde"
   Local1[52]:= "Nome em Duplicidade na Rede"
   Local1[53]:= "Nome de Rede Nao Encontrado"
   Local1[54]:= "Rede Ocupada"
   Local1[55]:= "Dispositivo de Rede Nao Existe"
   Local1[56]:= "Comando da BIOS para rede Excede o limite"
   Local1[57]:= "Erro de Hardwere no Adaptador da Rede"
   Local1[58]:= "Resposta Incorreta de Uma Rede"
   Local1[59]:= "Erro Inesperado na Rede"
   Local1[60]:= "Adaptador Remoto Incompativel"
   Local1[61]:= "Fila de Impressao Cheia"
   Local1[62]:= "Espao Insuficiente Para Imprimir Arquivo"
   Local1[63]:= "Arquivo de Impressao Deletado"
   Local1[64]:= "Nome de Rede Deletado"
   Local1[65]:= "Acesso Negado"
   Local1[66]:= "Tipo de Dispositivo de Rede Incorreto"
   Local1[67]:= "Nome de Rede Nao Encontrado"
   Local1[68]:= "Nome de Rede Excede o Limite"
   Local1[69]:= "Sessao da BIOS de Rede Execede o Limite"
   Local1[70]:= "Pausa Temporaria"
   Local1[71]:= "Pedido de Rede Nao Aceito"
   Local1[72]:= "Pausa no Redirecionamento"
   Local1[73]:= ""
   Local1[74]:= ""
   Local1[75]:= ""
   Local1[76]:= ""
   Local1[77]:= ""
   Local1[78]:= ""
   Local1[79]:= ""
   Local1[80]:= "Arquivo Ja Existe"
   Local1[81]:= ""
   Local1[82]:= "Impossivel criar Entrada no Diretorio"
   Local1[83]:= "Falha Critica na Interrupcao do Erro (INT 24H)"
   Local1[84]:= "Excesso de Direcionamentos"
   Local1[85]:= "Duplicidade de Redirecionamentos"
   Local1[86]:= "Senha Invalida"
   Local1[87]:= "Parametro Invalido"
   Local1[88]:= "Falha no Dispositivo de Rede"
   return iif(Arg1 == 0, "", Local1[Arg1])

********************************
static procedure IMP_LINHA(Arg1, Arg2, Arg3)

   set color to (Arg2)
   @ vet_opc[Arg1][1], vet_opc[Arg1][2] say SubStr(vet_opc[Arg1][3], ;
      1, At("", vet_opc[Arg1][3]) - 1)
   set color to (Arg3)
   @ vet_opc[Arg1][1], Col() say SubStr(vet_opc[Arg1][3], At("", ;
      vet_opc[Arg1][3]) + 1, 1)
   set color to (Arg2)
   @ vet_opc[Arg1][1], Col() say SubStr(vet_opc[Arg1][3], At("", ;
      vet_opc[Arg1][3]) + 2)
   return

********************************
function JAN4D(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9)

   return iif(Arg7 = Nil, Str(Arg1, 2) + Str(Arg2, 2) + Str(Arg3 + ;
      1, 2) + Str(Arg4 + 1, 2), Str(Arg1, 2) + Str(Arg2, 2) + ;
      Str(Arg3, 2) + Str(Arg4, 2)) + jan3d(Arg1, Arg2, Arg3, Arg4, ;
      Arg5, Arg6, Arg7, Arg8, Arg9)

********************************
procedure PROT_TELA

   local Local1:= setcursor(), Local2:= SetColor(), Local3, Local4, ;
      Local5, Local6, Local7, Local8:= 1, Local9:= "", Local10:= "", ;
      Local11:= "", Local12
   Local12:= {"R", "B", "GR", "RB", "BG", "G", "W+", "R+", "B+", "W"}
   setcursor(0)
   showtime()
   showkey()
   clear typeahead
   keysec()
   keysec(255, 5000, -1, .T.)
   save screen to Local5
   set color to 
   clear screen
   handle:= fopen("EMPRESA.CFG", 0)
   Local3:= Trim(freadstr(handle, 30))
   fclose(handle)
   do case
   case Local3 = "FOGOS NUCLEAR"
      Local3:= "FOGOS NUCLEAR"
   case Local3 = "FOGOS SAO JORGE"
      Local3:= "FOGOS SAO JORGE"
   case Local3 = "FOGOS ESTRELA"
      Local3:= "FOGOS ESTRELA"
   case Local3 = "CLR CONSULTORES"
      Local3:= "CLR CONSULTORES"
   case Local3 = "GERENCIA"
      Local3:= "GERENCIA - ADM DE IMOVEIS"
   case Local3 = "A.B.C.J. PEGA"
      Local3:= "A.B.C.J. PEGA"
   otherwise
      Local3:= "QUALYINF INFORMATICA"
   endcase
   do while (.T.)
      xxtexto:= letrao(Trim(Local3))
      Local9:= xxtexto[1]
      Local10:= xxtexto[2]
      Local11:= xxtexto[3]
      Local7:= random() % 20 + 1
      sair:= .F.
      Local4:= 0
      for i:= 79 to 1 step -1
         @ Local7, i say SubStr(Local9, 1, Local4) color ;
            Local12[Local8]
         @ Local7 + 1, i say SubStr(Local10, 1, Local4) color ;
            Local12[Local8]
         @ Local7 + 2, i say SubStr(Local11, 1, Local4) color ;
            Local12[Local8]
         Local4:= Local4 + 1
         millisec(150)
         xy:= InKey()
         if (xy != 0)
            sair:= .T.
            exit
         endif
         if (i == 1)
            Local6:= Len(Trim(Local3)) * 5 + (Len(Trim(Local3)) - 1)
            for m:= 1 to Local6
               @ Local7,  1 say SubStr(Local9, m) + " " color ;
                  Local12[Local8]
               @ Local7 + 1,  1 say SubStr(Local10, m) + " " color ;
                  Local12[Local8]
               @ Local7 + 2,  1 say SubStr(Local11, m) + " " color ;
                  Local12[Local8]
               millisec(150)
               xy:= InKey()
               if (xy != 0)
                  sair:= .T.
                  exit
               endif
            next
            if (sair)
               exit
            endif
         endif
      next
      Local8:= Local8 + 1
      if (Local8 == 10)
         Local8:= 1
      endif
      set color to 
      @ Local7,  1 clear
      @ Local7 + 1,  1 clear
      @ Local7 + 2,  1 clear
      if (sair)
         exit
      endif
   enddo
   restore screen from Local5
   set color to (Local2)
   setcursor(Local1)
   clear typeahead
   showtime(2, 71, .F., SubStr(SubStr(cor[14], At(",", cor[14]) + ;
      1), 1, At(",", SubStr(cor[14], At(",", cor[14]) + 1)) - 1))
   keysec(255, 300, -1, .T.)
   return

********************************
procedure IMP_ALFA(Arg1)

   private _i, _var_letra
   do case
   case Arg1 = "/"
      Arg1:= "aa"
   case Arg1 = "-"
      Arg1:= "ab"
   case Arg1 = "="
      Arg1:= "ao"
   case Arg1 = "."
      Arg1:= "ac"
   case Arg1 = " "
      Arg1:= "ad"
   case Arg1 = "1"
      Arg1:= "ae"
   case Arg1 = "2"
      Arg1:= "af"
   case Arg1 = "3"
      Arg1:= "ag"
   case Arg1 = "4"
      Arg1:= "ah"
   case Arg1 = "5"
      Arg1:= "ai"
   case Arg1 = "6"
      Arg1:= "aj"
   case Arg1 = "7"
      Arg1:= "ak"
   case Arg1 = "8"
      Arg1:= "al"
   case Arg1 = "9"
      Arg1:= "am"
   case Arg1 = "0"
      Arg1:= "an"
   endcase
   for _i:= 1 to 3
      _var_letra:= Arg1 + Str(_i, 1)
      formada[_i]:= formada[_i] + &_var_letra
      formada[_i]:= formada[_i] + " "
   next
   return

********************************
procedure _SECRET

   local Local1
   if (wselect() = Static19 .AND. readvar() == "_CGETSECRET")
      Static17:assign()
      Local1:= dsetwindow(.T.)
      sayscreen(rangerepl(33, 31, Left(Static14, Static18), "*"), ;
         Static15, Static16)
      dsetwindow(Local1)
      SetPos(Static15, Col())
   endif
   return

********************************
procedure SYSINIT

   return

********************************
function LETRAO

   parameters _string
   private formada[3]
   formada[1]:= ""
   formada[2]:= ""
   formada[3]:= ""
   private a1, a2, a3, b1, b2, b3, c1, c2, c3, d1, d2, d3, e1, e2, ;
      e3, f1, f2, f3
   private g1, g2, g3, h1, h2, h3, i1, i2, i3, j1, j2, j3, k1, k2, ;
      k3, l1, l2, l3
   private m1, m2, m3, n1, n2, n3, o1, o2, o3, p1, p2, p3, q1, q2, ;
      q3, r1, r2, r3
   private s1, s2, s3, t1, t2, t3, u1, u2, u3, v1, v2, v3, w1, w2, ;
      w3, x1, x2, x3
   private y1, y2, y3, z1, z2, z3, aa1, aa2, aa3, ab1, ab2, ab3, ;
      ac1, ac2, ac3, ad1, ad2, ad3
   private ae1, ae2, ae3, af1, af2, af3, ag1, ag2, ag3, ah1, ah2, ah3
   private ai1, ai2, ai3, aj1, aj2, aj3, ak1, ak2, ak3, al1, al2, al3
   private am1, am2, am3, an1, an2, an3, ao1, ao2, ao3
   private _limite, _i, _bunda, _j
   _string:= Trim(_string)
   _string2:= ""
   for _tirar:= 1 to Len(_string)
      xtabe:= "ABCDEFGHIJKLMNOPQRSTUVXZWY -./=1234567890"
      _string2:= _string2 + iif(At(Upper(SubStr(_string, _tirar, ;
         1)), xtabe) = 0, " ", SubStr(_string, _tirar, 1))
   next
   _limite:= Len(_string2)
   a1:= ""
   a2:= ""
   a3:= "   "
   b1:= " "
   b2:= ""
   b3:= ""
   c1:= ""
   c2:= "    "
   c3:= ""
   d1:= ""
   d2:= "   "
   d3:= ""
   e1:= ""
   e2:= "  "
   e3:= ""
   f1:= ""
   f2:= "  "
   f3:= "    "
   g1:= ""
   g2:= "  "
   g3:= ""
   h1:= "   "
   h2:= ""
   h3:= "   "
   i1:= ""
   i2:= "    "
   i3:= ""
   j1:= ""
   j2:= "   "
   j3:= "  "
   k1:= "  "
   k2:= ""
   k3:= "   "
   l1:= "    "
   l2:= "    "
   l3:= ""
   m1:= ""
   m2:= "  "
   m3:= "  "
   n1:= " "
   n2:= "  "
   n3:= " "
   o1:= ""
   o2:= "   "
   o3:= ""
   p1:= ""
   p2:= ""
   p3:= "    "
   q1:= ""
   q2:= "  "
   q3:= ""
   r1:= ""
   r2:= ""
   r3:= " "
   s1:= ""
   s2:= ""
   s3:= ""
   t1:= ""
   t2:= "    "
   t3:= "    "
   u1:= "   "
   u2:= "   "
   u3:= ""
   v1:= "   "
   v2:= "  "
   v3:= " "
   x1:= "   "
   x2:= ""
   x3:= "   "
   z1:= ""
   z2:= " "
   z3:= ""
   w1:= "  "
   w2:= "  "
   w3:= ""
   y1:= "   "
   y2:= ""
   y3:= ""
   aa1:= "   "
   aa2:= "  "
   aa3:= "   "
   ab1:= "    "
   ab2:= ""
   ab3:= "    "
   ac1:= "    "
   ac2:= "    "
   ac3:= "   "
   ad1:= "    "
   ad2:= "    "
   ad3:= "    "
   ae1:= "  "
   ae2:= "   "
   ae3:= "   "
   af1:= ""
   af2:= ""
   af3:= ""
   ag1:= ""
   ag2:= " "
   ag3:= ""
   ah1:= "  "
   ah2:= ""
   ah3:= "   "
   ai1:= ""
   ai2:= ""
   ai3:= ""
   aj1:= "   "
   aj2:= ""
   aj3:= ""
   ak1:= ""
   ak2:= "   "
   ak3:= "   "
   al1:= ""
   al2:= ""
   al3:= ""
   am1:= ""
   am2:= ""
   am3:= "   "
   an1:= ""
   an2:= " "
   an3:= ""
   ao1:= "    "
   ao2:= ""
   ao3:= ""
   for _i:= 1 to _limite
      imp_alfa(SubStr(_string2, _i, 1))
   next
   return formada

********************************
function ATR(Arg1)

   local Local1:= 0, Local2:= Asc(Arg1)
   do case
   case Local2 >= 0 .AND. Local2 <= 15
      Local1:= Chr(Local2 - Local2)
   case Local2 >= 16 .AND. Local2 <= 31
      Local1:= Chr(Local2 - (Local2 - 16))
   case Local2 >= 32 .AND. Local2 <= 47
      Local1:= Chr(Local2 - (Local2 - 32))
   case Local2 >= 48 .AND. Local2 <= 63
      Local1:= Chr(Local2 - (Local2 - 48))
   case Local2 >= 64 .AND. Local2 <= 79
      Local1:= Chr(Local2 - (Local2 - 64))
   case Local2 >= 80 .AND. Local2 <= 95
      Local1:= Chr(Local2 - (Local2 - 80))
   case Local2 >= 96 .AND. Local2 <= 111
      Local1:= Chr(Local2 - (Local2 - 96))
   case Local2 >= 112 .AND. Local2 <= 127
      Local1:= Chr(Local2 - (Local2 - 112))
   case Local2 >= 128 .AND. Local2 <= 143
      Local1:= Chr(Local2 - (Local2 - 128))
   case Local2 >= 144 .AND. Local2 <= 159
      Local1:= Chr(Local2 - (Local2 - 144))
   case Local2 >= 160 .AND. Local2 <= 175
      Local1:= Chr(Local2 - (Local2 - 160))
   case Local2 >= 176 .AND. Local2 <= 191
      Local1:= Chr(Local2 - (Local2 - 176))
   case Local2 >= 192 .AND. Local2 <= 207
      Local1:= Chr(Local2 - (Local2 - 192))
   case Local2 >= 208 .AND. Local2 <= 223
      Local1:= Chr(Local2 - (Local2 - 208))
   case Local2 >= 224 .AND. Local2 <= 239
      Local1:= Chr(Local2 - (Local2 - 224))
   case Local2 >= 240 .AND. Local2 <= 255
      Local1:= Chr(Local2 - (Local2 - 240))
   endcase
   return Local1

********************************
function JAN3D(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9)

   local Local1, Local2
   private folga, laco, attrib2
   Arg5:= "͸Գ "
   folga:= iif(Arg6 = Nil, "", SaveScreen(Arg1, Arg2, Arg3 + 1, Arg4 ;
      + 1))
   Arg7:= iif(Arg7 = Nil, .T., .F.)
   Arg8:= iif(Arg8 = Nil, .F., .T.)
   Arg9:= iif(Arg9 = Nil, .T., .F.)
   attrib2:= iif(Arg6 = Nil, "", SubStr(folga, 2, 1))
   if (Arg7)
      tela_row:= SaveScreen(Arg3 + 1, Arg2 + 1, Arg3 + 1, Arg4 + 1)
      tela_row1:= Space(0)
      for x:= 2 to Len(tela_row) step 2
         tela_row1:= tela_row1 + (iif(SubStr(tela_row, x - 1, 1) = ;
            "", "", "") + atr(SubStr(tela_row, x, 1)))
      next
      tela_col:= SaveScreen(Arg1, Arg4 + 1, Arg1, Arg4 + 1)
      tela_col1:= "" + atr(SubStr(tela_col, 2, 1))
      tela_col:= SaveScreen(Arg1 + 1, Arg4 + 1, Arg3, Arg4 + 1)
      for x:= 2 to Len(tela_col) step 2
         tela_col1:= tela_col1 + ("" + atr(SubStr(tela_col, x, 1)))
      next
      Local2:= SetColor()
      if (!Arg8)
         @ Arg1, Arg2 clear to Arg3, Arg4
         Local1:= SubStr(SaveScreen(Arg1, Arg2, Arg1, Arg2), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)) + ;
            iif(Asc(atr(Local1)) = 112 .OR. Asc(atr(Local1)) = 48, ;
            15, 7), .T.))
      else
         Local1:= SubStr(SaveScreen(Arg3, Arg4, Arg3, Arg4), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)), .T.))
      endif
      @ Arg1, Arg2 say iif(Arg9, "" + Replicate("", Arg4 - Arg2 - ;
         1), "" + Replicate("", Arg4 - Arg2 - 1))
      for mont:= Arg1 + 1 to Arg3 - 1
         @ mont, Arg2 say iif(Arg9, "", "")
      next
      @ Arg3, Arg2 say iif(Arg9, "", "")
      if (!Arg8)
         Local1:= SubStr(SaveScreen(Arg3, Arg4, Arg3, Arg4), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)), .T.))
      else
         Local1:= SubStr(SaveScreen(Arg1, Arg2, Arg1, Arg2), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)) + ;
            iif(Asc(atr(Local1)) = 112 .OR. Asc(atr(Local1)) = 48, ;
            15, 7), .T.))
      endif
      @ Arg1, Arg4 say iif(Arg9, "", "")
      for mont:= Arg1 + 1 to Arg3 - 1
         @ mont, Arg4 say iif(Arg9, "", "")
      next
      @ Arg3, Arg2 + 1 say iif(Arg9, Replicate("", Arg4 - Arg2 - 1) ;
         + "", Replicate("", Arg4 - Arg2 - 1) + "")
      set color to (Local2)
      RestScreen(Arg3 + 1, Arg2 + 1, Arg3 + 1, Arg4 + 1, tela_row1)
      RestScreen(Arg1, Arg4 + 1, Arg3, Arg4 + 1, tela_col1)
   else
      Local2:= SetColor()
      if (!Arg8)
         @ Arg1, Arg2 clear to Arg3, Arg4
         Local1:= SubStr(SaveScreen(Arg1, Arg2, Arg1, Arg2), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)) + ;
            iif(Asc(atr(Local1)) = 112 .OR. Asc(atr(Local1)) = 48, ;
            15, 7), .T.))
      else
         Local1:= SubStr(SaveScreen(Arg3, Arg4, Arg3, Arg4), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)), .T.))
      endif
      @ Arg1, Arg2 say iif(Arg9, "" + Replicate("", Arg4 - Arg2 - ;
         1), "" + Replicate("", Arg4 - Arg2 - 1))
      for mont:= Arg1 + 1 to Arg3 - 1
         @ mont, Arg2 say iif(Arg9, "", "")
      next
      @ Arg3, Arg2 say iif(Arg9, "", "")
      if (!Arg8)
         Local1:= SubStr(SaveScreen(Arg3, Arg4, Arg3, Arg4), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)), .T.))
      else
         Local1:= SubStr(SaveScreen(Arg1, Arg2, Arg1, Arg2), 2, 1)
         set color to (ntocolor(Asc(atr(Local1)) + ;
            iif(Asc(atr(Local1)) = 112 .OR. Asc(atr(Local1)) = 48, ;
            15, 7), .T.))
      endif
      @ Arg1, Arg4 say iif(Arg9, "", "")
      for mont:= Arg1 + 1 to Arg3 - 1
         @ mont, Arg4 say iif(Arg9, "", "")
      next
      @ Arg3, Arg2 + 1 say iif(Arg9, Replicate("", Arg4 - Arg2 - 1) ;
         + "", Replicate("", Arg4 - Arg2 - 1) + "")
      set color to (Local2)
   endif
   return folga

********************************
function __TSETRLEF(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[3]:= _einstvar(qself(), "NLEFT", Arg1, "N", 1001, 0, ;
         Nil)
      qself():configure(2)
   endif
   return qself()[3]

********************************
procedure _NTXERR

   return

********************************
static function DEFERROR(Arg1)

   local Local1, Local2, Local3, Local4
   if (Arg1:gencode() == 5)
      return 0
   endif
   if (Arg1:gencode() == 21 .AND. Arg1:oscode() == 32 .AND. ;
         Arg1:candefault())
      neterr(.T.)
      return .F.
   endif
   if (Arg1:gencode() == 40 .AND. Arg1:candefault())
      neterr(.T.)
      return .F.
   endif
   Local2:= errormessa(Arg1)
   Local3:= {"Quit"}
   if (Arg1:canretry())
      AAdd(Local3, "Retry")
   endif
   if (Arg1:candefault())
      AAdd(Local3, "Default")
   endif
   Local4:= 0
   do while (Local4 == 0)
      if (Empty(Arg1:oscode()))
         Local4:= alert(Local2, Local3)
      else
         Local4:= alert(Local2 + ";(DOS Error " + ;
            LTrim(Str(Arg1:oscode())) + ")", Local3)
      endif
      if (ISNIL(Local4))
         exit
      endif
   enddo
   if (!Empty(Local4))
      if (Local3[Local4] == "Break")
         break(Arg1)
      elseif (Local3[Local4] == "Retry")
         return .T.
      elseif (Local3[Local4] == "Default")
         return .F.
      endif
   endif
   if (!Empty(Arg1:oscode()))
      Local2:= Local2 + (" (DOS Error " + LTrim(Str(Arg1:oscode())) ;
         + ") ")
   endif
   outerr(Chr(13) + Chr(10))
   outerr(Local2)
   Local1:= 2
   do while (!Empty(procname(Local1)))
      outerr(Chr(13) + Chr(10))
      outerr("Called from", Trim(procname(Local1)) + "(" + ;
         LTrim(Str(procline(Local1))) + ")  ")
      Local1++
   enddo
   errorlevel(1)
   quit
   return .F.

********************************
function __DBCOPY(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8
   Local7:= .F.
   Local8:= .T.
   Local1:= Select()
   begin sequence
      if (!used())
         _dbcgenerr("COPY TO")
         Local8:= .F.
      endif
      if (Local8 .AND. Empty(Local3:= __fledit(dbstruct(), Arg2)))
         Local8:= .F.
      endif
      dbcreate(Arg1, Local3, Arg8, .T., "")
      Local2:= Select()
      if (Local2 == Local1)
         Local2:= Nil
      else
         select (Local1)
         __dbtrans(Local2, Local3, Arg3, Arg4, Arg5, Arg6, Arg7)
      endif
   recover using Local6
      Local7:= .T.
   end sequence
   if (Local2 != Nil)
      select (Local2)
      close
   endif
   select (Local1)
   if (Local7)
      break(Local6)
   endif
   return Local8

********************************
function __DBSORT(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7)

   local Local1, Local2, Local3, Local4, Local5
   Local5:= .F.
   Local1:= Select()
   if (Empty(Local3:= dbstruct()))
      return .F.
   endif
   begin sequence
      dbcreate(Arg1, Local3, Nil, .T., "")
      Local2:= Select()
      select (Local1)
      __dbarrang(Local2, Local3, Arg3, Arg4, Arg5, Arg6, Arg7, Arg2)
   recover using Local4
      Local5:= .T.
   end sequence
   if (Local2 != Nil)
      select (Local2)
      close
   endif
   select (Local1)
   if (Local5)
      break(Local4)
   endif
   return .T.

********************************
function __TSETRBOT(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[4]:= _einstvar(qself(), "NBOTTOM", Arg1, "N", 1001, ;
         qself():ntop(), Nil)
      qself():configure(2)
   endif
   return qself()[4]

********************************
function __MENUTO(Arg1, Arg2)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9, Local10, Local11, Local12, Local13, Local14, ;
      Local15, Local16
   Local13:= Static20
   Local14:= Set(_SET_MESSAGE)
   Local15:= Set(_SET_MCENTER)
   Local16:= readvar(Upper(Arg2))
   Static20:= {}
   Local11:= errorblock({|_1| break(_1)})
   begin sequence
      Local2:= eval(Arg1)
      Local12:= .F.
   recover
      Local12:= .T.
   end sequence
   errorblock(Local11)
   if (Local12)
      __qqpub(Arg2)
   endif
   if (ValType(Local2) != "N" .OR. Local2 < 1)
      Local2:= 1
   endif
   if (Local2 > Len(Local13))
      Local2:= Len(Local13)
   endif
   if (Set(_SET_INTENSITY))
      Local8:= setcursor(0)
   endif
   Local7:= .F.
   Local6:= ""
   Local9:= 0
   do while (Local2 != 0)
      Local5:= 0
      Local1:= Local13[Local2]
      if (Set(_SET_INTENSITY))
         colorselec(1)
      endif
      SetPos(Local1[1], Local1[2])
      dispout(Local1[3])
      if (Set(_SET_INTENSITY))
         colorselec(0)
      endif
      if (Local14 != 0)
         if (!Empty(Local6))
            SetPos(Local14, Local9)
            dispout(Space(Len(Local6)))
         endif
         Local6:= Local1[4]
         if (ISBLOCK(Local6))
            Local6:= eval(Local6)
         elseif (ValType(Local6) == "U")
            Local6:= ""
         endif
         if (Local15)
            Local9:= Int((MaxCol() - Len(Local6)) / 2)
         endif
         SetPos(Local14, Local9)
         dispout(Local6)
         SetPos(Local1[1], Local1[2])
      endif
      if (Local7)
         exit
      endif
      do while (Local5 == 0)
         Local5:= InKey(0)
         if ((Local10:= SetKey(Local5)) != Nil)
            eval(Arg1, Local2)
            eval(Local10, procname(1), procline(1), Upper(Arg2))
            Local2:= eval(Arg1)
            Local5:= 0
         endif
      enddo
      if (Local2 > Len(Local13))
         Local2:= Len(Local13)
      endif
      do case
      case Local5 == 5 .OR. Local5 == 19
         if (--Local2 < 1)
            Local2:= iif(Set(_SET_WRAP), Len(Local13), 1)
         endif
      case Local5 == 24 .OR. Local5 == 4
         if (++Local2 > Len(Local13))
            Local2:= iif(Set(_SET_WRAP), 1, Len(Local13))
         endif
      case Local5 == 1
         Local2:= 1
      case Local5 == 6
         Local2:= Len(Local13)
      case Local5 == 18
         Local7:= .T.
      case Local5 == 3
         Local7:= .T.
      case Local5 == 13
         Local7:= .T.
      case Local5 == 27
         Local2:= 0
      otherwise
         Local4:= Upper(Chr(Local5))
         Local3:= ascan(Local13, {|_1| Local4 == ;
            Left(Upper(LTrim(_1[3])), 1)})
         if (Local3 != 0)
            Local2:= Local3
            Local7:= .T.
         endif
      endcase
      if (Local2 != 0)
         SetPos(Local1[1], Local1[2])
         dispout(Local1[3])
      endif
   enddo
   setcursor(Local8)
   eval(Arg1, Local2)
   if (Local12)
      release (Arg2)
   endif
   if (!Empty(Local16))
      readvar(Local16)
   endif
   SetPos(MaxRow() - 1, 0)
   return Local2

********************************
function __TSETRRIG(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[5]:= _einstvar(qself(), "NRIGHT", Arg1, "N", 1001, ;
         qself():nleft(), Nil)
      qself():configure(2)
   endif
   return qself()[5]

********************************
function __DBAPP(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8, Local9
   Local8:= .F.
   Local9:= .T.
   Local2:= Select()
   begin sequence
      if (!used())
         _dbcgenerr("APPEND FROM")
         Local9:= .F.
      endif
      if (Local9 .AND. Empty(Local3:= __fledit(dbstruct(), Arg2)))
         Local9:= .F.
      endif
      use (Arg1) via Arg8 alias  new shared readonly
      Local1:= Select()
      Arg2:= {}
      aeval(dbstruct(), {|_1| AAdd(Arg2, _1[1])})
      if (!Empty(Local3:= __fledit(Local3, Arg2)))
         __dbtrans(Local2, Local3, Arg3, Arg4, Arg5, Arg6, Arg7)
      endif
   recover using Local7
      Local8:= .T.
   end sequence
   if (Local1 != Nil)
      close
   endif
   select (Local2)
   if (Local8)
      break(Local7)
   endif
   return Local9

********************************
function __FLEDIT(Arg1, Arg2)

   local Local1, Local2, Local3
   if (Empty(Arg2))
      return Arg1
   endif
   Local1:= {}
   aeval(Arg2, {|_1| AAdd(Local1, furbof(_1))})
   Arg2:= Local1
   Local1:= {}
   Local2:= {|_1| _1[1] == Local3}
   aeval(Arg2, {|_1, _2| (Local3:= _1, _2:= ascan(Arg1, Local2), ;
      iif(_2 == 0, Nil, AAdd(Local1, Arg1[_2])))})
   return Local1

********************************
function __DBSDF(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8)

   local Local1, Local2, Local3, Local4
   Local4:= "SDF"
   if (Arg1)
      Local1:= Select()
   else
      Local2:= Select()
   endif
   if (Empty(Local3:= __fledit(dbstruct(), Arg3)))
      return .F.
   endif
   if (Arg1)
      dbcreate(Arg2, Local3, Local4, .T., "")
      Local2:= Select()
      if (Local2 == Local1)
         Local2:= Nil
      endif
      select (Local1)
   else
      if (!__dbopensd(Arg2, Local3, Local4, .T., ""))
         return .F.
      endif
      Local1:= Select()
   endif
   if (Local2 != Nil)
      __dbtrans(Local2, Local3, Arg4, Arg5, Arg6, Arg7, Arg8)
   endif
   if (Arg1)
      if (Local2 != Nil)
         select (Local2)
         close
      endif
      select (Local1)
   else
      select (Local1)
      close
      select (Local2)
   endif
   return .T.

********************************
function READMODAL(Arg1, Arg2)

   local Local1, Local2
   if (ISBLOCK(Static21))
      eval(Static21)
   endif
   if (Empty(Arg1))
      SetPos(MaxRow() - 1, 0)
      return .F.
   endif
   Local2:= cleargetsy()
   Static29:= procname(1)
   Static30:= procline(1)
   if (!(ISNUMBER(Arg2) .AND. Arg2 > 0))
      Arg2:= settle(Arg1, 0)
   endif
   do while (!(Arg2 == 0))
      postactive(Local1:= Arg1[Arg2])
      if (ISBLOCK(Local1:reader()))
         eval(Local1:reader(), Local1)
      else
         getreader(Local1)
      endif
      Arg2:= settle(Arg1, Arg2)
   enddo
   restoreget(Local2)
   SetPos(MaxRow() - 1, 0)
   return Static22

********************************
procedure GETREADER(Arg1)

   if (getprevali(Arg1))
      Arg1:setfocus()
      do while (Arg1:exitstate() == 0)
         if (Arg1:typeout())
            Arg1:exitstate(5)
         endif
         do while (Arg1:exitstate() == 0)
            getapplyke(Arg1, InKey(0))
         enddo
         if (!getpostval(Arg1))
            Arg1:exitstate(0)
         endif
      enddo
      Arg1:killfocus()
   endif
   return

********************************
procedure GETAPPLYKE(Arg1, Arg2)

   local Local1, Local2
   if (!(ISNIL(Local2:= SetKey(Arg2))))
      getdosetke(Local2, Arg1)
   else
      do case
      case Arg2 == 5
         Arg1:exitstate(1)
      case Arg2 == 271
         Arg1:exitstate(1)
      case Arg2 == 24
         Arg1:exitstate(2)
      case Arg2 == 9
         Arg1:exitstate(2)
      case Arg2 == 13
         Arg1:exitstate(5)
      case Arg2 == 27
         if (Set(_SET_ESCAPE))
            Arg1:undo()
            Arg1:exitstate(7)
         endif
      case Arg2 == 18
         Arg1:exitstate(6)
      case Arg2 == 3
         Arg1:exitstate(6)
      case Arg2 == 29
         Arg1:exitstate(3)
      case Arg2 == 23
         Arg1:exitstate(6)
      case Arg2 == 22
         Set(_SET_INSERT, !Set(_SET_INSERT))
         showscoreb()
      case Arg2 == 21
         Arg1:undo()
      case Arg2 == 1
         Arg1:home()
      case Arg2 == 6
         Arg1:end()
      case Arg2 == 4
         Arg1:right()
      case Arg2 == 19
         Arg1:left()
      case Arg2 == 2
         Arg1:wordright()
      case Arg2 == 26
         Arg1:wordleft()
      case Arg2 == 8
         Arg1:backspace()
      case Arg2 == 7
         Arg1:delete()
      case Arg2 == 20
         Arg1:delwordrig()
      case Arg2 == 25
         Arg1:delend()
      case Arg2 == 127
         Arg1:delwordlef()
      otherwise
         if (Arg2 >= 32 .AND. Arg2 <= 255)
            Local1:= Chr(Arg2)
            if (Arg1:type() == "N" .AND. (Local1 == "." .OR. Local1 ;
                  == ","))
               Arg1:todecpos()
            else
               if (Set(_SET_INSERT))
                  Arg1:insert(Local1)
               else
                  Arg1:overstrike(Local1)
               endif
               if (Arg1:typeout())
                  if (Set(_SET_BELL))
                     ?? ""
                  endif
                  if (!Set(_SET_CONFIRM))
                     Arg1:exitstate(5)
                  endif
               endif
            endif
         endif
      endcase
      return
   endif

********************************
function GETPREVALI(Arg1)

   local Local1, Local2
   Local2:= .T.
   if (!(ISNIL(Arg1:preblock())))
      Local1:= Static22
      Local2:= eval(Arg1:preblock(), Arg1)
      Arg1:display()
      showscoreb()
      Static22:= Local1
   endif
   if (Static23)
      Local2:= .F.
      Arg1:exitstate(7)
   elseif (!Local2)
      Arg1:exitstate(8)
   else
      Arg1:exitstate(0)
   endif
   return Local2

********************************
procedure GETDOSETKE(Arg1, Arg2)

   local Local1
   if (Arg2:changed())
      Arg2:assign()
      Static22:= .T.
   endif
   Local1:= Static22
   eval(Arg1, Static29, Static30, readvar())
   showscoreb()
   Arg2:updatebuff()
   Static22:= Local1
   if (Static23)
      Arg2:exitstate(7)
   endif
   return

********************************
function __TSETCOLS(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[8]:= _einstvar(qself(), "COLSEP", Arg1, "C", 1001)
   endif
   return qself()[8]

********************************
function GETPOSTVAL(Arg1)

   local Local1, Local2
   Local2:= .T.
   if (Arg1:exitstate() == 7)
      return .T.
   endif
   if (Arg1:baddate())
      Arg1:home()
      datemsg()
      showscoreb()
      return .F.
   endif
   if (Arg1:changed())
      Arg1:assign()
      Static22:= .T.
   endif
   Arg1:reset()
   if (!(ISNIL(Arg1:postblock())))
      Local1:= Static22
      SetPos(Arg1:row(), Arg1:col() + Len(Arg1:buffer()))
      Local2:= eval(Arg1:postblock(), Arg1)
      SetPos(Arg1:row(), Arg1:col())
      showscoreb()
      Arg1:updatebuff()
      Static22:= Local1
      if (Static23)
         Arg1:exitstate(7)
         Local2:= .T.
      endif
   endif
   return Local2

********************************
static function SETTLE(Arg1, Arg2)

   local Local1
   if (Arg2 == 0)
      Local1:= 2
   else
      Local1:= Arg1[Arg2]:exitstate()
   endif
   if (Local1 == 7 .OR. Local1 == 6)
      return 0
   endif
   if (!(Local1 == 8))
      Static27:= Arg2
      Static24:= .F.
      Static25:= .F.
   else
      Local1:= Static26
   endif
   do case
   case Local1 == 1
      Arg2--
   case Local1 == 2
      Arg2++
   case Local1 == 3
      Arg2:= 1
      Static24:= .T.
      Local1:= 2
   case Local1 == 4
      Arg2:= Len(Arg1)
      Static25:= .T.
      Local1:= 1
   case Local1 == 5
      Arg2++
   endcase
   if (Arg2 == 0)
      if (!readexit() .AND. !Static25)
         Static24:= .T.
         Arg2:= Static27
         Local1:= 2
      endif
   elseif (Arg2 == Len(Arg1) + 1)
      if (!readexit() .AND. !(Local1 == 5) .AND. !Static24)
         Static25:= .T.
         Arg2:= Static27
         Local1:= 1
      else
         Arg2:= 0
      endif
   endif
   Static26:= Local1
   if (!(Arg2 == 0))
      Arg1[Arg2]:exitstate(Local1)
   endif
   return Arg2

********************************
static function CLEARGETSY

   local Local1[9]
   Local1[1]:= Static23
   Local1[2]:= Static24
   Local1[3]:= Static25
   Local1[4]:= Static26
   Local1[5]:= Static27
   Local1[6]:= getactive(Nil)
   Local1[7]:= readvar("")
   Local1[8]:= Static29
   Local1[9]:= Static30
   Static23:= .F.
   Static24:= .F.
   Static25:= .F.
   Static26:= 0
   Static27:= 0
   Static29:= ""
   Static30:= 0
   Static22:= .F.
   return Local1

********************************
static procedure RESTOREGET(Arg1)

   Static23:= Arg1[1]
   Static24:= Arg1[2]
   Static25:= Arg1[3]
   Static26:= Arg1[4]
   Static27:= Arg1[5]
   getactive(Arg1[6])
   readvar(Arg1[7])
   Static29:= Arg1[8]
   Static30:= Arg1[9]
   return

********************************
static function GETREADVAR(Arg1)

   local Local1, Local2
   Local1:= Upper(Arg1:name())
   if (!(ISNIL(Arg1:subscript())))
      for Local2:= 1 to Len(Arg1:subscript())
         Local1:= Local1 + ("[" + ;
            LTrim(Str(Arg1:subscript()[Local2])) + "]")
      next
   endif
   return Local1

********************************
function __TSETCOLO(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[10]:= _einstvar(qself(), "COLORSPEC", Arg1, "C", 1001)
      qself():configure(1)
   endif
   return qself()[10]

********************************
static procedure SHOWSCOREB

   local Local1, Local2
   if (Set(_SET_SCOREBOARD))
      Local1:= Row()
      Local2:= Col()
      SetPos(0, 60)
      dispout(iif(Set(_SET_INSERT), nationmsg(7), nationmsg(8)))
      SetPos(Local1, Local2)
   endif
   return

********************************
static procedure DATEMSG

   local Local1, Local2
   if (Set(_SET_SCOREBOARD))
      Local1:= Row()
      Local2:= Col()
      SetPos(0, 60)
      dispout(nationmsg(9))
      SetPos(Local1, Local2)
      do while (nextkey() == 0)
      enddo
      SetPos(0, 60)
      dispout(Space(Len(nationmsg(9))))
      SetPos(Local1, Local2)
   endif
   return

********************************
function RANGECHECK(Arg1, Arg2, Arg3, Arg4)

   local Local1, Local2, Local3, Local4
   if (!Arg1:changed())
      return .T.
   endif
   Local4:= Arg1:varget()
   if (Local4 >= Arg3 .AND. Local4 <= Arg4)
      return .T.
   endif
   if (Set(_SET_SCOREBOARD))
      Local1:= nationmsg(10) + LTrim(Transform(Arg3, "")) + ;
         nationmsg(11) + LTrim(Transform(Arg4, ""))
      if (Len(Local1) > MaxCol())
         Local1:= SubStr(Local1, 1, MaxCol())
      endif
      Local2:= Row()
      Local3:= Col()
      SetPos(0, Min(60, MaxCol() - Len(Local1)))
      dispout(Local1)
      SetPos(Local2, Local3)
      do while (nextkey() == 0)
      enddo
      SetPos(0, Min(60, MaxCol() - Len(Local1)))
      dispout(Space(Len(Local1)))
      SetPos(Local2, Local3)
   endif
   return .F.

********************************
function STRZERO(Arg1, Arg2, Arg3)

   local Local1
   if (PCount() == 3)
      Local1:= Str(Arg1, Arg2, Arg3)
   elseif (PCount() == 2)
      Local1:= Str(Arg1, Arg2)
   else
      Local1:= Str(Arg1)
   endif
   if ("-" $ Local1)
      return "-" + Replicate("0", Len(Local1) - Len(LTrim(Local1))) ;
         + SubStr(Local1, At("-", Local1) + 1)
   endif
   return Replicate("0", Len(Local1) - Len(LTrim(Local1))) + ;
      LTrim(Local1)

********************************
function ACLONE(Arg1)

   local Local1, Local2, Local3
   if (!(ISARRAY(Arg1)))
      return Nil
   endif
   Local3:= Len(Arg1)
   Local1:= array(Local3)
   for Local2:= 1 to Local3
      if (ISARRAY(Arg1[Local2]))
         Local1[Local2]:= aclone(Arg1[Local2])
      else
         Local1[Local2]:= Arg1[Local2]
      endif
   next
   return Local1

********************************
function __DEFPATH

   local Local1, Local2, Local3
   Local3:= Set(_SET_DEFAULT)
   Local1:= Len(Local3)
   if ((Local2:= SubStr(Local3, Local1, 1), Local1 > 0 .AND. Local2 ;
         != ":" .AND. Local2 != "\"))
      Local3:= Local3 + iif(Local1 == 1, ":", "\")
   endif
   return Local3

********************************
function __TSETCOLU(Arg1, Arg2)

   if (!(ISNIL(Arg1)) .AND. !(ISNIL(Arg2)))
      Arg1:= _einstvar(qself(), "COLUMN", Arg1, "N", 1001)
      qself()[6][Arg1]:= _einstvar(qself(), "COLUMN", Arg2, "O", 1001)
      qself():configure(2)
   endif
   return qself()

********************************
function __TDELCOLU(Arg1)

   local Local1
   Local1:= qself()[6][Arg1]
   adel(qself()[6], Arg1)
   asize(qself()[6], Len(qself()[6]) - 1)
   qself():configure(2)
   return Local1

********************************
function __CSETBLOC(Arg1)

   if (Arg1 != Nil)
      qself()[3]:= _einstvar(qself(), "BLOCK", Arg1, "B", 1001)
   endif
   return qself()[3]

********************************
function __CSETPICT(Arg1)

   if (!(ISNIL(Arg1)))
      qself()[11]:= Arg1
   endif
   return qself()[11]

********************************
function ADIR(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)

   local Local1, Local2, Local3
   Local3:= defpath()
   if (SubStr(Arg1, 2, 1) == ":" .OR. SubStr(Arg1, 1, 1) == "\")
      Local3:= Arg1
   else
      Local3:= Local3 + Arg1
   endif
   if (ISARRAY(Arg6))
      Local1:= directory(Local3, "HSD")
   else
      Local1:= directory(Local3)
   endif
   if (ValType(Local1) != "A")
      return 0
   endif
   Local2:= Len(Local1)
   if (ISARRAY(Arg2))
      aeval(Arg2, {|_1, _2| Arg2[_2]:= Local1[_2][1]}, 1, Local2)
   endif
   if (ISARRAY(Arg3))
      aeval(Arg3, {|_1, _2| Arg3[_2]:= Local1[_2][2]}, 1, Local2)
   endif
   if (ISARRAY(Arg4))
      aeval(Arg4, {|_1, _2| Arg4[_2]:= Local1[_2][3]}, 1, Local2)
   endif
   if (ISARRAY(Arg5))
      aeval(Arg5, {|_1, _2| Arg5[_2]:= Local1[_2][4]}, 1, Local2)
   endif
   if (ISARRAY(Arg6))
      aeval(Arg6, {|_1, _2| Arg6[_2]:= Local1[_2][5]}, 1, Local2)
   endif
   return Len(Local1)

********************************
function TBROWSENEW(Arg1, Arg2, Arg3, Arg4)

   local Local1[14]
   default Arg1 to 0
   default Arg2 to 0
   default Arg3 to MaxRow()
   default Arg4 to MaxCol()
   __totbrows(Local1)
   Local1:ntop(Arg1)
   Local1:nleft(Arg2)
   Local1:nbottom(Arg3)
   Local1:nright(Arg4)
   Local1[6]:= {}
   Local1[7]:= ""
   Local1[8]:= " "
   Local1[9]:= ""
   Local1[10]:= SetColor()
   Local1[11]:= {|| Nil}
   Local1[12]:= {|| Nil}
   Local1[13]:= {|| Nil}
   Local1:autolite(.T.)
   Local1:colpos(1)
   Local1:freeze(0)
   Local1:hitbottom(.F.)
   Local1:hittop(.F.)
   return Local1

********************************
function __CSETDEFC(Arg1)

   if (Arg1 != Nil)
      qself()[4]:= _einstvar(qself(), "DEFCOLOR", Arg1, "A", 1001)
   endif
   return qself()[4]

********************************
function __CSETCOLO(Arg1)

   if (Arg1 != Nil)
      qself()[5]:= _einstvar(qself(), "COLORBLOCK", Arg1, "B", 1001)
   endif
   return qself()[5]

********************************
function __CSETHEAD(Arg1)

   if (Arg1 != Nil)
      qself()[6]:= _einstvar(qself(), "HEADING", Arg1, "C", 1001)
   endif
   return qself()[6]

********************************
function __CSETFOOT(Arg1)

   if (Arg1 != Nil)
      qself()[10]:= _einstvar(qself(), "FOOTING", Arg1, "C", 1001)
   endif
   return qself()[10]

********************************
function __CSETHSEP(Arg1)

   local Local1
   if (Arg1 != Nil)
      Local1:= _einstvar(qself(), "HEADSEP", Arg1, "C", 1001)
   endif
   if (PCount() == 1)
      qself()[7]:= Local1
   endif
   return qself()[7]

********************************
function __CSETFSEP(Arg1)

   local Local1
   if (Arg1 != Nil)
      Local1:= _einstvar(qself(), "FOOTSEP", Arg1, "C", 1001)
   endif
   if (PCount() == 1)
      qself()[9]:= Local1
   endif
   return qself()[9]

********************************
function __CSETCOLS(Arg1)

   local Local1
   if (Arg1 != Nil)
      Local1:= _einstvar(qself(), "COLSEP", Arg1, "C", 1001)
   endif
   if (PCount() == 1)
      qself()[8]:= Local1
   endif
   return qself()[8]

********************************
function TBCOLUMNNE(Arg1, Arg2)

   local Local1[11]
   Local1[6]:= Arg1
   Local1[3]:= Arg2
   Local1[4]:= {1, 2}
   Local1[5]:= {|| Nil}
   Local1[8]:= Nil
   Local1[10]:= ""
   Local1[9]:= Nil
   Local1[7]:= Nil
   __totbcolu(Local1)
   return Local1

********************************
static function SKIPPED(Arg1)

   local Local1
   Local1:= 0
   if (LastRec() != 0)
      if (Arg1 == 0)
         skip 0
      elseif (Arg1 > 0 .AND. RecNo() != LastRec() + 1)
         do while (Local1 < Arg1)
            skip 
            if (EOF())
               skip -1
               exit
            endif
            Local1++
         enddo
      elseif (Arg1 < 0)
         do while (Local1 > Arg1)
            skip -1
            if (BOF())
               exit
            endif
            Local1--
         enddo
      endif
   endif
   return Local1

********************************
function TBROWSEDB(Arg1, Arg2, Arg3, Arg4)

   local Local1
   Local1:= tbrowsenew(Arg1, Arg2, Arg3, Arg4)
   Local1:skipblock({|_1| skipped(_1)})
   Local1:gotopbloc({|| dbGoTop()})
   Local1:gobottomb({|| dbGoBottom()})
   return Local1

********************************
static function SKIPPED(Arg1)

   local Local1
   Local1:= 0
   if (LastRec() != 0)
      if (Arg1 == 0)
         if (EOF() .AND. !Static10)
            skip -1
            Local1:= -1
         else
            skip 0
         endif
      elseif (Arg1 > 0 .AND. RecNo() != LastRec() + 1)
         do while (Local1 < Arg1)
            skip 
            if (EOF())
               if (Static10)
                  Local1++
               else
                  skip -1
               endif
               exit
            endif
            Local1++
         enddo
      elseif (Arg1 < 0)
         do while (Local1 > Arg1)
            skip -1
            if (BOF())
               exit
            endif
            Local1--
         enddo
      endif
   endif
   return Local1

********************************
static function CALLUSER(Arg1, Arg2, Arg3)

   local Local1, Local2, Local3, Local4
   do case
   case Arg3 != 0
      Local1:= 4
   case !Static10 .AND. emptyfile()
      Local1:= 3
   case Arg1:hitbottom()
      Local1:= 2
   case Arg1:hittop()
      Local1:= 1
   otherwise
      Local1:= 0
   endcase
   do while (!Arg1:stabilize())
   enddo
   Local3:= RecNo()
   if (ValType(Arg2) != "C" .OR. Empty(Arg2))
      if (Arg3 == 13 .OR. Arg3 == 27)
         Local2:= 0
      else
         Local2:= 1
      endif
   else
      Local2:= &Arg2(Local1, Arg1:colpos())
   endif
   Local4:= Local2 != 0
   if (!Static10 .AND. EOF() .AND. !emptyfile())
      skip -1
   endif
   if (Local2 == 3)
      Static10:= !(Static10 .AND. EOF())
      if (Static10)
         goto bottom
         Arg1:down()
      else
         Arg1:refreshcur()
      endif
      Static11:= .F.
   elseif (Local2 == 2 .OR. Local3 != RecNo())
      if (Local4)
         Static10:= .F.
         if (Set(_SET_DELETED) .AND. Deleted() .OR. ;
               !Empty(dbfilter()) .AND. !&(dbfilter()))
            skip 
         endif
         if (EOF())
            goto bottom
         endif
         Local3:= RecNo()
         Arg1:refreshall()
         do while (!Arg1:stabilize())
         enddo
         do while (Local3 != RecNo())
            Arg1:up()
            do while (!Arg1:stabilize())
            enddo
         enddo
         Static11:= .F.
      endif
   else
      Arg1:refreshcur()
   endif
   return Local4

********************************
static function DBEDSETUP(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, ;
   Arg8, Arg9, Arg10, Arg11, Arg12)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
      Local8
   if (ValType(Arg1) != "N" .OR. Arg1 < 0)
      Arg1:= 0
   endif
   if (ValType(Arg2) != "N" .OR. Arg2 < 0)
      Arg2:= 0
   endif
   if (ValType(Arg3) != "N" .OR. Arg3 > MaxRow() .OR. Arg3 < Arg1)
      Arg3:= MaxRow()
   endif
   if (ValType(Arg4) != "N" .OR. Arg4 > MaxCol() .OR. Arg4 < Arg2)
      Arg4:= MaxCol()
   endif
   if ((Arg4 - Arg2) * (Arg3 - Arg1) > MaxRow() * MaxCol())
      Arg1:= Arg2:= 0
      Arg3:= MaxRow()
      Arg4:= MaxCol()
   endif
   Local1:= tbrowsedb(Arg1, Arg2, Arg3, Arg4)
   if (ISARRAY(Arg5))
      Local3:= Len(Arg5)
      Local2:= 1
      do while (Local2 <= Local3)
         if (ValType(Arg5[Local2]) != "C" .OR. Empty(Arg5[Local2]))
            exit
         endif
         Local2++
      enddo
      Local3:= Local2 - 1
   else
      Local3:= FCount()
   endif
   if (Local3 == 0)
      return .F.
   endif
   Local1:headsep("")
   Local1:colsep("  ")
   Local4:= array(Local3, 6)
   if (ISARRAY(Arg5))
      for Local2:= 1 to Local3
         if ("->" $ Arg5[Local2])
            Local6:= At("->", Arg5[Local2])
            Local4[Local2][3]:= SubStr(Arg5[Local2], 1, Local6 - 1)
            Local4[Local2][4]:= SubStr(Arg5[Local2], Local6 + 2)
            Local4[Local2][1]:= Local4[Local2][3] + "->;" + ;
               Local4[Local2][4]
         else
            Local4[Local2][3]:= Nil
            Local4[Local2][4]:= Nil
            Local4[Local2][1]:= Arg5[Local2]
         endif
         Local4[Local2][2]:= Arg5[Local2]
      next
   elseif (FCount() > 0)
      for Local2:= 1 to Local3
         Local4[Local2][3]:= Nil
         Local4[Local2][4]:= Nil
         Local4[Local2][1]:= FieldName(Local2)
         Local4[Local2][2]:= FieldName(Local2)
      next
   else
      return .F.
   endif
   for Local2:= 1 to Local3
      Local5:= ""
      if (ISARRAY(Arg7))
         if (Len(Arg7) >= Local2 .AND. ISCHARACTER(Arg7[Local2]) ;
               .AND. !Empty(Arg7[Local2]))
            Local5:= Arg7[Local2]
         endif
      elseif (ISCHARACTER(Arg7) .AND. !Empty(Arg7))
         Local5:= Arg7
      endif
      Local7:= Nil
      if (ISMEMO(&(Local4[Local2][2])))
         Local7:= "{|| '  <Memo>  '}"
      elseif (Empty(Local5))
         if ("->" $ Local4[Local2][2])
            if (Upper(Local4[Local2][3]) == "M")
               Local7:= memvarbloc(Local4[Local2][2])
            elseif (Upper(Local4[Local2][3]) == "FIELD")
               Local7:= fieldwbloc(Local4[Local2][4], Select())
            else
               Local7:= fieldwbloc(Local4[Local2][4], ;
                  Select(Local4[Local2][3]))
            endif
         elseif (!Empty(fieldpos(Local4[Local2][2])))
            Local7:= fieldwbloc(Local4[Local2][2], Select())
         endif
      endif
      if (ISNIL(Local7))
         if (Empty(Local5))
            Local7:= "{||" + Local4[Local2][2] + "}"
         else
            Local7:= "{|| Transform(" + Local4[Local2][2] + ",'" + ;
               Local5 + "')}"
         endif
      endif
      if (ISCHARACTER(Local7))
         Local4[Local2][2]:= &Local7
      elseif (ISBLOCK(Local7))
         Local4[Local2][2]:= Local7
      endif
      if (ISARRAY(Arg8))
         if (Len(Arg8) >= Local2 .AND. ISCHARACTER(Arg8[Local2]))
            Local4[Local2][1]:= Arg8[Local2]
         endif
      elseif (ISCHARACTER(Arg8))
         Local4[Local2][1]:= Arg8
      endif
      Local4[Local2][3]:= Nil
      if (ISARRAY(Arg9))
         if (Len(Arg9) >= Local2 .AND. ISCHARACTER(Arg9[Local2]))
            Local4[Local2][3]:= Arg9[Local2]
         endif
      elseif (ISCHARACTER(Arg9))
         Local4[Local2][3]:= Arg9
      endif
      Local4[Local2][4]:= Nil
      if (ISARRAY(Arg10))
         if (Len(Arg10) >= Local2 .AND. ISCHARACTER(Arg10[Local2]))
            Local4[Local2][4]:= Arg10[Local2]
         endif
      elseif (ISCHARACTER(Arg10))
         Local4[Local2][4]:= Arg10
      endif
      Local4[Local2][5]:= Nil
      if (ISARRAY(Arg11))
         if (Len(Arg11) >= Local2 .AND. ISCHARACTER(Arg11[Local2]))
            Local4[Local2][5]:= Arg11[Local2]
         endif
      elseif (ISCHARACTER(Arg11))
         Local4[Local2][5]:= Arg11
      endif
      Local4[Local2][6]:= Nil
      if (ISARRAY(Arg12))
         if (Len(Arg12) >= Local2 .AND. ISCHARACTER(Arg12[Local2]))
            Local4[Local2][6]:= Arg12[Local2]
         endif
      elseif (ISCHARACTER(Arg12))
         Local4[Local2][6]:= Arg12
      endif
   next
   for Local2:= 1 to Local3
      Local8:= tbcolumnne(Local4[Local2][1], Local4[Local2][2])
      if (Local4[Local2][3] != Nil)
         Local8:headsep(Local4[Local2][3])
      endif
      if (Local4[Local2][4] != Nil)
         Local8:colsep(Local4[Local2][4])
      endif
      if (Local4[Local2][5] != Nil)
         Local8:footsep(Local4[Local2][5])
      endif
      if (Local4[Local2][6] != Nil)
         Local8:footing(Local4[Local2][6])
      endif
      Local1:addcolumn(Local8)
   next
   return Local1

********************************
static function LOCKERRHAN(Arg1, Arg2)

   if (Arg1:gencode() == 41)
      return .T.
   endif
   return eval(Arg2, Arg1)

********************************
function DBEDIT(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
   Arg9, Arg10, Arg11, Arg12)

   local Local1, Local2, Local3, Local4, Local5, Local6, Local7
   if (EOF())
      goto bottom
   endif
   Local1:= dbedsetup(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, ;
      Arg8, Arg9, Arg10, Arg11, Arg12)
   Local1:skipblock({|_1| skipped(_1)})
   Local1:autolite(.F.)
   Local2:= setcursor(0)
   Local7:= {Static10, Static11}
   Static10:= .F.
   Static11:= .T.
   Local5:= .T.
   Local3:= .T.
   do while (Local3)
      do while (!Local1:stabilize())
         if (nextkey() != 0)
            exit
         endif
      enddo
      if ((Local4:= InKey()) == 0)
         if (Local5)
            Local3:= calluser(Local1, Arg6, 0)
            do while (!Local1:stabilize())
            enddo
         endif
         if (Local3 .AND. Static11)
            Local1:hilite()
            Local4:= InKey(0)
            Local1:dehilite()
            if ((Local6:= SetKey(Local4)) != Nil)
               eval(Local6, procname(1), procline(1), "")
               loop
            endif
         else
            Static11:= .T.
         endif
      endif
      Local5:= .T.
      do case
      case Local4 == 0
      case Local4 == 24
         if (Static10)
            Local1:hitbottom(.T.)
         else
            Local1:down()
         endif
      case Local4 == 5
         if (Static10)
            Local1:hittop(.T.)
         else
            Local1:up()
         endif
      case Local4 == 3
         if (Static10)
            Local1:hitbottom(.T.)
         else
            Local1:pagedown()
         endif
      case Local4 == 18
         if (Static10)
            Local1:hittop(.T.)
         else
            Local1:pageup()
         endif
      case Local4 == 31
         if (Static10)
            Local1:hittop(.T.)
         else
            Local1:gotop()
         endif
      case Local4 == 30
         if (Static10)
            Local1:hitbottom(.T.)
         else
            Local1:gobottom()
         endif
      case Local4 == 4
         Local1:right()
      case Local4 == 19
         Local1:left()
      case Local4 == 1
         Local1:home()
      case Local4 == 6
         Local1:end()
      case Local4 == 26
         Local1:panleft()
      case Local4 == 2
         Local1:panright()
      case Local4 == 29
         Local1:panhome()
      case Local4 == 23
         Local1:panend()
      otherwise
         Local3:= calluser(Local1, Arg6, Local4)
         Local5:= .F.
      endcase
   enddo
   setcursor(Local2)
   Static10:= Local7[1]
   Static11:= Local7[2]
   return .T.

********************************
function _EINSTVAR(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7)

   local Local1, Local2
   Local2:= .F.
   if (ValType(Arg3) == Arg4)
      if (!(ISNIL(Arg6)))
         Local2:= !(Arg3 >= Arg6)
      endif
      if (!(ISNIL(Arg7)))
         Local2:= !(Arg3 <= Arg7)
      endif
   else
      Local2:= .T.
   endif
   if (Local2 .AND. ValType((Local1:= errornew(), Local1:gencode(1), ;
         Local1:severity(2), Local1:subsystem(Arg1:classname()), ;
         Local1:subcode(Arg5), Local1:args({Arg3}), ;
         Local1:cansubsti(.T.), Arg3:= eval(errorblock(), Local1), ;
         Arg3)) != Arg4)
      errorinhan()
   endif
   return Arg3

* EOF
