;** PFacG **********************************************************************
;*  Programcao Faccao/Producao                                                 *
;*******************************************************************************
;Autor           : Vise Informatica (VISERP)
;Desenvolvido    : 26/03/2007 por Anivel Augusto Rodrigues
;Ultima Alteracao: 11/04/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Estamparia
;Ultima Alteracao: 18/04/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Gera Requisicao
;Ultima Alteracao: 20/04/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Programacao Estamparia nÆo Gera Requisicao
;Ultima Alteracao: 10/05/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Campo Lancamento RQCabeca
;Ultima Alteracao: 03/07/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Apos Impressao
;Ultima Alteracao: 30/08/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Inclusao Grade
;Ultima Alteracao: 28/09/2007 por Anivel Augusto Rodrigues
;Motivo Alteracao: Inclusao RqItemG
;Ultima Alteracao: 29/01/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Requisicao()
;Ultima Alteracao: 24/03/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Bordado
;Ultima Alteracao: 26/03/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes
;Ultima Alteracao: 27/03/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes
;Ultima Alteracao: 03/04/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Gera_PfacRI
;Ultima Alteracao: 23/05/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Inclusao Controla_Edicao
;Ultima Alteracao: 07/07/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Requisicao Estamp/Bordaria 0185
;Ultima Alteracao: 31/07/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Clientes 0003,0200
;Ultima Alteracao: 11/08/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes PegaItens_Programacao()
;Ultima Alteracao: 02/10/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes PegaItens_Programacao()
;Ultima Alteracao: 03/10/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Imprimir
;Ultima Alteracao: 27/10/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Descricao
;Ultima Alteracao: 27/11/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Monta_Array_Grade()
;Ultima Alteracao: 24/12/2008 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Seta_Sequencia
;Ultima Alteracao: 11/05/2009 por Anivel Augusto Rodrigues
;Motivo Alteracao: Inclusao Lavanderia/Outros
;Ultima Alteracao: 15/01/2010 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes ordem consulta cores             
;Ultima Alteracao: 14/06/2010 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Gera_Pfacri()     
;Ultima Alteracao: 21/07/2010 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Cria_Ficha() sem msg nova ficha      
;Ultima Alteracao: 15/09/2010 por Karina Andrade
;Motivo Alteracao: Ajustes codigo cliente confec‡Æo
;Ultima Alteracao: 14/10/2010 por Bruno Carvalho
;Motivo Alteracao: Ajustes Edita_Memo
;Ultima Alteracao: 03/01/2011 por Bruno Carvalho
;Motivo Alteracao: Ajustes Novo Layout de Teclas  
;Ultima Alteracao: 06/01/2011 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Cria_Ficha*()
;Ultima Alteracao: 27/04/2011 por Bruno Carvalho
;Motivo Alteracao: Otimiza‡Æo Monta_Array_Grade
;Ultima Alteracao: 30/04/2011 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Isabela Garcia Nova Codifica‡Æo
;Ultima Alteracao: 12/05/2011 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes novas fun‡äes para confec‡äes  
;Ultima Alteracao: 23/05/2011 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes exibir cores em ordem Alfabetica               
;Ultima Alteracao: 07/06/2011 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes exibir cores em ordem sequencia lupus         
;Ultima Alteracao: 17/06/2011 por Karina Andrade
;Motivo Alteracao: Ajustes TECLAS
;Ultima Alteracao: 26/09/2012 por Anivel Augusto Rodrigues                           
;Motivo Alteracao: Ajustes bloqueio de registro durante carrega_parametros()        
;Ultima Alteracao: 01/02/2013 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes descricao do movimento/operacao                   

;*******************************************************************************
;* Rotina para Controlar Chave                                                 *
;*******************************************************************************
Proc CHAVE()
INICIO=True
campocorrente=""

While True
  Moveto "PFACC"
  End
  Moveto [Numero_Programacao]
  NPROG=[Numero_Programacao]
  
  If OPCAO_FORM="F"
     Then Down
     Else PgDn PgDn
  EndIf
  Moveto [Numero_Programacao]

  SetaCorRegistro("Editar")
  While True

  TECLA=""
  AguardaTeclasPadrao()

    Switch
        Case RetVal=-33 : SemFuncoes()
        Case RetVal=-94 : MsgTeclasPadrao()
        Case RetVal="F3":
             If OPCAO_FORM="F"
                Then OPCAO_FORM="1"
                Else OPCAO_FORM="F"
             EndIf
             Del
             CHAVE=5
             Return
        Case RetVal="F7" Or RetVal="UP" Or RetVal="PGUP" Or RetVal="HOME":
             Del
             While True
               INICIO=True
               campocorrente=""

               If OPCAO_FORM="F"
                  Then PAGINA("PFACC","MR")
                  Else PAGINA("PFACC","MT")
               EndIf
               CHAVE=0
               NPROG   =[Numero_Programacao]
               If EDITAR="S"
                  Then If OPCAO_FORM="F"
                          Then PickForm "2"
                       EndIf
                       If Checa_Controle([Numero_Controle_Dia])
                          Then Controla_EdicaoC()
                          Else UnLockRecord
                       EndIf
                  Else If EXCLUIR="S"
                          Then If QuerExcluir("") And Checa_Supervisor()
                                  Then If Carrega_Parametros()
                                          Then If OPCAO_FORM="F"
                                                  Then PickForm "2"
                                               EndIf
                                               EXCLUSAO("Cabeca")
                                               If OPCAO_FORM="F"
                                                  Then PickForm "F"
                                               EndIf
                                          Else UnLockRecord
                                       EndIf
                                  Else UnLockRecord
                               EndIf
                          Else QuitLoop
                       EndIf
               EndIf
               SetaPosForm()
            EndWhile
            QuitLoop
        Case Retval="ESC":
             CHAVE=9
             Del
             Return
        Case Retval="ENTER":
             If IsBlank([])
                Then If IsBlank(NPROG)
                        Then NPROG="1"
                        Else NPROG=StrVal(NumVal(NPROG)+1)
                     EndIf
                Else NPROG=[]
             EndIf
             NPROG=AlinhM(NPROG,6)
             If RecordStatus("New")=False
                Then QuitLoop
                Else Del
             EndIf

             If OPCAO_FORM="F"
                Then PickForm "2"
             EndIf
             Moveto [Numero_Programacao]
             Locate NPROG
             If Retval
                Then CHAVE=0
                Else CHAVE=1
                     End
                     PgDn PgDn
                     Moveto [Numero_Programacao]
                     [Numero_Programacao]=NPROG
             EndIf

             If Not IsLockRecord()
                Then Echo Normal
                     Echo Off
                     If (CHAVE=1 And Checa_Controle(SYS_CONTROLE_DIA)) Or
                        (CHAVE=0 And Checa_Controle([Numero_Controle_Dia]))
                        Then Return
                     EndIf
             EndIf

             If IsLockRecord()
                Then If OPCAO_FORM="F"
                        Then PickForm "F"
                     EndIf
                     If CHAVE=1
                        Then Del
                     EndIf
                     QuitLoop
             EndIf
             Return
        EndSwitch
  EndWhile
EndWhile
EndProc   ; (Chave)

;*******************************************************************************
;* Rotina para Digitacao Dados Gerais                                          *
;*******************************************************************************
Proc DIGITA()
gerou_pfacri=False
If IsBlank(campocorrente)
   Then If [Situacao_Programacao]="FINALIZADA" And INICIO
           Then Mensagem("Ordem Finalizada !")
                If Not Checa_Supervisor()
                   Then CHAVE=9
                        Return
                EndIf
        EndIf

        If Not IsBlank([Codigo da Empresa])
           Then If Not Carrega_Parametros()
                   Then If CHAVE=1
                           Then Del
                        EndIf
                        CHAVE=9
                        Return
                EndIf
        EndIf

        Moveto [Numero_Corte]
        If CHAVE=1
           Then [Situacao_Programacao]="PROGRAMADA"
        EndIf
   Else Moveto Field campocorrente
EndIf

