[Resolvido]Verificar se registro existe para o mês atual e assim liberar a emissão de guias para o mesmo

Saudações!

Tenho uma tela de emissão de guias de exames na qual necessito de um código que verifique se existe o registro do pagamento da mensalidade (na tb_contribuicoes) referente ao mês atual conforme a matrícula selecionada, com base nisso libera a emissão da guia, caso contrário apresenta mensagem informando que o segurado não pode ter o documento da guia gerada no mês.

Formulário:
frm_guia_assistencia_medica

Caixa de combinação que contém o código: (no evento antes de atualizar).  
Segurado

Tabela que contém os valores pagos:
tb_contribuicoes


A verificação seria pela tabela de contribuições onde ao verificar que os campos: Matricula, MesContribuicao, AnoContribuicao  correspondem a matrícula selecionada na combo e ao mês e ano atuais então assim libera para passar para o outro campo, caso não correspondam apresenta a mensagem.

A título de teste utilizo a matricula 5050 que teve contribuição em todos os meses menos no mês 09.

Tentei adaptar o código enviado a mim pelo amigo Piloto, porém estou tendo dificuldade por ainda ser iniciante, por isso peço ajuda.

http://maximoaccess.forumeiros.com/t15166-resolvido-bloquear-o-cadastro-de-dados-duplicados-no-campo-matricula

Boas... Dê o passo a passo para que eu teste....
E cite o que deseja.


Cumprimentos.

Caro Piloto, saudações!

Seria conforme a seguir:

1 – Abrir tela de emissão de guias (frm_guia_assistencia_medica)

2 – Selecionar no campo Matrícula (que é a caixa de combinação Segurado) a Matricula 5050 por exempo.  Neste momento o sistema verifica na tabela: tb_contribucoes se existe um pagamento correspondente para: o mês atual (9), ano atual (2013) e matricula selecionada (5050), por meio dos campos da tabela tb_contribuicoes: Matricula, MesContribuicao, AnoContribuicao.  Para esta verificação poderia comparar com os campos do formulário(frm_guia_assistencia_medica):  Segurado (Caixa de combinação que guarda a matricula selecionada); MesAtual (caixa de texto que indica o mês atual de emissão da guia) e AnoAtual (caixa de texto que indica o Ano atual de emissão da guia).

3 – Como resultado da comparação teríamos duas situações:
3.1 – Caso exista um registro totalmente correspondente na tabela tb_contribuicoes
(e.x:  Matricula = 5050, MesContribuicao = 9, AnoContribuicao = 2013) então exibe uma mensagem: Segurado apto para emissão de guias.  E em seguida deixa-se selecionar no formulário o próximo campo de preenchimento da guia que é o Consultorio conveniado  e assim assim em diante.
       3.2 – Caso o resultado da verificação seja diferente (como exemplo deixei a matricula 5050 com contribuição em todos os meses menos no mês 09.) sendo assim, não encontrando registro totalmente correspondente a matrícula selecionada, ao mês atual e ao ano atual, então o sistema exibiria uma mensagem: o segurado não está habilitado para emissão de guias !.  E não deixaria prosseguir com o preenchimento dos demais campos da tela.

Anexo envio um detalhamento da tela de emissão visando ajudar no detalhamento.
Grato,
Williams

Para diminuirmos a quantidade de registros no recordset abriremos o mesmo já filtrado pelo paciente;
Quando não existe nenhum registro para o paciente produzirá o erro 3021, assim sendo o tratamos

'---------------------------------------------------------------------------------------
' Procedure     : Segurado_BeforeUpdate
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 13/09/2013
' Comentários   : Pesquisa na tabela se existe registro correspondente
'---------------------------------------------------------------------------------------
Private Sub Segurado_BeforeUpdate(Cancel As Integer)
On Error GoTo TrataErro

Dim rs As DAO.Recordset
Dim strSQL As String