While True

      TECLA=" Esc=Retornar  "
      If Field()="Codigo da Empresa" Or
         Field()="Numero_Corte" Or
         Field()="Destino_Producao" Or
         Field()="Codigo" Or
         Field()="Codigo da Tabela" Or
         Field()="Situacao_Programacao"
         Then TECLA=TECLA+"F1=Tabelas  "
      EndIf
      If CHAVE=0
         Then TECLA=TECLA+"Del=Exclui  "
      EndIf
      TECLA=TECLA+"Alt+F=Fun‡”es  PgDn=Finalizar  "

      MSGCAMPO=Field()

      campocorrente=Field()
      Tecla_Funcao =""

      Prompt TECLA

      Wait Field
           Message MSGCAMPO
           Until "F1","ESC","ENTER","DEL","FIELDVIEW","F35","F6",
                 "PGDN",-33,-24,-19,-20

      If RetVal=-33
        Then If Not Seleciona_Funcao()
                Then Loop
                Else Return
             EndIf
      EndIf

      Switch

      Case RetVal=-24  Or RetVal=-19 Or RetVal="F6" or RetVal=-20:
           Tecla_Funcao=RetVal
           Return

      Case RetVal="F1":
           If Field()="Codigo da Empresa" OR
              Field()="Numero_Corte" OR
              Field()="Codigo" Or
              Field()="Codigo da Tabela"
              Then CONSULTAF1()
           EndIf
           If Field()="Destino_Producao"
              Then
                   ShowPopup " Destino " @ 05,11
                        "~B~ordaria  ": " Produ‡„o bordaria  " : "BORDARIA",
                        "~E~stamparia": " Produ‡„o estamparia" : "ESTAMPARIA",
                        "~F~ac‡„o    ": " Produ‡„o fac‡„o    " : "FACCAO",
                        "~I~nterno   ": " Produ‡„o interna   " : "INTERNO",
                        "~L~avanderia": " Produ‡„o Lavanderia" : "LAVANDERIA",
                        "~O~utros    ": " Produ‡„o Outros    " : "OUTROS"
                   EndMenu
                    To MenuVar
                       If MenuVar<>"Esc"
                          Then [Destino_Producao]=MenuVar
                       EndIf
           EndIf
           If Field()="Situacao_Programacao"
              Then
                   ShowPopup " Situa‡„o " @ 03,57
                        "~P~rogramada ": " Programa‡„o    " : "PROGRAMADA",
                        "~E~m produ‡„o": " Em produ‡„o    " : "EM PRODUCAO",
                        "~S~uspensa   ": " Suspensa       " : "SUSPENSA",
                        "~F~inalizada ": " Finalizada     " : "FINALIZADA"
                   EndMenu
                    To MenuVar
                       If MenuVar<>"Esc"
                          Then [Situacao_Programacao]=MenuVar
                       EndIf
           EndIf
      Case Retval="ESC":
           Switch
           Case Field()="Numero_Corte":
                If QuerDesfazer("")
                   Then If CHAVE=1
                           Then Exclusao("Cabeca")
                                CHAVE=9
                           Else Undo
                                FINALIZADO=True
                                Tecla_Funcao=""
                                OPCAO=""
                        EndIf
                        QuitLoop
                EndIf
           Case Field()="Codigo da Empresa" Or
                Field()="Data_Programacao":
                Moveto [Numero_Corte]
           Case Field()="Codigo da Tabela":
                Moveto [Codigo]
           OtherWise:
                Left
           EndSwitch
      Case Retval="PGDN" and CHAVE=0:
           FINALIZADO=True
           Tecla_Funcao=""
           OPCAO=""
           QuitLoop
      Case Retval="FIELDVIEW" or Retval="F35":
           EDITFIELD()
      Case Retval="DEL":
           If CHAVE=0
              Then If QuerEXcluir("") And Checa_Supervisor()
                      Then CHAVE=9
                           EXCLUSAO("Cabeca")
                           QuitLoop
                   EndIf
           EndIf
      Case Retval="ENTER":
        Switch
          Case Field()="Numero_Corte"  :
               If IsBlank([])
                  Then Moveto [Codigo da Empresa]
                       If Not IsBlank(SYS_EMPRESA_DEFAULT) And IsBlank([Codigo da Empresa])
                          Then [Codigo da Empresa]=SYS_EMPRESA_DEFAULT
                       EndIf
                  Else If Not BUSCA_LOOKUP("Numero_Corte",[],"Programa‡„o Corte n„o encontrada !")
                          Then Loop
                       EndIf
                       If REG_BUSCA_LOOKUP["Situacao_Programacao"]="SUSPENSA" or
                          REG_BUSCA_LOOKUP["Situacao_Programacao"]="FINALIZADA"
                          Then Mensagem("Programa‡Æo n„o permitida !// //Situa‡„o: "+REG_BUSCA_LOOKUP["Situacao_Programacao"])
                               Loop
                       EndIf
                       [Codigo da Empresa]=REG_BUSCA_LOOKUP["Codigo da Empresa"]

                       If Not Carrega_Parametros()
                          Then Loop
                       EndIf

                       Moveto [Data_Programacao]
               EndIf
          Case Field()="Codigo da Empresa"  :
               If Not IsBlank([])
                  Then If Not Carrega_Parametros()
                          Then Loop
                       EndIf
                       Moveto [Data_Programacao]
               EndIf
          Case Field()="Data_Programacao"  :
               If IsBlank([])
                  Then []=Today()
               EndIf
               Moveto [Hora_Programacao]
          Case Field()="Hora_Programacao"  :
               If IsBlank([])
                  Then []=Time()
               EndIf
               Moveto [Situacao_Programacao]
          Case Field()="Situacao_Programacao"  :
               If IsBlank([])
                  Then []="PROGRAMADA"
               EndIf
               If [Situacao_Programacao]="FINALIZADA" And CHAVE=0
                  Then FINALIZADO=True
                       CHAVE=9
                       OPCAO=""
                       QuitLoop
               EndIf
               Moveto [Destino_Producao]
          Case Field()="Destino_Producao"  :
               If IsBlank([])
                  Then Loop
               EndIf
               Moveto [Codigo]
          Case Field()="Codigo"  :
               If IsBlank([])
                  Then Loop
               EndIf
               Moveto [Codigo da Tabela]
          Case Field()="Codigo da Tabela"  :
               Tecla_Funcao=-19
               Return

          OtherWise: Right

        EndSwitch
      EndSwitch
EndWhile
EndProc

;*******************************************************************************
;* Rotina para                                                                 *
;*******************************************************************************
Proc Seleciona_Funcao()

Tecla_Funcao=""
Echo Normal
Echo Off

ShowPopup " Fun‡”es " CENTERED
 "~O~bs          ": " Alt+O = Observa‡”es                " : "-24",
 "Cor~t~e        ": " Alt+T = Carregar Itens do Corte    " : "-20",
 "~R~ela‡ao Itens": " Alt+R = Rela‡„o Itens              " : "-19",
 "~I~mprimir     ": " [F6]  = Imprimir Programa‡„o Produ‡„o/Interna/Externa " :"F6",
 "~C~ancelar     ": " Cancelar a Opera‡„o                " : "CANCELAR"
EndMenu
 To MenuVar

Echo Off

If MenuVar="CANCELAR" or MenuVar="Esc"
    Then Return False
EndIf

If MenuVar<>"F6"
   Then Tecla_Funcao=NumVal(MenuVar)
   Else Tecla_Funcao=MenuVar
EndIf

Return True

EndProc

;*******************************************************************************
;* Rotina Observacoes                                                          *
;*******************************************************************************
Proc PegaItens_Programacao()

If IsBlank([PFACC->Numero_Corte]) Or CHAVE=0
   Then Mensagem("Fun‡„o n„o permitida !")
        Return
EndIf

ShowPopup " Quantidades " CENTERED
     "~1~ com as quantidades": " Carregar com as quantidades da programa‡„o" : "COMQTD",
     "~2~ sem as quantidades": " Carregar sem as quantidades da programa‡„o" : "SEMQTD",
     "~C~ancelar            ": " Cancelar a Opera‡„o                       " : "CANCELAR"
EndMenu
 To MenuVar

If MenuVar="Esc" Or MenuVar="CANCELAR"
   Then Return
EndIf

NCORT=[PFACC->Numero_Corte]

Moveto "PFACRIG"
While RecordStatus("New")=False
  Del
EndWhile

Moveto "CFACRIG"
Moveto [Numero_Corte]
Locate NCORT
If Retval
   Then While [Numero_Corte]=NCORT
          CopyToArray REGISTRO_F1
          REGISTRO_F1["Codigo do Item"]=MudaCodigoPara(REGISTRO_F1["Codigo do Item"],"P")

          Moveto "PFACRIG"
          End
          Down
          REGISTRO_F1["Numero_Corte"]=NPROG
          Switch
            Case MenuVar="SEMQTD":
              REGISTRO_F1["Qtd1"        ]=BlankNum()
              REGISTRO_F1["Qtd2"        ]=BlankNum()
              REGISTRO_F1["Qtd3"        ]=BlankNum()
              REGISTRO_F1["Qtd4"        ]=BlankNum()
              REGISTRO_F1["Qtd5"        ]=BlankNum()
              REGISTRO_F1["Qtd6"        ]=BlankNum()
              REGISTRO_F1["Qtd7"        ]=BlankNum()
              REGISTRO_F1["Qtd8"        ]=BlankNum()
              REGISTRO_F1["Qtd9"        ]=BlankNum()
              REGISTRO_F1["Qtd10"       ]=BlankNum()
              REGISTRO_F1["Qtd11"       ]=BlankNum()
              REGISTRO_F1["Qtd12"       ]=BlankNum()
              REGISTRO_F1["Quantidade Programada"]=BlankNum()
          EndSwitch

          CopyFromArray REGISTRO_F1

          Pega_Preco("Novo")
          UnLockRecord

          Moveto "CFACRIG"
          Skip
          If EOT() Then QuitLoop EndIf

        EndWhile
   Else Mensagem("Item(s) da Programa‡„o do Corte n„o localizado(s) !")
EndIf

Moveto "PFACRIG"
EndProc

;*******************************************************************************
;* Rotina de Impressao                                                         *
;*******************************************************************************
Proc IMPRIME()
Private OPCAOC,OPCAON,ntab

ntab=table()

Moveto "PFACRIG"
If RecordStatus("New")
   Then MENSAGEM("Sem Itens p/ imprimir !")
        Moveto ntab
        Return False
EndIf
Moveto ntab

Echo Normal
Echo Off
ShowPopup " Relatorio " CENTERED
   "~I~mprimir " : " Imprimir Programa‡„o Produ‡„o/Interna/Externa "   :"Program01",
   "~C~ancelar"  : " Cancelar                  "   :"CANCELAR"
EndMenu
To Opcaoc

Echo off

If Opcaoc="Esc" Or Opcaoc="CANCELAR"
   Then Return False
EndIf

Gera_Pfacri()
Requisicao("Inclusao")
Moveto "PFACC"

NPROG  =[PFACC->Numero_Programacao]
DESTINO=[PFACC->Destino_Producao  ]
UnLockRecord
Do_It!

Dispositivo()
If OK=""
   Then CoEditKey
        Moveto [Numero_Programacao]
        Locate NPROG
        Return False
EndIf

gerou_pfacri=True
LoopdoDispositivo=False

PLAY PARAM_RELATORIO

AbreTabelas()
PickForm "2"
Moveto [Numero_Programacao]
Locate NPROG
Return True
EndProc

;*******************************************************************************
;* Rotina para Tabela de Preco                                                 *
;*******************************************************************************
Proc Pega_Preco(OpcaoP)
Private OpcaoP, TABPR, CPGTO, Registro_Tab_Preco,
        Registro_TabPreco_CondPagto, PesqOk

[Codigo da Tabela]=[PFACC->Codigo da Tabela]
CODIT=[Codigo do Item]
TABPR=[PFACC->Codigo da Tabela]
PesqOk     =False

CODIT=PegaCodigoRaiz(CODIT)

Moveto [Lookup_TabPreco_Cliente]
Ativa_Lookup()
Moveto [Codigo da Tabela]
Locate TABPR,[PFACC->Codigo],CODIT
If RetVal
   Then PesqOk=True
   Else KeyPress "ESC"
EndIf

If Not PesqOk
   Then Moveto [Lookup_TabPreco_Item]
        Ativa_Lookup()
        Moveto [Codigo da Tabela]
        Locate TABPR,CODIT
        If RetVal
           Then PesqOk=True
        EndIf
EndIf

If PesqOK
   Then CopyToArray Registro_TabPreco_Item
        KeyPress "ESC"

        [Preco Unitario       ]=Registro_TabPreco_Item["Preco Unitario"]
        [Preco Unitario Tabela]=Registro_TabPreco_Item["Preco Unitario"]
   Else KeyPress "ESC"
        [Preco Unitario       ]=BlankNum()
        [Preco Unitario Tabela]=BlankNum()
EndIf
Return True
EndProc ;(Pega_Preco)

;*******************************************************************************
;* Rotina para Localizar Registro Item                                         *
;*******************************************************************************
Proc CHAVEI()

Moveto "Pfacrig"
While True
  Moveto [Sequencia do Lancamento]
  End
  ITEM = [Sequencia do Lancamento]
  Down
  Moveto [Sequencia do Lancamento]
  Seta_Sequencia(ITEM,False)
  If IsLockRecord()
     Then Del
          Loop
  EndIf

  Opcao_Ver=False

  SetaCorRegistro("Editar")
  While true
        Moveto "Pfacrig"
        Moveto [Quantidade Programada]
        TOTQTD= ImageCSum()

        Moveto [Preco Total          ]
        TOTVR = ImageCSum()

        Moveto "PFACC"
        [Quantidade_Programada]=TOTQTD
        [Valor Total          ]=TOTVR
        UnLockRecord

        Moveto "Pfacrig"
        Moveto [Sequencia do Lancamento]

        TECLA=" Esc=Retornar  Alt+F=Fun‡”es  F3=Ver Ficha  PgDn=Finalizar  F7=Paginar  "
        Prompt TECLA

        Wait Field
           Until "ESC","ENTER","F7","HOME","UP","PGUP","PGDN","F3",-33,-24,"F6",-20

        If RetVal=-33
          Then If Not Seleciona_Funcao()
                  Then Loop
                  Else Del
                       CHAVEI=9
                       Return
               EndIf
        EndIf

        Switch
        Case RetVal="F3":
             Del
             Moveto [Sequencia do Lancamento]
             If RecordStatus("New")
                Then MENSAGEM("Sem Item p/ ver !")
                     QuitLoop
             EndIf
             Opcao_Ver=True
             CHAVEI=0
             Home
             ITEM=[Sequencia do Lancamento]
             Inicia_Registro()
             DigitaI()
             QuitLoop
        Case RetVal="PGDN":
             Del
             Moveto [Sequencia do Lancamento]
             If RecordStatus("New")=True
                Then MENSAGEM("O Lancamento deve ter pelo menos 1(um) Item Ok !")
                     QuitLoop
             EndIf
             CHAVEI=9
             FINALIZADO=True
             Tecla_Funcao=""
             Return
        Case RetVal=-24 Or RetVal="F6" or RetVal=-20:
             Tecla_Funcao=RetVal
             Del
             CHAVEI=9
             Return
        Case RetVal="F7" Or RetVal="UP" Or RetVal="PGUP" Or RetVal="HOME":
             del
             While True
               Moveto "Pfacrig"
               Moveto [Quantidade Programada]
               TOTQTD= ImageCSum()

               Moveto [Preco Total          ]
               TOTVR = ImageCSum()

               Moveto "PFACC"
               [Quantidade_Programada]=TOTQTD
               [Valor Total          ]=TOTVR
               UnLockRecord

               Moveto "Pfacrig"
               Moveto [Sequencia do Lancamento]

               PAGINA("Pfacrig","MR")
               ITEM = [Sequencia do Lancamento]
               If EDITAR="S"
                  Then CHAVEI=0
                       Controla_EdicaoI()
                  Else If EXCLUIR="S"
                          Then If QuerExcluir("")
                                  Then EXCLUSAO("Item")
                                       Moveto "Pfacrig"
                                  Else UnLockRecord
                               EndIf
                          Else QuitLoop
                       EndIf
               EndIf
               SetaPosForm()
             EndWhile
             QuitLoop
        Case Retval="ESC":
             Del
             CHAVEI=9
             Tecla_Funcao=""
             Return
        Case Retval="ENTER":
             If Not Seta_Sequencia(ITEM,True)
                Then Del
                     QuitLoop
             EndIf
             ITEM=[]
             Del
             Locate NPROG,ITEM
             If Retval
                Then CHAVEI=0
                Else CHAVEI=1
                     End Down
                     [Numero_Programacao   ] = NPROG
                     [Sequencia do Lancamento] = ITEM
                     Locate NPROG,ITEM
             EndIf
             Return
        EndSwitch
  EndWhile
EndWhile
EndProc    ; (ChaveI)

;*******************************************************************************
;* Rotina Monta Aray Grade                                                     *
;*******************************************************************************
Proc Monta_Array_Grade(Tipo)
Private i,tm,ItemPesq,Itok,ContIt,Tipo

If IsBlank([Codigo do Item])
   Then grdant="***"
        For i From 1 to 12
          Array_TM[i]="F"
        EndFor
        Return True
EndIf

ItemPesq=[Codigo do Item]

If [Codigo da Grade]<>grdant
   Then grdant=[Codigo da Grade]
        Moveto [Codigo da Grade]
        If Not Busca_Lookup("Codigo da Grade",[Codigo da Grade],"Item "+ItemPesq+" com defini‡„o de grade incorreta !//Verificar !")
           Then Return False
        EndIf
        
        Array_TM[1] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade1"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item1"]))
        Array_TM[2] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade2"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item2"]))
        Array_TM[3] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade3"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item3"]))
        Array_TM[4] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade4"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item4"]))
        Array_TM[5] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade5"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item5"]))
        Array_TM[6] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade6"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item6"]))
        Array_TM[7] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade7"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item7"]))
        Array_TM[8] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade8"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item8"]))
        Array_TM[9] ="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade9"] ,2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item9"]))
        Array_TM[10]="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade10"],2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item10"]))
        Array_TM[11]="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade11"],2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item11"]))
        Array_TM[12]="F"+Completa(REG_BUSCA_LOOKUP["Titulo Grade12"],2," ") +LTrim(RTrim(REG_BUSCA_LOOKUP["Codigo Item12"]))
Endif

If PARAM_COR_TECIDO="S" And [Tipo do Item]="D"
   Then	Return True
EndIf       

If Tipo<>"Valida"
   Then	Return True
EndIf       

For i From 1 to 12
  Tm=LTrim(RTrim(SuBstr(Array_TM[i],4,2)))
  Switch
    Case Len(Tm)=1 : ItemPesq=SubStr([Codigo do Item],1,9) QuitLoop
    Case Len(Tm)=2 : ItemPesq=SubStr([Codigo do Item],1,8) QuitLoop
  EndSwitch
EndFor
If Len(Tm)=0
   Then Return False
Endif

ItOk=True
Moveto [Codigo do Item]
Ativa_Lookup()
Moveto [Codigo do Item]
Locate Pattern ItemPesq+".."
If Not RetVal
   Then ItOk=False
        Mensagem("Itens "+ItemPesq+".. sem cadastrado !//Verificar !")
   Else ContIt=0
        While True
          Switch
            Case Len(Tm)=1 : vr=SubStr([Codigo do Item],10,1)
            Case Len(Tm)=2 : vr=SubStr([Codigo do Item],09,2)
          EndSwitch
          If vr<>"0" And vr<>"00"
             Then If [Inativo]<>"S"
                     Then For i From 1 to 12
                            If LTrim(RTrim(SuBstr(Array_TM[i],4,2)))=vr
                               Then Array_TM[i]="T"+RTrim(SubStr(Array_TM[i],2,4))
                                    ContIt=ContIt+1
                                    QuitLoop
                            EndIf
                          EndFor
                  EndIf
          EndIf
          Skip
          If EOT()
             Then QuitLoop
          EndIf
          Locate Next Pattern ItemPesq+".."
          If Not Retval
             Then QuitLoop
          EndIf
        EndWhile
        If ContIt=0
           Then Mensagem("Itens "+ItemPesq+".. Inativos//Verificar !")
        EndIf
EndIf
KeyPress "ESC"
Return ItOk
EndProc
;*******************************************************************************
;* Rotina de Digitacao Dados do Item                                           *
;*******************************************************************************
Proc Item_Dialog(Disparo,Campo,Evento,Elemento)
Private JANELA, WinArray5
TECLA=" Esc=Retornar  "
MSG_CAMPO=""
Temp=True
If INICIO_DIALOG
   Then If CHAVEI=0
           Then For i From 1 To 12
                  Array_TM[i]="F"+SubStr(Array_TM[i],2,5)
                EndFor

                Moveto [Codigo do Item]
                Ativa_Lookup()
                Moveto [Codigo do Item]
                Locate VSD_I_Codigo_Item
                If RetVal
                   Then CODANTERIOR=[Codigo do Item]
                        While SubStr([Codigo do Item],1,8)=
                              SubStr(CODANTERIOR,1,8)
                          For i from 1 to 12
                              If Len(LTrim(RTrim(SubStr(Array_TM[i],4,2))))=2
                                 Then If LTrim(RTrim(SubStr(Array_TM[i],4,2))) = SubStr([Codigo do Item],9,2)
                                         Then Array_TM[i]="T"+SubStr(Array_TM[i],2,5)
                                              QuitLoop
                                      EndIf
                                 Else If LTrim(RTrim(SubStr(Array_TM[i],4,2))) =SubStr([Codigo do Item],10,1)
                                         Then Array_TM[i]="T"+SubStr(Array_TM[i],2,5)
                                              QuitLoop
                                      EndIf
                              EndIf
                          EndFor
                          Skip
                          If EOT() Then QuitLoop EndIf
                        EndWhile
                EndIf
                KeyPress "ESC"

                Campo=AvancaCampo("I_Qtd0")
           Else Campo="I_Codigo_Item"
        EndIf
        INICIO_DIALOG=False
EndIf