strSQL = "Select * From tb_Contribuicoes WHERE Matricula = '" & Me.Segurado.Column(1) & "'"
Set rs = CurrentDb.OpenRecordset(strSQL)
rs.MoveFirst: rs.MoveLast
Do While Not rs.EOF
    If rs!Mescontribuicao = MesAtual And Me.ano_guia = rs!AnoContribuicao Then
        MsgBox "Parcela encontrada " & rs!Mescontribuicao & " e Ano " & rs!AnoContribuicao & ""
        Exit Sub
    End If
rs.MoveNext
Loop
    MsgBox "Parcela não encontrada"
Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
Exit Sub
TrataErro:
    Select Case err.Number
        Case 3021
           MsgBox "Não existe registro de parcelas para este paciente", vbCritical, "REGISTRO NÃO ENCONTRADO"
        Case Else
          DoCmd.Hourglass False
          DoCmd.Echo True
        MsgBox "Erro Gerado no form frm_guia_assistencia_medica" _
                & vbNewLine & "No Procedimento: matricula_dep_BeforeUpda" _
                & vbNewLine & "Erro Número: " & err.Number _
                & vbNewLine & "linha: " & Erl _
                & vbNewLine & "Descrição: " & err.Description _
                & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, err.Number & ", linha:" & Erl
    End Select
End Sub



Cumprimentos.

Saudações amigo Piloto!  Desde já agradeço a atenção !

Fiz um teste com o registro 5050
Coloquei uma parcela de pagamento na tabela contribuições, com os seguintes dados:

CodigoContribuicao:8743    Matricula: 5050 MesContribuicao: 9 AnoContribuicao: 2013 ValorContribuicao:30


Na tela de emissão fiz o preenchimento dos seguintes dados:
Matrícula: 5050
Ano atual:2013    Mês Atual: 9

A mensagem apresentada foi "Parcela não encontrada".  Para este caso precisaria que a mensagem fosse: "Parcela Encontrada".

A mensagem: "Parcela não encontrada"   seria para o caso de quando os dados atuais não batem com a parcela de pagamento existentes na tabela de contribuições.

Atenciosamente,
Williams.

Estava entendendo as caixas texto como string... Aplique então o Cint para colocar como integer e aplique no evento após atualizar:

'---------------------------------------------------------------------------------------
' Procedure     : Segurado_BeforeUpdate
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 13/09/2013
' Comentários   : Pesquisa na tabela se existe registro correspondente
'---------------------------------------------------------------------------------------
Private Sub Segurado_AfterUpdate()
On Error GoTo TrataErro

Dim rs As DAO.Recordset
Dim strSQL As String

strSQL = "Select * From tb_Contribuicoes WHERE Matricula = '" & Me.Segurado.Column(1) & "'"
Set rs = CurrentDb.OpenRecordset(strSQL)
rs.MoveFirst: rs.MoveLast
Do While Not rs.EOF
    If rs!MesContribuicao = CInt(MesAtual) And rs!AnoContribuicao = CInt(Me.ano_guia) Then
        MsgBox "Parcela encontrada " & rs!MesContribuicao & " e Ano " & rs!AnoContribuicao & ""
        Exit Sub
    End If
rs.MoveNext
Loop
    MsgBox "Parcela não encontrada"
Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
Exit Sub
TrataErro:
    Select Case err.Number
        Case 3021
           MsgBox "Não existe registro de parcelas para este paciente", vbCritical, "REGISTRO NÃO ENCONTRADO"
        Case Else
          DoCmd.Hourglass False
          DoCmd.Echo True
        MsgBox "Erro Gerado no form frm_guia_assistencia_medica" _
                & vbNewLine & "No Procedimento: matricula_dep_BeforeUpda" _
                & vbNewLine & "Erro Número: " & err.Number _
                & vbNewLine & "linha: " & Erl _
                & vbNewLine & "Descrição: " & err.Description _
                & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, err.Number & ", linha:" & Erl
    End Select

End Sub

Cumprimentos.

Grande amigo Piloto, o seu código resolveu a situação! Muito grato !
Williams

O Fórum agradece o Retorno.