If Opcao_Ver=True Then Campo="I_Seq" EndIf
If Disparo="EVENT" And DynArraySize(Evento)>0 And Evento["Type"]="KEY" Then
   Switch
      Case Opcao_Ver=True:
           Temp=False
           Switch
             Case Evento["KeyCode"] =  27:
                  CancelDialog
             OtherWise:
               Mover_Reg=True
               Switch
                 Case Evento["KeyCode"] = -71:
                      If AtFirst()
                         Then Mover_Reg=False Beep
                         Else Home
                      EndIf
                 Case Evento["KeyCode"] = -79:
                      If AtLast()
                         Then Mover_Reg=False Beep
                         Else End
                      EndIf
                 Case Evento["KeyCode"] = -73:
                      If AtFirst()
                         Then Mover_Reg=False Beep
                         Else Up
                      EndIf
                 Case Evento["KeyCode"] = -81:
                      If AtLast()
                         Then Mover_Reg=False Beep
                         Else Down
                      EndIf
               EndSwitch
               If Mover_Reg=True
                  Then ITEM=[Sequencia do Lancamento]
                       Inicia_Registro()
               EndIf
           EndSwitch
       Case Evento["KeyCode"] = 9 Or
            Evento["KeyCode"] = -15:
            Temp=False
       Case (Evento["KeyCode"] = -6 Or Evento["KeyCode"] = -147):
            If CHAVEI=0
               Then If QuerExcluir("")
                       Then CHAVEI=8
                            CancelDialog
                    EndIf
            EndIf
       Case Evento["KeyCode"] = -59:
            If Campo="I_Codigo_Item" Or
               Campo="I_Codigo_Cor_Tecido"
               Then
                    If Campo="I_Codigo_Cor_Tecido"  
                       Then Monta_Opcoes("Codigo da Cor_Tecido","")
                            Seleciona_Opcoes("Codigo da Cor_Tecido","")
                            Moveto [Codigo da Cor_Tecido ]
                       Else
                            Dynarray WinArray5[]
                            Window Handle Dialog to JANELA
                            Window GetAttributes JANELA To WinArray5
                            WinArray5["FLOATING"]=False
                            Window SetAttributes JANELA From WinArray5
        
                            If Campo="I_Codigo_Item" Then Moveto [Codigo do Item ] EndIf
        
                            ConsultaF1()
                            Window Select JANELA
                            WinArray5["FLOATING"]=True
                            Window SetAttributes JANELA From WinArray5
        
                            echo Normal
                            echo off
                    EndIf
                    If Campo="I_Codigo_Item"
                       Then VSD_I_Codigo_Item    =[Codigo do Item    ]
                            VSD_I_Descricao_Item =[Descricao do Item ]
                            VSD_I_Tipo_Item      =[Tipo do Item      ]
                            VSD_I_UN_Item        =[Unidade Interna   ]
                            Campo="I_Codigo_Item"
                    EndIf

                    If Campo="I_Codigo_Cor_Tecido"
                       Then VSD_I_Codigo_Cor_Tecido   =[Codigo da Cor_Tecido   ]
                            VSD_I_Descricao_Cor_Tecido=[Descricao da Cor_Tecido]
                    EndIf

                    Moveto "Pfacrig"
                    RefreshDialog
           EndIf
           Temp=False
      Case Evento["KeyCode"] = 27:
           Switch
             Case Campo="I_Codigo_Item":
                  If QuerDesfazer("")
                     Then CHAVEI=9
                          Del
                          CancelDialog
                  EndIf
             Case Campo="I_Codigo_Cor_Tecido"   :
                  Campo="I_Codigo_Item"
                  VSD_I_Codigo_Item   =""
                  VSD_I_Descricao_Item=""
                  VSD_I_UN_Item       =""
                  VSD_I_CF_Item       =""
                  VSD_I_CST_Item      =""
                  VSD_I_Tipo_Item     =""
                  VSD_I_Modelo_Item   =""
             Case SubStr(Campo,1,5)="I_Qtd": Campo=VoltaCampo(Campo)

             Case Campo="I_Custo_Unitario" : Campo=VoltaCampo("I_Qtd13")

             Case Campo="I_Flag":
                  Campo="I_Custo_Unitario"
           EndSwitch
           Temp=False
      Case Evento["KeyCode"] = 13:
           Switch
             Case Campo="I_Codigo_Item":
                  VSD_I_REFERENCIA  =ControlValue("I_Codigo_Item")
                  Moveto [Codigo do Item]
                  Ativa_Lookup()

                  If PARAM_COR_TECIDO="S" 
                     Then tpitemref="D"
                     Else tpitemref="P"
                  EndIf   

                  Moveto [Referencia]
                  Locate IndexOrder by "refcor_01" VSD_I_REFERENCIA, tpitemref
                  If RetVal
                     Then VSD_I_Codigo_Item   =[Codigo do Item   ]
                          If [Inativo]="S"
                             Then Mensagem("Este item: //"+[Codigo do Item]+"//"+[Descricao do Item]+"// // esta inativo !")
                                  KeyPress "ESC"
                             Else KeyPress "ESC"
                                  [Codigo do Item       ]=VSD_I_Codigo_Item
                                  [Referencia           ]=VSD_I_REFERENCIA

                                  If Not Monta_Array_Grade("Valida")
                                     Then Campo="I_Codigo_Item"
                                          return
                                  EndIf

                                  Pega_Preco("Novo")
                                  Registro_Item("Ler")
                                  Monta_Opcoes("Codigo da Cor_Tecido","")
                                  RefreshDialog

                                  Moveto "Pfacrig"

                                  If PARAM_COR_TECIDO="S"
                                    Then Campo="I_Codigo_Cor_Tecido"
                                    Else Campo=Avancacampo("I_Qtd0")
                                  EndIf  
                          EndIf
                     Else Mensagem("Referlncia n„o Cadastrada !")
                          VSD_I_Codigo_Item   =""
                          VSD_I_Descricao_Item=""
                          VSD_I_UN_Item       =""
                          VSD_I_CF_Item       =""
                          VSD_I_CST_Item      =""
                          VSD_I_Tipo_Item     =""
                          KeyPress "ESC"
                  EndIf
                  Echo Off
            Case Campo="I_Codigo_Cor_Tecido":
                 VSD_I_Codigo_Cor_Tecido=AlinhM(ControlValue("I_Codigo_Cor_Tecido"),4)
                 If Not IsBlank(VSD_I_Codigo_Cor_Tecido)
                    Then If Checa_Opcoes("Codigo da Cor_Tecido",VSD_I_Codigo_Cor_Tecido)
                            Then
                                 Moveto "Pfacrig"
                                 [Codigo da Cor_Tecido]=VSD_I_Codigo_Cor_Tecido
                                 VSD_I_Descricao_Cor_Tecido=[Descricao da Cor_Tecido]

                                 Moveto [Codigo do Item]
                                 Ativa_Lookup()

                                 tpitemref="P"
                                 Moveto [Referencia]
                                 Locate IndexOrder by "refcor_01" VSD_I_REFERENCIA, tpitemref, VSD_I_Codigo_Cor_Tecido
                                 If RetVal
                                    Then VSD_I_Codigo_Item   =[Codigo do Item   ]

                                         If [Inativo]="S"
                                            Then Mensagem("Este item: //"+[Codigo do Item]+"//"+[Descricao do Item]+"// // esta inativo !")
                                                 KeyPress "ESC"
                                            Else KeyPress "ESC"
                                                 [Codigo do Item       ]=VSD_I_Codigo_Item
                                                 [Referencia           ]=VSD_I_REFERENCIA

                                                 If Not Monta_Array_Grade("Valida")
                                                    Then Campo="I_Codigo_Item"
                                                         return
                                                 EndIf

                                                 Pega_Preco("Novo")
                                                 Registro_Item("Ler")
                                                 RefreshDialog

                                                 Moveto "Pfacrig"

                                                 Campo=Avancacampo("I_Qtd0")
                                         EndIf
                                    Else Mensagem("Referlncia n„o Cadastrada !")
                                         KeyPress "ESC"
                                 EndIf

                            Else Mensagem("Cor/Tecido n„o cadastrado para esta referencia !")
                                 VSD_I_Codigo_Cor_Tecido   =""
                                 VSD_I_Descricao_Cor_Tecido=""
                                 KeyPress "ESC"
                         EndIf
                 EndIf
                 Echo Off

             Case SubStr(Campo,1,5)="I_Qtd" : Campo=AvancaCampo(Campo)

             Case Campo="I_Custo_Unitario":
                  VSD_I_Custo_Unitario=ControlValue("I_Custo_Unitario")
                  If VSD_I_Quantidade>0 and VSD_I_Custo_Unitario>0
                     Then VSD_I_Custo_Total=VSD_I_Quantidade*VSD_I_Custo_Unitario
                     Else If VSD_I_Custo_Unitario>0
                             Then VSD_I_Custo_Total=VSD_I_Custo_Unitario
                          EndIf
                  EndIf
                  Campo="I_Flag"
             Case Campo="I_Flag"  : AcceptDialog
           EndSwitch
           Temp=False
   EndSwitch
EndIf
SelectControl Campo
TECLA=" Esc=Retornar  "
If Campo="I_Codigo_Item" Or
   Campo="I_Codigo_Cor_Tecido"
   Then TECLA=TECLA+"F1=Tabelas  "
EndIf
Switch
  Case Campo="I_Seq":
       MSGCAMPO="Sequencia"
  Case Campo="I_Codigo_Item":
       MSGCAMPO="Referlncia"
  Case SubStr(Campo,1,5)="I_Qtd" :
       MSGCAMPO="Quantidade ["+SubStr(Array_TM[NumVal( RTrim( SubStr(Campo,6,2) ) )],2,2)+"] "
  Case Campo="I_Custo_Unitario":
       MSGCAMPO="Custo Unitario"
  Case Campo="I_Custo_Total":
       MSGCAMPO="Custo Total"
  Case Campo="I_Codigo_Cor_Tecido":
       MSGCAMPO="Codigo da Cor"
  Case Campo="I_Flag":
       MSGCAMPO="[pausa]"
  OtherWise:
       MSGCAMPO=""
EndSwitch

If CHAVEI=0
    Then TECLA=TECLA+"Ctrl+Del=Excluir  "
EndIf

If Opcao_Ver=True
   Then TECLA=" Esc=Retornar  Home/End/PgDn/PgUp=Paginar  "
EndIf

@ 24,0 ?? TECLA+Spaces(80-Len(TECLA))
PaintCanvas Attribute 31 24,0,24,79
Message(MSGCAMPO)
Mouse Hide
RefreshDialog
Return TEMP
EndProc  ; (Item_Dialog)

;*******************************************************************************
;* Rotina para AvancaCampo                                                      *
;*******************************************************************************
Proc AvancaCampo(Campo)
VSD_I_Qtd1 =ControlValue("I_Qtd1")
VSD_I_Qtd2 =ControlValue("I_Qtd2")
VSD_I_Qtd3 =ControlValue("I_Qtd3")
VSD_I_Qtd4 =ControlValue("I_Qtd4")
VSD_I_Qtd5 =ControlValue("I_Qtd5")
VSD_I_Qtd6 =ControlValue("I_Qtd6")
VSD_I_Qtd7 =ControlValue("I_Qtd7")
VSD_I_Qtd8 =ControlValue("I_Qtd8")
VSD_I_Qtd9 =ControlValue("I_Qtd9")
VSD_I_Qtd10=ControlValue("I_Qtd10")
VSD_I_Qtd11=ControlValue("I_Qtd11")
VSD_I_Qtd12=ControlValue("I_Qtd12")

VSD_I_Quantidade=VSD_I_QTD1+VSD_I_QTD2+VSD_I_QTD3+VSD_I_QTD4+
                 VSD_I_QTD5+VSD_I_QTD6+VSD_I_QTD7+VSD_I_QTD8+
                 VSD_I_QTD9+VSD_I_QTD10+VSD_I_QTD11+VSD_I_QTD12
[Quantidade Programada]=VSD_I_Quantidade
If VSD_I_Quantidade>0 and VSD_I_Custo_Unitario>0
   Then VSD_I_Custo_Total=VSD_I_Quantidade*VSD_I_Custo_Unitario
EndIf
indice=NumVal(RTrim(SubStr(Campo,6,2)))
For i From indice To 12
  If (i+1)=13
     Then Campo="I_Custo_Unitario"
          QuitLoop
     Else If (i+1) > NumVal(SubStr(Campo,6,2)) And
             SubStr(Array_TM[i+1],1,1)="T"
             Then Campo=SubStr(Campo,1,5)+StrVal(i+1)
                  QuitLoop
          EndIf

  EndIf
EndFor

Return Campo
EndProc

;*******************************************************************************
;* Rotina para VoltaCampo                                                      *
;*******************************************************************************
Proc VoltaCampo(Campo)
For i From 12 to 0 Step -1
  If i=0
     Then If CHAVEI=1
             Then Campo="I_Codigo_Item"
                  VSD_I_Codigo_Item   =""
                  VSD_I_Descricao_Item=""
                  VSD_I_UN_Item       =""
                  VSD_I_CF_Item       =""
                  VSD_I_CST_Item      =""
                  VSD_I_Tipo_Item     =""
                  VSD_I_Modelo_Item   =""
                  VSD_I_Codigo_Cor_Tecido   =""
                  VSD_I_Descricao_Cor_Tecido=""
             Else CHAVEI=9
                  CopyFromArray RegItem
                  CancelDialog
          EndIf
          QuitLoop
     Else If i < NumVal(SubStr(Campo,6,2)) And
             SubStr(Array_TM[i],1,1)="T"
             Then Campo=SubStr(Campo,1,5)+StrVal(i)
                  QuitLoop
          EndIf
  EndIf
EndFor

Return Campo
EndProc

;*******************************************************************************
;* Rotina para Iniciar Registro                                                *
;*******************************************************************************
Proc Inicia_Registro()
INICIO_DIALOG=True
Moveto [Sequencia do Lancamento]
Locate [Pfacc->Numero_Programacao],ITEM
CopyToArray RegItem

Echo Normal
Echo Off

Registro_Item("Ler")
Monta_Array_Grade("")

EndProc ; (Inicia_Registro)

;*******************************************************************************
;* Rotina para Digitacao Item                                                  *
;*******************************************************************************
Proc DIGITAI()
Showdialog "Dados do Item [     ]" Proc "Item_Dialog"
   Trigger "OPEN","ARRIVE"
    Key "F1","TAB","ReverseTab","ENTER","ESC","F4","ClearArea","HOME","END","PGDN","PGUP"
     @ 10,01 height 10 width 78

   Accept @ -01,42 Width 5 "A2" Tag "I_Seq" To VSD_I_SEQ

   Label  @ 00,01 "Ref/C¢digo" For "I_Codigo_Item"
   Accept @ 01,01 Width 13 "A10" picture "!*!" Tag "I_Codigo_Item" to VSD_I_Codigo_Item
   Label  @ 00,15 "Descricao Item" For "I_Descricao_Item"
   Accept @ 01,15 Width 33 "A30" picture "!*!" Tag "I_Descricao_Item" to VSD_I_Descricao_Item
   Label  @ 00,49 "TI" For "I_Tipo_Item"
   Accept @ 01,49 Width 04 "A1" picture "&" Tag "I_Tipo_Item" to VSD_I_Tipo_Item

   Label  @ 02,02 "Cor/Tecido" For "I_Codigo_Cor_Tecido"
   Accept @ 03,07 Width 07 "A4" picture "!*!" Tag "I_Codigo_Cor_Tecido" to VSD_I_Codigo_Cor_Tecido
   Label  @ 02,15 "Descricao Cor/Tecido" For "I_Descricao_Cor_Tecido"
   Accept @ 03,15 Width 22 "A20" picture "!*!" Tag "I_Descricao_Cor_Tecido" to VSD_I_Descricao_Cor_Tecido

   @ 04,01 ?? "Prog"
   @ 04,06 ?? SubStr(Array_TM[1],2,2)
   @ 04,11 ?? SubStr(Array_TM[2],2,2)
   @ 04,16 ?? SubStr(Array_TM[3],2,2)
   @ 04,21 ?? SubStr(Array_TM[4],2,2)
   @ 04,26 ?? SubStr(Array_TM[5],2,2)
   @ 04,31 ?? SubStr(Array_TM[6],2,2)
   @ 04,36 ?? SubStr(Array_TM[7],2,2)
   @ 04,41 ?? SubStr(Array_TM[8],2,2)
   @ 04,46 ?? SubStr(Array_TM[9],2,2)
   @ 04,51 ?? SubStr(Array_TM[10],2,2)
   @ 04,56 ?? SubStr(Array_TM[11],2,2)
   @ 04,61 ?? SubStr(Array_TM[12],2,2)

   Accept @ 05,05 Width 05 "S" Tag "I_Qtd1"  to VSD_I_Qtd1
   Accept @ 05,10 Width 05 "S" Tag "I_Qtd2"  to VSD_I_Qtd2
   Accept @ 05,15 Width 05 "S" Tag "I_Qtd3"  to VSD_I_Qtd3
   Accept @ 05,20 Width 05 "S" Tag "I_Qtd4"  to VSD_I_Qtd4
   Accept @ 05,25 Width 05 "S" Tag "I_Qtd5"  to VSD_I_Qtd5
   Accept @ 05,30 Width 05 "S" Tag "I_Qtd6"  to VSD_I_Qtd6
   Accept @ 05,35 Width 05 "S" Tag "I_Qtd7"  to VSD_I_Qtd7
   Accept @ 05,40 Width 05 "S" Tag "I_Qtd8"  to VSD_I_Qtd8
   Accept @ 05,45 Width 05 "S" Tag "I_Qtd9"  to VSD_I_Qtd9
   Accept @ 05,50 Width 05 "S" Tag "I_Qtd10" to VSD_I_Qtd10
   Accept @ 05,55 Width 05 "S" Tag "I_Qtd11" to VSD_I_Qtd11
   Accept @ 05,60 Width 05 "S" Tag "I_Qtd12" to VSD_I_Qtd12


   Label  @ 04,69 "Total" For "I_Quantidade"
   Accept @ 05,66 Width 09 "N" picture "#*#.[###]" Tag "I_Quantidade" to VSD_I_Quantidade

   Label  @ 06,00 "UN" For "I_UN_Item"
   Accept @ 07,01 Width 05 "A2" picture "!*!" Tag "I_UN_Item" to VSD_I_UN_Item
              
   Label  @ 06,07 "Ct.Unitario" For "I_Custo_Unitario"
   Accept @ 07,07 Width 12 "N" picture "#*#.[#####]" Tag "I_Custo_Unitario" to VSD_I_Custo_Unitario
   Label  @ 06,20 "Ct.Total" For "I_Custo_Total"
   Accept @ 07,20 Width 12 "$" picture "#*#.[##]" Tag "I_Custo_Total" to VSD_I_Custo_Total

   Accept @ 07,43 Width 1 "A1" picture "!*!" Tag "I_Flag" to VSD_I_Flag

Enddialog
Mouse Show
If RetVal
   Then Finaliza_Registro(True)
   Else Finaliza_Registro(False)
EndIf
EndProc  ;  (DigitaI)

;*******************************************************************************
;* Rotina para Finalizar o Registro                                            *
;*******************************************************************************
Proc Finaliza_Registro(ok)
Private ok
If Ok
   Then Registro_Item("Gravar")
   Else If CHAVEI=8
           Then CopyFromArray RegItem
                Exclusao("Item")
        EndIf
EndIf
EndProc   ; (Finaliza_Registro)

;*******************************************************************************
;* Rotina para Gravacao/Leitura do Item                                        *
;*******************************************************************************
Proc Registro_Item(Funcao_Registro)
Private Funcao_Registro
Switch
  Case Funcao_Registro="Gravar":
       [Codigo do Item       ]=VSD_I_Codigo_Item
       [Descricao do Item    ]=VSD_I_Descricao_Item
       [Tipo do Item         ]=VSD_I_Tipo_Item

       [Qtd1                      ]=VSD_I_Qtd1
       [Qtd2                      ]=VSD_I_Qtd2
       [Qtd3                      ]=VSD_I_Qtd3
       [Qtd4                      ]=VSD_I_Qtd4
       [Qtd5                      ]=VSD_I_Qtd5
       [Qtd6                      ]=VSD_I_Qtd6
       [Qtd7                      ]=VSD_I_Qtd7
       [Qtd8                      ]=VSD_I_Qtd8
       [Qtd9                      ]=VSD_I_Qtd9
       [Qtd10                     ]=VSD_I_Qtd10
       [Qtd11                     ]=VSD_I_Qtd11
       [Qtd12                     ]=VSD_I_Qtd12

       [Quantidade Programada]=VSD_I_Quantidade
       [Unidade Interna      ]=VSD_I_UN_Item
       [Preco Unitario       ]=VSD_I_Custo_Unitario
       [Preco Total          ]=Round(VSD_I_Custo_Total,2)

       [Referencia                ]=VSD_I_Referencia

       [Codigo da Cor_Tecido      ]=VSD_I_Codigo_Cor_Tecido
       [Descricao da Cor_Tecido   ]=VSD_I_Descricao_Cor_Tecido

  Case Funcao_Registro="Ler":
       VSD_I_Seq                    =[Sequencia do Lancamento   ]

       VSD_I_Tipo_Item              =[Tipo do Item              ]
       VSD_I_Codigo_Item            =[Codigo do Item            ]
       VSD_I_Descricao_Item         =[Descricao do Item]
       If CHAVEI=1
          Then VSD_I_Descricao_Item=TiraTamanhoDescricaoItem(VSD_I_Descricao_Item)
       EndIf
       VSD_I_Qtd1                   =[Qtd1                      ]
       VSD_I_Qtd2                   =[Qtd2                      ]
       VSD_I_Qtd3                   =[Qtd3                      ]
       VSD_I_Qtd4                   =[Qtd4                      ]
       VSD_I_Qtd5                   =[Qtd5                      ]
       VSD_I_Qtd6                   =[Qtd6                      ]
       VSD_I_Qtd7                   =[Qtd7                      ]
       VSD_I_Qtd8                   =[Qtd8                      ]
       VSD_I_Qtd9                   =[Qtd9                      ]
       VSD_I_Qtd10                  =[Qtd10                     ]
       VSD_I_Qtd11                  =[Qtd11                     ]
       VSD_I_Qtd12                  =[Qtd12                     ]

       VSD_I_Quantidade             =[Quantidade Programada     ]
       VSD_I_UN_Item                =[Unidade Interna           ]
       VSD_I_Custo_Unitario         =[Preco Unitario            ]
       VSD_I_Custo_Total            =Round([Preco Total               ],2)

       VSD_I_Referencia             =[Referencia                ]

       VSD_I_Codigo_Cor_Tecido      =[Codigo da Cor_Tecido      ]
       VSD_I_Descricao_Cor_Tecido   =[Descricao da Cor_Tecido   ]

EndSwitch

EndProc  ; (Registro_Item)

;*******************************************************************************
;* Exclusao de Itens                                                           *
;*******************************************************************************
Proc EXCLUSAO(TIPO)
Private TIPO
Switch
Case TIPO="Cabeca":
     Moveto "Pfacri"
     Moveto [Numero_Programacao]
     Locate [Pfacc->Numero_Programacao]
     If RetVal
        Then While [Numero_Programacao]=[Pfacc->Numero_Programacao]
               Del
             EndWhile
     EndIf

     Moveto "Pfacrig"
     While RecordStatus("New")=False
       Del
     EndWhile

     Moveto "Pfacc"
     Requisicao("Exclusao")
     Del
Case TIPO="Item":
     Moveto "Pfacrig"
     Del
EndSwitch
EndProc  ; (Exclusao)

;*******************************************************************************
;* Rotina Gera Tabela Pfacrig                                                  *
;*******************************************************************************
Proc Gera_Pfacri()
Private codite

Aguarde("Convertendo programa‡„o modo padr„o")
Moveto "Pfacri"
Moveto [Numero_Programacao]
Locate [Pfacc->Numero_Programacao]
If RetVal
   Then While [Numero_Programacao]=[Pfacc->Numero_Programacao]
          Del
        EndWhile
EndIf

refant="****"