Olá Piloto Saudações!
Inicialmente gostaria de agradecer novamente a grande ajuda quanto ao tópico.

Estou tendo a necessidade de acrescentar algumas regras no código que você desenvolveu.

A rotina que desenvolveu controla se a pessoa pagou ou não e está ótima!

A segunda parte funcionaria assim:

Após a  primeira verificação se pagou ou não; preciso colocar na Caixa de combinação: Consultorio um código que conte (some) qual foi a quantidade de guias existentes para a pessoa na tabela tb_guia_assistencia_medica conforme o Mês Atual.  Então se a quantidade for igual ou superior a 2 (ou seja, dois registros) apresentar a mensagem de que a pessoa já atingiu o limite mensal de guias, caso contrário pode passar para o próximo campo normalmente.

Com isso ocorreria a checagem se a pessoa têm ou não direito a pegar outra guia , conforme o estabelecido no Mês que são duas guias.´
Creio que seria uma modificação no primeiro código que me enviou para aplicar em outra caixa de combinação, pois, nesse caso teria que contar as quantidades.

grato,
Williams.

Vou te passar uma ideia:

Me.CaixaTexto = MsgBox DCount("*", "tb_guia_assistencia_medica", "Id_Paciente = " & Me.Segurado & " And  Format([dt_emissao],'m') =  Format(Now(),'m')")

A caixa texto ficará preenchida com o número de guias para o paciente no mes..

Utilize a caixa para as devidas checagens.

If Me.CaixaTexto > 2 Then
    sua mensagem
Else
    sua mensagem
End if


Cumprimentos.

Piloto Saudações!

Inseri o código abaixo e retornou um mensagem:

Me.TxtcOTA = MsgBox DCount("*", "tb_guia_assistencia_medica", "Id_Paciente = " & Me.Segurado & " And Format([dt_emissao],'m') = Format(Now(),'m')")


Mensagem: Era esperado Fim da instrução.

Williams

Eita.. eu tinha colocado pra apresentar em uma msgBox.. esqueci de tirar a mesma...

Mas você pelo jeito não se esforçou para entender o que estava errado...
as vezes a idéia é para que você possa desenvolver o restante do que necessita.. mas se não procurar entender o que o código faz..
Procure sempre entender o código.. assim aumentará em conhecimento.

Retire o MsgBox.


Cumprimentos.

Piloto,
Resolveu.
Grato
Williams.

O Fórm agradece o Retorno.

Saudações Piloto,
Estou com duvida para altera o código abaixo inserindo mais uma condição, que seria também identificando o valor 91 no campo Id_Especialidade.Value = "91"
O código original é o seguinte:
'Mostra a cota mensal
Me.txtCota = DCount("*", "tb_guia_assistencia_medica_Demais", "Id_Paciente = " & Me.Segurado & " And Format([dt_emissao],'m') = Format(Now(),'m')")

Fiz a alteração porém não funcionou:
Me.TxtCotaFono = DCount("*", "tb_guia_assistencia_medica_Demais", "Id_Paciente = " & Me.Segurado & " And Format([dt_emissao],'m') = Format(Now(),'m') & " And Id_Especialidade.Value = "91")

Me.TxtCotaFono = DCount("*", "tb_guia_assistencia_medica_Demais", "Id_Paciente = " & Me.Segurado & " And Format([dt_emissao],'m') = " & Format(Now(),'m') & " And Id_Especialidade = 91")

Tente assim.

Cumprimentos.

Piloto,

Testei mas deu um pequeno problema:

Microsoft Visual Basic for Applications
---------------------------
Erro de compilação:

Era esperado: expressão
---------------------------
OK Help
---------------------------

na parte da instrução: Format(Now(),'m')

especificamente na primeira ' antes do m')

Tente assim:

DCount("*", "tb_guia_assistencia_medica", "Id_Paciente = " & Me.Segurado & " And Format([dt_emissao],'m') = " & Format(Now(), "m") & " And Id_Especialidade = 91")


Cumprimentos.