Seq=0
Moveto "Pfacrig"
Scan
  CopyToArray RegRq
	If RegRq["Referencia"]<>refant
	   Then Monta_Array_Grade("")
	        refant=[Referencia]
	EndIf        

  For ic From 1 to 12
    Aguarde("Convertendo programa‡„o modo padr„o")
    Qtd=0
    TM=RTrim(SubStr(Array_TM[ic],4,2))
    Switch
      Case ic=1:  Qtd=RegRq["Qtd1"]  
      Case ic=2:  Qtd=RegRq["Qtd2"]  
      Case ic=3:  Qtd=RegRq["Qtd3"]  
      Case ic=4:  Qtd=RegRq["Qtd4"]  
      Case ic=5:  Qtd=RegRq["Qtd5"]  
      Case ic=6:  Qtd=RegRq["Qtd6"]  
      Case ic=7:  Qtd=RegRq["Qtd7"]  
      Case ic=8:  Qtd=RegRq["Qtd8"]  
      Case ic=9:  Qtd=RegRq["Qtd9"]  
      Case ic=10: Qtd=RegRq["Qtd10"] 
      Case ic=11: Qtd=RegRq["Qtd11"] 
      Case ic=12: Qtd=RegRq["Qtd12"] 
    EndSwitch

    If Qtd>0
       Then If Len(TM)=1
               Then codite=SubStr(RegRq["Codigo do Item"],1,9)+TM
               Else codite=SubStr(RegRq["Codigo do Item"],1,8)+TM
            EndIf

            Moveto "Pfacri"
            Moveto [Numero_Programacao]
            Locate RegRq["Numero_Programacao"],codite
            If Not RetVal
               Then End Down
                    Seq=Seq+1
                    [Numero_Programacao       ]=RegRq["Numero_Programacao"]
                    [Codigo do Item           ]=codite
                    [Lookup_Itens             ]=[Codigo do Item]
            EndIf
            [Quantidade Programada    ]=[Quantidade Programada    ]+Qtd
            [Preco Unitario           ]=RegRq["Preco Unitario"]
            [Preco Unitario Tabela    ]=RegRq["Preco Unitario Tabela"]
            [Codigo da Tabela         ]=RegRq["Codigo da Tabela"]

            If [Quantidade Programada]>0
               Then [Preco Total]=[Quantidade Programada]*[Preco Unitario]
            EndIf

            Moveto "Pfacri"
            UnlockRecord
    EndIf
  EndFor

  Moveto "Pfacrig"
EndScan
CHAVEF=8
LimpAguarde()
EndProc

;*******************************************************************************
;* Atualizacao Requisicao                                                      *
;*******************************************************************************
Proc REQUISICAO(Tipo)
Private NUMEROL, RQ_ENCONTRADA, MES_EST, ANO_EST, CUSTO,
        SEQ, Tipo, CODIGO_ITEM, i, QTD_ITEM,DESTINO,NOMDEST,QTDTOT,VRTOT

If [PFACC->Destino_Producao]="ESTAMPARIA" And PARAM_BAIXESTQ_ESTAMP<>"S"
   Then Return
EndIf
If [PFACC->Destino_Producao]="BORDARIA"   And PARAM_BAIXESTQ_BORDAR<>"S"
   Then Return
EndIf
If [PFACC->Destino_Producao]="FACCAO"     And PARAM_BAIXESTQ_FACCAO<>"S"
   Then Return
EndIf
If [PFACC->Destino_Producao]="INTERNO"    And PARAM_BAIXESTQ_PROINT<>"S"
   Then Return
EndIf
If [PFACC->Destino_Producao]="LAVANDERIA" And PARAM_BAIXESTQ_LAVAND<>"S"
   Then Return
EndIf
If [PFACC->Destino_Producao]="OUTROS"     And PARAM_BAIXESTQ_OUTROS<>"S"
   Then Return
EndIf

Aguarde("Gerando requisi‡„o no estoque")

DESTINO=[PFACC->Destino_Producao      ]
NOMDEST=[PFACC->Nome Fantasia EmitDest]
Moveto "PFACC"
UnLockRecord
FormKey

If IsBlank([PFACC->Lancamento RqCabeca_PFACC])
   Then RQ_ENCONTRADA=False
   Else Moveto "\\Sistemas\\Estoque\\RQCabeca"
        Moveto [Numero do Lancamento]
        Locate [PFACC->Lancamento RqCabeca_PFACC]
        If RetVal
           then If [Codigo da Empresa]=[PFACC->Codigo da Empresa]
                   Then RQ_ENCONTRADA=True
                   Else RQ_ENCONTRADA=False
                EndIf
           Else RQ_ENCONTRADA=False
        EndIf
EndIf

If Not RQ_ENCONTRADA
   Then If Not IsBlank([PFACC->Lancamento RqCabeca_PFACC])
           Then
                LimpAguarde()
                MSG="Requisi‡„o de Estoque N. "+[PFACC->Lancamento RqCabeca_PFACC]+" n„o localizada !// //"
                MSG=MSG+"Este lan‡amento n„o ser  corrigido no Estoque !// //"
                MSG=MSG+"Motivos: - Fechamento Mensal do Estoque efetuado;          //"
                MSG=MSG+"         - Empresa da requisi‡„o n„o corresponde;          //"
                MSG=MSG+"         - Algum erro ocorrido no momento deste Lan‡amento.//"
                Mensagem(MSG)

                Moveto "PFACC"
                FormKey
                Return
        EndIf

	 Else NUMEROL=[\Sistemas\Estoque\RQCabeca->Numero do Lancamento]

        Moveto "\\Sistemas\\Estoque\\RqItem"
        Moveto [Numero do Lancamento]
        Locate NUMEROL
        If RetVal
           Then While [Numero do Lancamento]=NUMEROL
                  MES_EST = AlinhM(StrVal(Month([\Sistemas\Estoque\RqCabeca->Data de Ocorrencia])),2)
                  ANO_EST = StrVal(Year([\Sistemas\Estoque\RqCabeca->Data de Ocorrencia]))

                  Moveto "\\Sistemas\\Estoque\\SdEstq"
                  Moveto [Codigo da Empresa]
                  Locate [\Sistemas\Estoque\RqItem->Codigo da Empresa],
                         [\Sistemas\Estoque\RqItem->Codigo do Item], ANO_EST, MES_EST
                  If RetVal
                     Then While True
                            If Not IsLockRecord()
                               Then QuitLoop
                            EndIf
                          EndWhile
                          [Saldo Atual      ]=NDecimal([Saldo Atual      ]+[\Sistemas\Estoque\RqItem->Quantidade ],3)
                          [Custo Total Atual]=NDecimal([Custo Total Atual]+[\Sistemas\Estoque\RqItem->Custo Total],2)
                          If ([Custo Total Atual]/[Saldo Atual])>0
                             Then [Ultimo Custo Atual]=NDecimal([Custo Total Atual]/[Saldo Atual],5)
                          EndIf
                          UnLockRecord
                  EndIf

                  Moveto "\\Sistemas\\Estoque\\RqItem"
                  Del
                EndWhile
        EndIf
        
        Moveto "\\Sistemas\\Estoque\\RqItemg"
        Moveto [Numero do Lancamento]
        Locate NUMEROL
        If RetVal
           Then While [Numero do Lancamento]=NUMEROL
                  Del
                EndWhile
        EndIf
        
        Moveto "\\Sistemas\\Estoque\\RqCabeca"
        Del
EndIf

If Tipo="Exclusao"
   Then Moveto "PFACC"
        FormKey
        LimpAguarde()
        Return
EndIf

CODREQ =""
WS_CREQ=""
WS_DREQ=DESTINO+" "+NOMDEST

Switch
  Case DESTINO="INTERNO"    : CODREQ="000002"
  Case DESTINO="FACCAO"     : CODREQ="000003"
  Case DESTINO="ESTAMPARIA" : CODREQ="000004"
  Case DESTINO="BORDARIA"   : CODREQ="000005"
  Case DESTINO="LAVANDERIA" : CODREQ="000006"
  Case DESTINO="OUTROS"     : CODREQ="000007"
EndSwitch

Moveto "\\Sistemas\\Estoque\\Requisit"
Moveto [Codigo do Requisitante]
Locate CODREQ
If RetVal
   Then WS_CREQ=[Codigo do Requisitante]
       ;WS_DREQ=[Descricao Requisitante]
EndIf

SEQ=0
While True
 Moveto "\\Sistemas\\Estoque\\RqCabeca"
 End
 If Not IsBlank([PFACC->Lancamento RqCabeca_PFACC]) And SEQ=0
    Then NUMEROL=[PFACC->Lancamento RqCabeca_PFACC]
    Else If [Numero do Lancamento]=""
            Then NUMEROL="000001"
            Else NUMEROL=AlinhM(StrVAl(NumVal([Numero do Lancamento])+1),6)
         EndIf
 EndIf
 SEQ=SEQ+1
 Down
 [Numero do Lancamento  ]=NUMEROL
 If IsLockRecord()
    Then Del
         Loop
 EndIf

 QuitLoop
EndWhile
[Codigo da Empresa     ]=[PFACC->Codigo da Empresa]
[Tipo de Movimento     ]="S"
[Descricao do Movimento]="SAIDA"
[Tipo de Operacao      ]="C"
[Descricao da Operacao ]="CONSUMO"
[Codigo do Documento   ]="PROG"
[Numero do Documento   ]=AlinhM(StrVal([PFACC->Numero_Programacao ]),6)
[Data de Ocorrencia    ]=[PFACC->Data_Programacao]
[Requisitante          ]=WS_CREQ
[Descricao Requisitante]=WS_DREQ
Controle_Dia()
UnLockrecord

QTDTOT=0
VRTOT =0
SEQ   =0
For i From 1 to 2
  If i=1
     Then Moveto "PFACRI"
     Else Moveto "PFACRIG"
  EndIf
  If Recno()=0 Then Loop EndIf

  Moveto [Numero_Programacao]
  Locate [PFACC->Numero_Programacao]
  While [Numero_Programacao]=[PFACC->Numero_Programacao]
    If i=1
       Then CODIGO_ITEM=[Codigo do Item]
            CODIGO_ITEM=MudaCodigoPara(CODIGO_ITEM,"S")
            QTD_ITEM=[Quantidade Programada]

           MES_EST = AlinhM(StrVal(Month([PFACC->Data_Programacao])),2)
           ANO_EST = StrVal(Year([PFACC->Data_Programacao]))

           While True
             Moveto "\\Sistemas\\Estoque\\SdEstq"
             Moveto [Codigo da Empresa]
             Locate [PFACC->Codigo da Empresa ],
                    CODIGO_ITEM, ANO_EST, MES_EST
             If Not RetVal
                Then Cria_Ficha([PFACC->Codigo da Empresa ],CODIGO_ITEM,False)
                     Loop
             EndIf
             If IsLockRecord()
                Then Loop
             EndIf

             CUSTO=NDecimal([Custo Total Atual]/[Saldo Atual],5)
             If CUSTO<=0
                Then CUSTO=[Ultimo Custo Atual]
             EndIf
             [Saldo Atual      ]=NDecimal([Saldo Atual]-QTD_ITEM,3)
             [Custo Total Atual]=NDecimal([Custo Total Atual]-(QTD_ITEM*CUSTO),2)
             If ([Custo Total Atual]/[Saldo Atual])>0
                Then [Ultimo Custo Atual]=NDecimal([Custo Total Atual]/[Saldo Atual],5)
             EndIf
             UnLockRecord

             QuitLoop
           EndWhile

           While True
             Moveto "\\Sistemas\\Estoque\\EstqPrm"
             Moveto [Codigo da Empresa]
             Locate [PFACC->Codigo da Empresa], CODIGO_ITEM
             If Not RetVal
                Then End Down
                     [Codigo da Empresa   ]=[PFACC->Codigo da Empresa ]
                     [Codigo do Item      ]=CODIGO_ITEM
                     UnLockRecord
                     Loop
             EndIf
             If IsLockRecord()
                Then Loop
             EndIf
             If [PFACC->Data_Programacao]>[Data da Ultima Saida]
                Then [Data da Ultima Saida]=[PFACC->Data_Programacao]
             EndIf

             UnLockRecord
             QuitLoop
           EndWhile

           Moveto "\\Sistemas\\Estoque\\Itens"
           Moveto [Codigo do Item]
           Locate CODIGO_ITEM
           If RetVal
              Then WS_TITEM=[Tipo do Item     ]
                   WS_DITEM=[Descricao do Item]
                   WS_UNI  =[Unidade Interna  ]
              Else WS_TITEM=""
                   WS_DITEM=""
                   WS_UNI  =""
           EndIf

           Moveto "\\Sistemas\\Estoque\\RqItem"
           End
           Down
           SEQ=SEQ+1
           [Numero do Lancamento       ]=NUMEROL
           [Sequencia do Lancamento    ]=SEQ
           [Codigo da Empresa          ]=[PFACC->Codigo da Empresa ]
           [Tipo do Item               ]=WS_TITEM
           [Codigo do Item             ]=CODIGO_ITEM
           [Descricao do Item          ]=WS_DITEM
           [Quantidade                 ]=QTD_ITEM
           [Unidade Interna            ]=WS_UNI
           [Custo Unitario             ]=CUSTO
           [Custo Total                ]=NDecimal(CUSTO*[Quantidade],2)

           QTDTOT=QTDTOT+[Quantidade ]
           VRTOT =VRTOT +[Custo Total]

           UnLockrecord

      Else

           MES_EST = AlinhM(StrVal(Month([PFACC->Data_Programacao])),2)
           ANO_EST = StrVal(Year([PFACC->Data_Programacao]))

           While True
             Moveto "\\Sistemas\\Estoque\\SdEstq"
             Moveto [Codigo da Empresa]
             Locate [PFACC->Codigo da Empresa ],
                    [PFACRIG->Codigo do Item  ], ANO_EST, MES_EST
             If Not RetVal
                Then Cria_Ficha([PFACC->Codigo da Empresa ],[PFACRIG->Codigo do Item  ],False)
                     Loop
             EndIf
             If IsLockRecord()
                Then Loop
             EndIf

             CUSTO=NDecimal([Custo Total Atual]/[Saldo Atual],5)
             If CUSTO<=0
                Then CUSTO=[Ultimo Custo Atual]
             EndIf
             QuitLoop
           EndWhile

           Moveto "\\Sistemas\\Estoque\\RqItemg"
           End
           Down
           [Numero do Lancamento       ]=NUMEROL
           [Sequencia do Lancamento    ]=[PFACRIG->Sequencia do Lancamento    ]   
           [Codigo da Empresa          ]=[PFACC->Codigo da Empresa            ]
           [Codigo do Item             ]=[PFACRIG->Codigo do Item             ]
           [Tipo do Item               ]=[PFACRIG->Tipo do Item               ]
           [Referencia                 ]=[PFACRIG->Referencia                 ]
           [Descricao do Item          ]=[PFACRIG->Descricao do Item          ]
           [Codigo da Cor_Tecido       ]=[PFACRIG->Codigo da Cor_Tecido       ]
           [Descricao da Cor_Tecido    ]=[PFACRIG->Descricao da Cor_Tecido    ]
           [Qtd1                       ]=[PFACRIG->Qtd1                       ]
           [Qtd2                       ]=[PFACRIG->Qtd2                       ]
           [Qtd3                       ]=[PFACRIG->Qtd3                       ]
           [Qtd4                       ]=[PFACRIG->Qtd4                       ]
           [Qtd5                       ]=[PFACRIG->Qtd5                       ]
           [Qtd6                       ]=[PFACRIG->Qtd6                       ]
           [Qtd7                       ]=[PFACRIG->Qtd7                       ]
           [Qtd8                       ]=[PFACRIG->Qtd8                       ]
           [Qtd9                       ]=[PFACRIG->Qtd9                       ]
           [Qtd10                      ]=[PFACRIG->Qtd10                      ]
           [Qtd11                      ]=[PFACRIG->Qtd11                      ]
           [Qtd12                      ]=[PFACRIG->Qtd12                      ]
           [Quantidade                 ]=[PFACRIG->Quantidade Programada      ]
           [Unidade Interna            ]=[PFACRIG->Unidade Interna            ]
           [Codigo da Grade            ]=[PFACRIG->Codigo da Grade            ]
    
           [Custo Unitario             ]=CUSTO
           [Custo Total                ]=NDecimal(CUSTO*[Quantidade],2)
           UnLockrecord
    EndIf

    If i=1
       Then Moveto "PFACRI"
       Else Moveto "PFACRIG"
    EndIf
    Skip
    If EOT() Then QuitLoop EndIf
  EndWhile
EndFor

Moveto "\\Sistemas\\Estoque\\RqCabeca"
Moveto [Numero do Lancamento]
Locate NUMEROL
If RetVal
   Then [Quantidade Total         ]=QTDTOT
        [Valor Total              ]=VRTOT
        UnLockRecord
EndIf

Moveto "PFACC"
[Lancamento RQCabeca_PFACC]=NUMEROL
UnLockRecord
FormKey
LimpAguarde()
EndProc

;*******************************************************************************
;* Rotina para Criar Ficha do Estoque e Parametros                             *
;*******************************************************************************
Proc Cria_Ficha(ESTQ_EMPRESA,ESTQ_ITEM,ESTQ_CONFIRMA)
Private ESTQ_EMPRESA,ESTQ_ITEM,ESTQ_CONFIRMA,ESTQ_ANO,ESTQ_MES
ESTQ_MES=ALINHM(StrVal(Month([\Sistemas\Estoque\RQCabeca->Data de Ocorrencia])),2)
ESTQ_ANO=ALINHM(StrVal(Year([\Sistemas\Estoque\RQCabeca->Data de Ocorrencia])),4)

Moveto "\\Sistemas\\Estoque\\EstqPrm"
Moveto [Codigo da Empresa]
Locate ESTQ_EMPRESA, ESTQ_ITEM
If Not RetVal
   Then End Down
        [Codigo da Empresa   ]=ESTQ_EMPRESA
        [Codigo do Item      ]=ESTQ_ITEM
        UnLockRecord
EndIf

Moveto "\\Sistemas\\Estoque\\SdEstq"
While True
  Moveto [Codigo da Empresa]
  Locate ESTQ_EMPRESA, ESTQ_ITEM, ESTQ_ANO, ESTQ_MES
  If Not RetVal
     Then End Down
          [Codigo da Empresa   ]=ESTQ_EMPRESA
          [Codigo do Item      ]=ESTQ_ITEM
          [Ano Referencia      ]=ESTQ_ANO
          [Mes Referencia      ]=ESTQ_MES
          If IsLockRecord()
             Then Del
             Else UnLockRecord
          EndIf
          Loop
  EndIf
  QuitLoop
EndWhile

Return True
EndProc  ; (Cria_Ficha)

;*******************************************************************************
;* Entrada e Saida de Estoque                                                  *
;*******************************************************************************
Proc ESTOQUE(OPER,TPMOV,CODITEM,QTD,VR)
Private OPER,COD_EMPRESA,TPMOV,CODITEM,QTD,VR

COD_EMPRESA=[RqCabeca->Codigo da Empresa]

MES=ALINHM(StrVal(Month([RqCabeca->Data de Ocorrencia])),2)
ANO=ALINHM(StrVal(Year([RqCabeca->Data de Ocorrencia])),4)

Moveto "SdEstq"
Moveto [Codigo da Empresa]
Locate COD_EMPRESA, CODITEM, ANO, MES
If Not RetVal
   Then Cria_Ficha(COD_EMPRESA,CODITEM,False)
EndIf
While True
  If IsLockRecord()
     Then Loop
  EndIf

  If TPMOV="E"
     Then [Saldo Atual      ]=NDecimal([Saldo Atual]+QTD,3)
          [Custo Total Atual]=NDecimal([Custo Total Atual]+VR,2)
     Else [Saldo Atual      ]=NDecimal([Saldo Atual]-QTD,3)
          [Custo Total Atual]=NDecimal([Custo Total Atual]-VR,2)
  EndIf
  If ([Custo Total Atual]/[Saldo Atual])>0
     Then [Ultimo Custo Atual]=NDecimal([Custo Total Atual]/[Saldo Atual],5)
  EndIf

  If OPER="IncAlt" And TPMOV="E"
     Then CUSTO=[Preco de Custo        ]
  EndIf

  UnLockRecord

  QuitLoop
EndWhile

If OPER="IncAlt" And TPMOV="S"
   Then While True
          Moveto "EstqPrm"
          Moveto [Codigo da Empresa]
          Locate COD_EMPRESA, [RqItem->Codigo do Item]
          If Not RetVal
             Then End Down
                  [Codigo da Empresa   ]=COD_EMPRESA
                  [Codigo do Item      ]=[RqItem->Codigo do Item]
                  UnLockRecord
                  Loop
          EndIf
          If IsLockRecord()
             Then Loop
          EndIf
          If [RqCabeca->Data de Ocorrencia]>[Data da Ultima Saida]
             Then [Data da Ultima Saida]=[RqCabeca->Data de Ocorrencia]
          EndIf
          UnLockRecord

          QuitLoop
        EndWhile
EndIf
EndProc  ; (Estoque)



;*******************************************************************************
;* Rotina p/ Montar Opcoes p/ Grade                                            *
;*******************************************************************************
Proc Monta_Opcoes(OPCAODIVERSAS, ITEMDESEJADO)
Private OPCAODIVERSAS, ITEMDESEJADO, wcg, icg, icgt, tnovo, nomecampo,opconta
nomecampo=Field()
If IsAssigned(Opcoes)
   Then Release Vars Opcoes
EndIf
DynArray Opcoes[]
Switch
  Case OPCAODIVERSAS="Codigo da Cor_Tecido":
       Moveto [Lookup_Itens_Cor]
EndSwitch
Ativa_Lookup()
Moveto [Codigo do item]
Locate VSD_I_Codigo_Item 

wcg=0
While [Codigo do Item]=VSD_I_Codigo_Item   
  Switch
    Case OPCAODIVERSAS="Codigo da Cor_Tecido" And SYS_CODIGO_CLIENTE="0222":
         wcg=wcg+1
         Opcoes[wcg]=AlinhM(StrVal([Sequencia da Cor_Tecido]),4)+"  "+[Codigo da Cor_Tecido]+"-"+Completa([Descricao da Cor_Tecido],30," ")
    Case OPCAODIVERSAS="Codigo da Cor_Tecido":
         wcg=wcg+1
         Opcoes[wcg]=Completa([Descricao da Cor_Tecido],30," ")+" "+[Codigo da Cor_Tecido]+" - "+Format("W2,AR",[Sequencia da Cor_Tecido])
  EndSwitch
  Skip
  IF EOT() Then QuitLoop EndIf
EndWhile
KeyPress "ESC"
Moveto Field nomecampo
EndProc    ; (Monta_Opcoes)

;*******************************************************************************
;* Rotina p/ Checagem Opcoes p/ Grade                                          *
;*******************************************************************************
Proc Checa_Opcoes(OPCAODIVERSAS, VALORDESEJADO)
Private OPCAODIVERSAS, VALORDESEJADO, icg, resultado

If DynArraySize(Opcoes)=0
   Then Return False
EndIf

resultado=false
For icg From 1 To DynArraySize(Opcoes)
  Switch
    Case OPCAODIVERSAS="Codigo da Cor_Tecido" And SYS_CODIGO_CLIENTE="0222":
         If RTrim(SubStr(Opcoes[icg],07,4))=VALORDESEJADO
            Then resultado=true
         EndIf
    Case OPCAODIVERSAS="Codigo da Cor_Tecido":
         If RTrim(SubStr(Opcoes[icg],32,4))=VALORDESEJADO
            Then resultado=true
         EndIf
  EndSwitch
  If resultado
     then MontaRegistro_F1(OPCAODIVERSAS,icg)
          QuitLoop
  EndIf
EndFor
return resultado
EndProc         ;  (Checa_Opcoes)

;*******************************************************************************
;* Rotina Montar Registro_F1 p/ Grade                                          *
;*******************************************************************************
Proc MontaRegistro_F1(OPCAODIVERSAS, indice)
private OPCAODIVERSAS, indice

If IsAssigned(Registro_F1)
   Then Release Vars Registro_F1
EndIf
DynArray Registro_F1[]
Switch
  Case OPCAODIVERSAS="Codigo da Cor_Tecido" And SYS_CODIGO_CLIENTE="0222":
       Registro_F1["Codigo da Cor_Tecido"]         =RTrim(SubStr(Opcoes[indice],07,4))
       Registro_F1["Descricao da Cor_Tecido"]      =RTrim(SubStr(Opcoes[indice],12,30))
       If IsAssigned(VSDGCORTECIDO)
          Then VSD_I_Codigo_Cor_Tecido   =Registro_F1["Codigo da Cor_Tecido"]
               VSD_I_Descricao_Cor_Tecido=Registro_F1["Descricao da Cor_Tecido"]
       EndIf
  Case OPCAODIVERSAS="Codigo da Cor_Tecido"  :
       Registro_F1["Codigo da Cor_Tecido"]         =RTrim(SubStr(Opcoes[indice],32,4))
       Registro_F1["Descricao da Cor_Tecido"]      =RTrim(SubStr(Opcoes[indice],01,30))
       If IsAssigned(VSDGCORTECIDO)
          Then VSD_I_Codigo_Cor_Tecido   =Registro_F1["Codigo da Cor_Tecido"]
               VSD_I_Descricao_Cor_Tecido=Registro_F1["Descricao da Cor_Tecido"]
       EndIf
EndSwitch
EndProc    ;  (Monta_RegistroF1)

;*******************************************************************************
;* Rotina de Selecionar Grade                                                  *
;*******************************************************************************
Proc Seleciona_Opcoes(OPCAODIVERSAS,SEMRETORNO)
Private OPCAODIVERSAS, LJ, AJ, nc, SEMRETORNO

If DynArraySize(Opcoes)=0
   Then Mensagem("Tabela sem Registros !")
        Return False
EndIf

AJ=DynArraySize(Opcoes)
If AJ>15
   Then AJ=15
   Else If AJ<3 Then AJ=3 EndIf
EndIf

Switch
  Case OPCAODIVERSAS="Codigo da Cor_Tecido"   : LJ=43 nc=1
EndSwitch

ArrayElement=0
Showdialog "Consulta "+OPCAODIVERSAS Proc "Opcoes_Dialog"
   Trigger "OPEN","ARRIVE"
    Key "TAB","ReverseTab","ENTER","ESC"
     @ 13,09 height AJ+2 width LJ+5

   PickDynArray @0,01 Height AJ width LJ
   Columns nc
   Opcoes
   Tag "TG_OPCAO"
   To ArrayElement
EndDialog
Mouse Show
If RetVal
   Then If SEMRETORNO<>"SR"
           Then Switch
                  Case OPCAODIVERSAS="Codigo da Cor_Tecido":
                  [Codigo da Cor_Tecido   ]=Registro_F1["Codigo da Cor_Tecido"]
                  [Descricao da Cor_Tecido]=Registro_F1["Descricao da Cor_Tecido"]
                EndSwitch
                Return True
        EndIf
   Else Return False
EndIf
EndProc   ; (Seleciona_Opcoes)




;*******************************************************************************
;* Rotina para Carregar Parametros                                             *
;*******************************************************************************
Proc Carrega_Parametros()
Private Result

If IsEmpty("P_Fac")
   Then Mensagem("N„o esta Configurado os Parametros para Digita‡„o !")
        Result=False
   Else 
        UnLockRecord
        KeyPress "F7"
        While True
          If Not IsLockRecord()
             Then QuitLoop
          EndIf
        EndWhile
        
        Moveto "P_Fac"
        Moveto [Codigo_Empresa]
        Locate [Pfacc->Codigo da Empresa]
        If Not RetVal
           Then Mensagem("Parametros n„o Cadastrado para esta Empresa !")
                Result=False
           Else 
                PARAM_EMPRESA         = [Codigo_Empresa           ]
                PARAM_COR_TECIDO      = [Cor_Tecido               ]
                PARAM_RELATORIO       = [Script_Impressao_ProgFac ]
                PARAM_BAIXESTQ_ESTAMP = [Baixar_SemiAcab_Estamp   ]
                PARAM_BAIXESTQ_BORDAR = [Baixar_SemiAcab_Bordar   ]
                PARAM_BAIXESTQ_FACCAO = [Baixar_SemiAcab_Faccao   ]
                PARAM_BAIXESTQ_PROINT = [Baixar_SemiAcab_ProdInt  ]
                PARAM_BAIXESTQ_LAVAND = [Baixar_SemiAcab_Lavand   ]
                PARAM_BAIXESTQ_OUTROS = [Baixar_SemiAcab_Outros   ]

                Result=True
        EndIf
EndIf

Moveto "Pfacc"
KeyPress "F7"

Return Result
EndProc

Proc AbreTabelas()
View NoWindow "P_FAC"
View NoWindow "\\Sistemas\\Estoque\\RqCabeca"
View NoWindow "\\Sistemas\\Estoque\\RqItem"
View NoWindow "\\Sistemas\\Estoque\\RqItemg"
View NoWindow "\\Sistemas\\Estoque\\RqMatpri"
View NoWindow "\\Sistemas\\Estoque\\EstqPrm"
View NoWindow "\\Sistemas\\Estoque\\SdEstq"
View NoWindow "\\Sistemas\\Estoque\\Itens"
View NoWindow "\\Sistemas\\Estoque\\Requisit"
View NoWindow "\\Sistemas\\Producao\\FormulaC"
View NoWindow "\\Sistemas\\Producao\\FormulaI"
View NoWindow "PFACRI"
View NoWindow "PFACRIG"
CoEdit "PFACC"
EndProc

;*******************************************************************************
;* Rotina para controlar Edicao do registro                                    *
;*******************************************************************************
Proc Controla_EdicaoI()
INICIA_REGISTRO()
DIGITAI()
EndProc

;*******************************************************************************
;* Rotina para controlar Edicao do registro                                    *
;*******************************************************************************
Proc Controla_EdicaoC()
FINALIZADO=False
While Not FINALIZADO

  Tecla_Funcao=BlankNum()
  DIGITA()
  If CHAVE=9 Then QuitLoop EndIf
  INICIO=False

  CODITEM_ANTERIOR=""
  VLRITEM_ANTERIOR=BlankNum()

  While Not IsBlank(Tecla_Funcao)

    Switch
      Case Tecla_Funcao="F6":
           If Imprime()
               Then FINALIZADO=True
                    Tecla_Funcao=""
           EndIf
           Switch
             Case Table()="Pfacc"   : Tecla_Funcao=""
             Case Table()="Pfacrig" : Tecla_Funcao=-19
           EndSwitch

      Case Tecla_Funcao=-24:
           Tabela=Table()
           Moveto "PFACC"
           Edita_Memo("Observacoes",08,07,12,65,"Observa‡”es")
           Moveto Tabela
           Switch
             Case Table()="Pfacc"   : Tecla_Funcao=""
             Case Table()="Pfacrig" : Tecla_Funcao=-19
           EndSwitch

      Case Tecla_Funcao=-20:
           Switch
             Case Table()="Pfacc"   : Tecla_Funcao=""
                                      Mensagem("Fun‡Æo ativa em Rela‡„o de Itens")
             Case Table()="Pfacrig" : Tecla_Funcao=-19
                                      PegaItens_Programacao()
           EndSwitch

      Case Tecla_Funcao=-19:
           While True
             CHAVEI()
             If CHAVEI=9 Then QuitLoop EndIf
             Controla_EdicaoI()
           EndWhile
      OtherWise            : QuitLoop
    EndSwitch

  EndWhile

  If Finalizado
     Then If Not gerou_pfacri
          Then Gera_Pfacri()
               Requisicao("Inclusao")
          EndIf
  EndIf

  Moveto "PFACC"
EndWhile
If RecordStatus("Locked") Then UnLockRecord EndIf
If OPCAO_FORM="F"
   Then PickForm "F"
EndIf
EndProc

;*******************************************************************************
;* Rotina Principal                                                            *
;*******************************************************************************
AutoLib="\\Sistemas\\Cadastro\\Bibliot,\\Sistemas\\Cadastro\\Bib_Show"

If Not IsAssigned(SYS_EMPRESA_DEFAULT) Then SYS_EMPRESA_DEFAULT=""   EndIf
If Not IsAssigned(SYS_NCONEXAO)        Then SYS_NCONEXAO      =""    EndIf
If Not IsAssigned(SYS_ESTACAO)         Then SYS_ESTACAO       =""    EndIf
If Not IsAssigned(SYS_VERSAO_SO)       Then SYS_VERSAO_SO="Windows"  EndIf
If Not IsAssigned(SYS_CHAPA_USUARIO)   Then SYS_CHAPA_USUARIO="9999" EndIf
If Not IsAssigned(SYS_NIVEL_USUARIO)   Then SYS_NIVEL_USUARIO="S"    EndIf
If Not IsAssigned(SYS_CONTROLE_DIA)    Then SYS_CONTROLE_DIA=""      EndIf
If Not IsAssigned(SYS_NOME_USUARIO)    Then SYS_NOME_USUARIO=""      EndIf
If Not IsAssigned(SYS_CODIGO_CLIENTE)  Then SYS_CODIGO_CLIENTE=""    EndIf

Array Array_TM[12]
grdant="***"

AbreTabelas()
PickForm "F"
OPCAO_FORM="F"
While True
  CHAVE()
  If CHAVE=9 Then QuitLoop EndIf
  If CHAVE=1 Then Controle_Dia() EndIf
  If CHAVE=5
     Then If OPCAO_FORM="F"
             Then PickForm "F"
             Else PickForm "2"
          EndIf
          Loop
  EndIf
  Controla_EdicaoC()
EndWhile
Do_It!
ClearAll
Release Vars All
Release Procs All
