Rotina de esta travando quando aberta pela segunda estação
Enviado: 12 Dez 2005 17:15
Caro Amigos,
Tenho uma rotina simples de baixa de parcelas, acontece que no servidor está funciona normalzinho e bem rapida por sinal, mais o segundo micro quando abre essa mesma rotina simplesmente quando vai selecionar o cupom para baixar a parcela o sistema trava e inclusive trava o outra estação lá no servidor.
Gostaria que alguem desse uma olhadinha nela e me auxilia-se se possivel.
Obrigado
Marcio Ril
* TITULO : SISCREDI - SISTEMA DE CREDIARIO
* DATA : 18/10/2005
* PROGRAMA : BXCARNE.PRG
* COMENTARIO : BAIXA TITULO COM CARNE
SETCOLOR("B/W,W/N+,,,B/W")
WKTELA2 := SAVESCREEN(00,00,24,79)
IF !FILE("INDCLI1.IDX")
SELECT 1
USE CLIENTE ALIAS CLIENTE
INDEX ON COD_CLI TO INDCLI1
INDEX ON NOME_CLI TO INDCLI2
SET INDEX TO INDCLI1, INDCLI2
ELSE
SELECT 1
USE CLIENTE ALIAS CLIENTE
SET INDEX TO INDCLI1, INDCLI2
ENDIF
IF !FILE("INDVE1.IDX")
SELECT 3
USE VENDEDOR ALIAS VENDEDOR
INDEX ON COD_VEN TO INDVE1
INDEX ON NOME_VEN TO INDVE2
SET INDEX TO INDVE1, INDVE2
ELSE
SELECT 3
USE VENDEDOR ALIAS VENDEDOR
SET INDEX TO INDVE1, INDVE2
ENDIF
IF !FILE("INDME1.IDX")
SELECT 13
USE MENSAGEM ALIAS MENSA
INDEX ON COD_MEN TO INDME1
SET INDEX TO INDME1
ELSE
SELECT 13
USE MENSAGEM ALIAS MENSA
SET INDEX TO INDME1
ENDIF
IF !FILE("INDCO1.IDX")
SELECT 4
USE CONTRATO ALIAS CONTRATO
INDEX ON COD_CON TO INDCO1
INDEX ON COD_CON + COD_CLI TO INDCO2
SET INDEX TO INDCO1, INDCO2
ELSE
SELECT 4
USE CONTRATO ALIAS CONTRATO
SET INDEX TO INDCO1, INDCO2
ENDIF
IF !FILE("INDCX1.IDX")
SELECT 5
USE CAIXA ALIAS CAIXA
INDEX ON COD_CON TO INDCX1
INDEX ON COD_CON + VALOR_CON TO INDCX2
INDEX ON COD_CON + COD_CLI TO INDCX3
INDEX ON DTEM_CON TO INDCX4
SET INDEX TO INDCX1, INDCX2, INDCX3, INDCX4
ELSE
SELECT 5
USE CAIXA ALIAS CAIXA
SET INDEX TO INDCX1, INDCX2, INDCX3, INDCX4
ENDIF
IF !FILE("INDCA1.IDX")
SELECT 2
USE CARNE ALIAS CARNE
INDEX ON NUM_PAR TO INDCA1
INDEX ON COD_CON TO INDCA2
INDEX ON COD_CLI TO INDCA3
INDEX ON DTVEN_PAR + NUM_PAR TO INDCA4
INDEX ON COD_CON + COD_CLI TO INDCA5
INDEX ON COD_CON + NUM_PAR TO INDCA6
SET INDEX TO INDCA1, INDCA2, INDCA3, INDCA4, INDCA5, INDCA6
ELSE
SELECT 2
USE CARNE ALIAS CARNE
SET INDEX TO INDCA1, INDCA2, INDCA3, INDCA4, INDCA5, INDCA6
ENDIF
IF !FILE("INDCH1.IDX")
SELECT 6
USE CHEQUE ALIAS CHEQUE
INDEX ON NUM_CH TO INDCH1
INDEX ON COD_CLI TO INDCH2
INDEX ON NUM_CH + COD_CLI TO INDCH3
INDEX ON NUM_CH + COD_CON TO INDCH4
INDEX ON COD_CON TO INDCH5
SET INDEX TO INDCH1, INDCH2, INDCH3, INDCH4, INDCH5
ELSE
SELECT 6
USE CHEQUE ALIAS CHEQUE
SET INDEX TO INDCH1, INDCH2, INDCH3, INDCH4, INDCH5
ENDIF
SET DELETED ON
DO WHILE .T.
MENSAGEM("Tecle <ESC> para retornar")
WHORA_PG := TIME()
WCOD_CLI := 0
WCOD_FOR := 0
WCODIGO := 0
WCOD_CON := 0
WCOD_DOC := 0
WQTDE_PAR := 0
WTP_PG_CON := 3
WNUM_PAR := 0
WVL_PAR := 0
WDTEM_CON := DATAATU
WDTBASE := DATAATU
WDTVEN_PAR := DATAATU
WVL_PAR_PG := 0
WDT_PAR_PG := DATAATU
WCOD_VEN := 0
WENTRADA := 0
WVALOR_CON := 0
WRESTO := 0
WCAIXA := 0
WTIPOB := "D"
WTIPO := "P"
WCONTA := "R"
WCONTADOR := 0
JANELA(04,10,20,69," BAIXA PARCELAS - CARNES ")
COR("MENU")
@ 06,13 SAY "Posicao(P/T).: (P)endentes ou (T)odos"
@ 08,13 SAY "Cliente......:"
@ 09,13 SAY "Contrato.....:"
@ 10,13 SAY "Data Emissao.:"
@ 11,13 SAY "Valor........:"
@ 11,40 SAY "Vencimento...:"
@ 12,13 SAY "Valor Juros..:"
@ 12,40 SAY "Dias Atraso..:"
@ 13,13 SAY "Valor Desc...:"
@ 14,13 SAY "Valor Pago...:"
@ 14,40 SAY "Data Baixa...:"
@ 16,13 SAY "Tipo Pagto...: [D-Dinheiro/Cheque, B-Banco, A-Acerto]"
@ 06,28 GET WTIPO PICT "@!" VALID WTIPO $ "PT"
READ
IF LASTKEY() = 27
EXIT
CLS
ENDIF
SELE CLIENTE
SET ORDER TO 1
@ 08,28 GET WCOD_CLI VALID (WCOD_CLI>0) PICT "999999"
READ
WCODIGO := WCOD_CLI
MENSAGEM(" ")
SEEK WCODIGO
IF FOUND()
WNOME := NOME_CLI
WDADOS1_CLI := DADOS1_CLI
WDADOS2_CLI := DADOS2_CLI
WDADOS3_CLI := DADOS3_CLI
@ 08,28 SAY WNOME PICT "@!"
ELSE
MENSAGEM("Cliente nao Cadastrado",2)
LOOP
ENDIF
IF LASTKEY() = 27
EXIT
CLS
ENDIF
POSFIN()
DO WHILE .T.
MENSAGEM("Tecle <ESC> para retornar")
WCONTADOR := WCONTADOR + 1
WCOD_CAR := 0
WCOD_CON := 0
WTP_PG_CON := 0
WVL_PAR := 0
WNUM_PAR := 0
WDTVEN_PAR := DATAATU
WVL_PAR_PG := 0
WDT_PAR_PG := DATAATU
WCOD_VEN := 0
WENTRADA := 0
WVALOR_CON := 0
WRESTO := 0
WCAIXA := 0
WJUROS := 0
WDESCONTO := 0
WNUM_PAR := 0
WTIPOB := "D"
JANELA(04,10,20,69," BAIXA PARCELAS - CARNES ")
COR("MENU")
@ 06,13 SAY "Posicao(P/T).: (P)endentes ou (T)odos"
@ 08,13 SAY "Cliente......:"
@ 09,13 SAY "Contrato.....: "
@ 10,13 SAY "Data Emissao.: "
@ 11,13 SAY "Valor........: "
@ 11,40 SAY "Vencimento...: "
@ 12,13 SAY "Valor Juros..: "
@ 12,40 SAY "Dias Atraso..: "
@ 13,13 SAY "Valor Desc...: "
@ 14,13 SAY "Valor Pago...: "
@ 14,40 SAY "Data Baixa...: "
@ 16,13 SAY "Tipo Pagto...: [D-Dinheiro/Cheque, B-Banco, A-Acerto]"
IF WCONTA = "R"
@ 06,28 SAY WTIPO PICT "@!"
@ 08,28 SAY WCOD_CLI PICT "999999"
@ 08,28 SAY WNOME PICT "@!"
SELE CARNE
SET ORDER TO 1
IF WTIPO = "T"
SET FILTER TO WCODIGO = COD_CLI
ELSE
SET FILTER TO WCODIGO = COD_CLI .AND. VL_PAR_PG = 0
ENDIF
@ 09,28 GET WCOD_CAR VALID (WCOD_CAR>0) PICT "999999"
READ
WCOD_CON := WCOD_CAR
WNUM_PAR := NUM_PAR
IF LASTKEY() = 27
EXIT
CLS
ENDIF
SELE CARNE
SET FILTER TO WCODIGO = COD_CLI
SET ORDER TO 6
SEEK WCOD_CON + WNUM_PAR
IF FOUND()
WVL_PAR := VL_PAR
WDTVEN_PAR := DTVEN_PAR
WVL_PAR_PG := VL_PAR_PG
WDT_PAR_PG := DT_PAR_PG
SELE CONTRATO
SET ORDER TO 1
SET FILTER TO WCODIGO = COD_CLI
SEEK WCOD_CON
IF FOUND()
WDTEM_CON := DTEM_CON
WCOD_VEN := COD_VEN
WTP_PG_CON := TP_PG_CON
WVL_LIQ_CON := VL_LIQ_CON
SELE CARNE
ENDIF
SELE CARNE
SET ORDER TO 2
SET FILTER TO WCOD_CON = COD_CON
WNUM_PARX := 1
SEEK WNUM_PAR
IF FOUND()
WVL_PAR := VL_PAR
WQTDE_PAR := 0
WQTDE_PAR := (WVL_LIQ_CON / WVL_PAR)
ENDIF
ELSE
BEEP()
MENSAGEM("Cupom nÆo Existe",2)
LOOP
ENDIF
@ 10,28 SAY WDTEM_CON PICT "@D"
@ 11,28 SAY WVL_PAR PICT "@E 99,999.99"
@ 11,54 SAY WDTVEN_PAR PICT "@D"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
@ 14,54 SAY WDT_PAR_PG PICT "@D"
IF WVL_PAR_PG <> 0
WCONF := "N"
BEEP()
MENSAGEM("Parcela j Baixada",2)
MENSAGEM("Deseja Estorna-la ? (S/N):")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
WCONF = "N"
ENDIF
IF WCONF = "S"
WVALOR_CON := WVL_PAR_PG
WVL_PAR := WVL_PAR
WVL_PAR_PG := 0
WDT_PAR_PG := CTOD(" / / ")
SELE CARNE
SET ORDER TO 6
SET FILTER TO WCODIGO = COD_CLI
SEEK WCOD_CON + WNUM_PAR
IF FOUND()
IF RLOCK()
REPLACE VL_PAR WITH WVL_PAR
REPLACE VL_PAR_PG WITH WVL_PAR_PG
REPLACE DT_PAR_PG WITH WDT_PAR_PG
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
TONE(100)
TONE(100)
TONE(100)
ELSE
MENSAGEM("Cupom nÆo existe",2)
LOOP
ENDIF
SELE CAIXA
SET ORDER TO 3
SEEK WCOD_CON + WCODIGO
IF FOUND()
IF RLOCK()
DELETE
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
ENDIF
SELE CARNE
LOOP
ELSE
LOOP
CLS
ENDIF
ENDIF
IF WDTVEN_PAR < DATAATU
WDIAS := 0
WTAXA := 0
WJUROS := 0
WDESCONTO := 0
WDIAS := DATAATU - WDTVEN_PAR
WTAXA := (3/30) * WDIAS
WJUROS := (WVL_PAR * WTAXA)/100
WVL_PAR_PG := WVL_PAR + WJUROS
WDT_PAR_PG := DATAATU
@ 12,54 SAY WDIAS PICT "@E 9999"
@ 12,28 GET WJUROS PICT "@E 99,999.99"
@ 13,28 GET WDESCONTO PICT "@E 99,999.99"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
IF WJUROS <> 0 .OR. WDESCONTO <> 0
WVL_PAR_PG := (WVL_PAR + WJUROS) - WDESCONTO
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF
ELSE
WDIAS := 0
WTAXA := 0
WJUROS := 0
WDESCONTO := 0
WDT_PAR_PG := DATAATU
WTAXA := 10
WDESCONTO := 0
WJUROS := 0
IF WQTDE_PAR < 4
WDESCONTO := (WVL_PAR * WTAXA)/100
WVL_PAR_PG := WVL_PAR - WDESCONTO
WDT_PAR_PG := DATAATU
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF
@ 12,54 SAY WDIAS PICT "@E 9999"
@ 12,28 GET WJUROS PICT "@E 99,999.99"
@ 13,28 GET WDESCONTO PICT "@E 99,999.99"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
IF WJUROS <> 0 .OR. WDESCONTO <> 0
WVL_PAR_PG := (WVL_PAR + WJUROS) - WDESCONTO
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF
ENDIF
@ 14,28 GET WVL_PAR_PG VALID (WVL_PAR_PG>0) PICT "@E 99,999.99"
@ 14,54 GET WDT_PAR_PG PICT "@D"
@ 16,28 GET WTIPOB PICT "@!" VALID WTIPOB $ "DCA"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
WCONF := "S"
MENSAGEM("Confirma (S/N):")
@ 24,48 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
WCONF = "N"
ENDIF
IF WCONF = "S"
WCONF := "S"
MENSAGEM("Confirma Baixa....:")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
IF WCONF = "S"
SELE CARNE
SET ORDER TO 1
SET FILTER TO WCOD_CON = COD_CON
SEEK WNUM_PAR
IF FOUND()
IF RLOCK()
REPLACE VL_PAR WITH WVL_PAR
REPLACE VL_PAR_PG WITH WVL_PAR_PG
REPLACE DT_PAR_PG WITH WDT_PAR_PG
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
TONE(100)
TONE(100)
TONE(100)
ELSE
MENSAGEM("Cupom nÆo existe",2)
LOOP
ENDIF
SELE CAIXA
SET ORDER TO 4
APPEND BLANK
REPLACE COD_CON WITH WCOD_CON
REPLACE DTEM_CON WITH WDT_PAR_PG
REPLACE COD_CLI WITH WCOD_CLI
REPLACE COD_VEN WITH WCOD_VEN
REPLACE TP_PG_CON WITH WTP_PG_CON
REPLACE VALOR_CON WITH WVL_PAR_PG
IF WVL_PAR_PG < WVL_PAR
IF (WVL_PAR - WDESCONTO) <> WVL_PAR_PG
WRESTO := (WVL_PAR - WDESCONTO) - WVL_PAR_PG
EXTRA()
ENDIF
ENDIF
WCONF = " "
MENSAGEM("Autentica Via Pagto(S/N):")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
WCONF = "N"
ENDIF
IF WCONF = "S"
AUTENTICA()
ELSE
RECIBO()
IF WTIPO = "B"
VALE()
ENDIF
IF WTIPO = "A"
VALE1()
ENDIF
ENDIF
LOOP
ENDIF
ENDIF
ENDIF
ENDDO
ENDDO
PROCEDURE RECIBO()
WOPCAO = "I"
WCONF = "S"
WPOSCARNE := 0
WRECIBO = SPACE(2)
IF WCONF = "S"
SET ORDER TO 1
SET SOFTSEEK ON
SEEK WCOD_CON
SET SOFTSEEK OFF
LIN := PRow()
MARCA = 61
LIN := PRow()
MARCA = 61
IF WOPCAO = "I"
IMPRESSORA()
ELSE
SET DEVICE TO PRINTER
SET PRINTER TO RECPG.TXT
ENDIF
// 1 2 3 4 5 6
// 0123456789012345678901234567890123456789012345678901234567890
@ LIN,02 SAY "<<<<< SISCREDI - SISTEMA DE CREDIARIO >>>>>"
LIN = LIN+1
@ LIN,01 SAY "==============================================="
LIN = LIN+1
@ LIN,01 SAY "|==== J A N Y ' S M O D A S =====|"
LIN = LIN+1
@ LIN,01 SAY "|= AV. PR, 944 - (44) 448-1011 - MARILENA-PR =|"
LIN = LIN+1
@ LIN,01 SAY "|= =|"
LIN = LIN+1
@ LIN,01 SAY "|=== R E C I B O D E P A G A M E N T O ===|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,03 SAY DATAATU
@ LIN,15 SAY "Recibo:"
@ LIN,23 SAY WCOD_CON
@ LIN,29 SAY "/"
WRECIBO := LTRIM(STR(WNUM_PAR))
@ LIN,30 SAY WRECIBO
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"
SELE CLIENTE
SET ORDER TO 1
SEEK WCOD_CLI
IF FOUND()
WNOME_CLI := CLIENTE-> NOME_CLI
WEND_CLI := CLIENTE-> END_CLI
WCID_CLI := CLIENTE-> CID_CLI
WUF_CLI := CLIENTE-> UF_CLI
WBAIRRO_CLI := CLIENTE-> BAIRRO_CLI
WCPF_CLI := CLIENTE-> CPF_CLI
WRG_CLI := CLIENTE-> RG_CLI
WFONE_CLI := CLIENTE-> FONE_CLI
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY WCOD_CLI
@ LIN,09 SAY LEFT(WNOME_CLI,38) PICT "@!"
@ LIN,47 SAY "|"
LIN := LIN+1
@ LIN,01 SAY "|"
@ LIN,09 SAY WCPF_CLI PICT "999.999.999-99"
@ LIN,26 SAY WRG_CLI PICT "@!"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|---------------------------------------------|"
ENDIF
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Numero do Contrato....:"
@ LIN,36 SAY WCOD_CON
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Numero da Parcela.....:"
@ LIN,36 SAY WNUM_PAR
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Data Vencimento.......:"
@ LIN,36 SAY WDTVEN_PAR
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Data Pagamento........:"
@ LIN,36 SAY WDT_PAR_PG
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Parcela.........:"
@ LIN,37 SAY WVL_PAR PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Juros...........:"
@ LIN,37 SAY WJUROS PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Desconto........:"
@ LIN,37 SAY WDESCONTO PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Pago............:"
@ LIN,37 SAY WVL_PAR_PG PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"
POSFINREC()
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "SALDO DEVEDOR--------->"
@ LIN,37 SAY WPOSCARNE PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"
LIN = LIN+1
WCOD_MEN := 1
SELE MENSA
SET ORDER TO 1
SEEK WCOD_MEN
IF FOUND()
WDESC1_MEN := DESC1_MEN
WDESC2_MEN := DESC2_MEN
ENDIF
@ LIN,03 SAY WDESC1_MEN PICT "@!"
LIN = LIN+1
@ LIN,03 SAY WDESC2_MEN PICT "@!"
LIN = LIN+10
@ LIN,00 SAY " "
SetPrc(0,0)
SET DEVICE TO SCREEN
SET DEVICE TO SCREEN
IF WOPCAO = "T"
SET PRINTER TO
CLEAR
RUN LIST RECPG.TXT
RUN DEL RECPG.TXT
ENDIF
WPOSCARNE := 0
ENDIF
RETURN
PROCEDURE EXTRA()
SELE CARNE
SET ORDER TO 2
WCONTADOR := 0
WDATAP := WDTVEN_PAR
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
WCONTADOR := NUM_PAR
WCOD_UNICO := COD_UNICO
SKIP
ENDDO
WCONTADOR := WCONTADOR+1
IF! FOUND()
APPEND BLANK
ENDIF
REPLACE COD_CON WITH WCOD_CON
REPLACE COD_UNICO WITH WCOD_UNICO
REPLACE COD_CLI WITH WCOD_CLI
REPLACE NUM_PAR WITH WCONTADOR
REPLACE VL_PAR WITH WRESTO
REPLACE DTVEN_PAR WITH WDTVEN_PAR
RETURN
PROCEDURE EXTRA1()
SELE CARNE
SET ORDER TO 2
WULTIMA := 0
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
WULTIMA := NUM_PAR
WCOD_UNICO := COD_UNICO
SKIP
ENDDO
RETURN
PROCEDURE EXTRA2()
SELE CHEQUE
SET ORDER TO 5
WULTIMA := 0
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
IF DT_PG_CH = CTOD(" / / ")
WULTIMA := 1
ENDIF
SKIP
ENDDO
RETURN
PROCEDURE PARCON()
SELE CARNE
SET ORDER TO 2
WTESTE := 0
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
WTESTE := WTESTE + VL_PAR_PG
SKIP
ENDDO
IF WTESTE <> 0
BEEP()
BEEP()
MENSAGEM("Existe Parcelas j baixadas",2)
MENSAGEM("O processo ser encerrado !!",2)
RETURN
END
RETURN
PROCEDURE IMP25()
SET DEVICE TO PRINTER
TECLA = 0
SetPrc(0,0)
DO WHILE (! ISPRINTER()) .AND. TECLA <> 27
SET DEVICE TO SCREEN
MENSAGEM("Verifique impressora - [ESC Retorna] [ENTER Prossegue]")
BEEP()
TECLA = 0
DO WHILE TECLA <> 13 .AND. TECLA <> 27
TECLA = INKEY(0)
ENDDO
SET DEVICE TO PRINTER
ENDDO
IF TECLA = 27
SET DEVICE TO SCREEN
ENDIF
RETURN
Tenho uma rotina simples de baixa de parcelas, acontece que no servidor está funciona normalzinho e bem rapida por sinal, mais o segundo micro quando abre essa mesma rotina simplesmente quando vai selecionar o cupom para baixar a parcela o sistema trava e inclusive trava o outra estação lá no servidor.
Gostaria que alguem desse uma olhadinha nela e me auxilia-se se possivel.
Obrigado
Marcio Ril
* TITULO : SISCREDI - SISTEMA DE CREDIARIO
* DATA : 18/10/2005
* PROGRAMA : BXCARNE.PRG
* COMENTARIO : BAIXA TITULO COM CARNE
SETCOLOR("B/W,W/N+,,,B/W")
WKTELA2 := SAVESCREEN(00,00,24,79)
IF !FILE("INDCLI1.IDX")
SELECT 1
USE CLIENTE ALIAS CLIENTE
INDEX ON COD_CLI TO INDCLI1
INDEX ON NOME_CLI TO INDCLI2
SET INDEX TO INDCLI1, INDCLI2
ELSE
SELECT 1
USE CLIENTE ALIAS CLIENTE
SET INDEX TO INDCLI1, INDCLI2
ENDIF
IF !FILE("INDVE1.IDX")
SELECT 3
USE VENDEDOR ALIAS VENDEDOR
INDEX ON COD_VEN TO INDVE1
INDEX ON NOME_VEN TO INDVE2
SET INDEX TO INDVE1, INDVE2
ELSE
SELECT 3
USE VENDEDOR ALIAS VENDEDOR
SET INDEX TO INDVE1, INDVE2
ENDIF
IF !FILE("INDME1.IDX")
SELECT 13
USE MENSAGEM ALIAS MENSA
INDEX ON COD_MEN TO INDME1
SET INDEX TO INDME1
ELSE
SELECT 13
USE MENSAGEM ALIAS MENSA
SET INDEX TO INDME1
ENDIF
IF !FILE("INDCO1.IDX")
SELECT 4
USE CONTRATO ALIAS CONTRATO
INDEX ON COD_CON TO INDCO1
INDEX ON COD_CON + COD_CLI TO INDCO2
SET INDEX TO INDCO1, INDCO2
ELSE
SELECT 4
USE CONTRATO ALIAS CONTRATO
SET INDEX TO INDCO1, INDCO2
ENDIF
IF !FILE("INDCX1.IDX")
SELECT 5
USE CAIXA ALIAS CAIXA
INDEX ON COD_CON TO INDCX1
INDEX ON COD_CON + VALOR_CON TO INDCX2
INDEX ON COD_CON + COD_CLI TO INDCX3
INDEX ON DTEM_CON TO INDCX4
SET INDEX TO INDCX1, INDCX2, INDCX3, INDCX4
ELSE
SELECT 5
USE CAIXA ALIAS CAIXA
SET INDEX TO INDCX1, INDCX2, INDCX3, INDCX4
ENDIF
IF !FILE("INDCA1.IDX")
SELECT 2
USE CARNE ALIAS CARNE
INDEX ON NUM_PAR TO INDCA1
INDEX ON COD_CON TO INDCA2
INDEX ON COD_CLI TO INDCA3
INDEX ON DTVEN_PAR + NUM_PAR TO INDCA4
INDEX ON COD_CON + COD_CLI TO INDCA5
INDEX ON COD_CON + NUM_PAR TO INDCA6
SET INDEX TO INDCA1, INDCA2, INDCA3, INDCA4, INDCA5, INDCA6
ELSE
SELECT 2
USE CARNE ALIAS CARNE
SET INDEX TO INDCA1, INDCA2, INDCA3, INDCA4, INDCA5, INDCA6
ENDIF
IF !FILE("INDCH1.IDX")
SELECT 6
USE CHEQUE ALIAS CHEQUE
INDEX ON NUM_CH TO INDCH1
INDEX ON COD_CLI TO INDCH2
INDEX ON NUM_CH + COD_CLI TO INDCH3
INDEX ON NUM_CH + COD_CON TO INDCH4
INDEX ON COD_CON TO INDCH5
SET INDEX TO INDCH1, INDCH2, INDCH3, INDCH4, INDCH5
ELSE
SELECT 6
USE CHEQUE ALIAS CHEQUE
SET INDEX TO INDCH1, INDCH2, INDCH3, INDCH4, INDCH5
ENDIF
SET DELETED ON
DO WHILE .T.
MENSAGEM("Tecle <ESC> para retornar")
WHORA_PG := TIME()
WCOD_CLI := 0
WCOD_FOR := 0
WCODIGO := 0
WCOD_CON := 0
WCOD_DOC := 0
WQTDE_PAR := 0
WTP_PG_CON := 3
WNUM_PAR := 0
WVL_PAR := 0
WDTEM_CON := DATAATU
WDTBASE := DATAATU
WDTVEN_PAR := DATAATU
WVL_PAR_PG := 0
WDT_PAR_PG := DATAATU
WCOD_VEN := 0
WENTRADA := 0
WVALOR_CON := 0
WRESTO := 0
WCAIXA := 0
WTIPOB := "D"
WTIPO := "P"
WCONTA := "R"
WCONTADOR := 0
JANELA(04,10,20,69," BAIXA PARCELAS - CARNES ")
COR("MENU")
@ 06,13 SAY "Posicao(P/T).: (P)endentes ou (T)odos"
@ 08,13 SAY "Cliente......:"
@ 09,13 SAY "Contrato.....:"
@ 10,13 SAY "Data Emissao.:"
@ 11,13 SAY "Valor........:"
@ 11,40 SAY "Vencimento...:"
@ 12,13 SAY "Valor Juros..:"
@ 12,40 SAY "Dias Atraso..:"
@ 13,13 SAY "Valor Desc...:"
@ 14,13 SAY "Valor Pago...:"
@ 14,40 SAY "Data Baixa...:"
@ 16,13 SAY "Tipo Pagto...: [D-Dinheiro/Cheque, B-Banco, A-Acerto]"
@ 06,28 GET WTIPO PICT "@!" VALID WTIPO $ "PT"
READ
IF LASTKEY() = 27
EXIT
CLS
ENDIF
SELE CLIENTE
SET ORDER TO 1
@ 08,28 GET WCOD_CLI VALID (WCOD_CLI>0) PICT "999999"
READ
WCODIGO := WCOD_CLI
MENSAGEM(" ")
SEEK WCODIGO
IF FOUND()
WNOME := NOME_CLI
WDADOS1_CLI := DADOS1_CLI
WDADOS2_CLI := DADOS2_CLI
WDADOS3_CLI := DADOS3_CLI
@ 08,28 SAY WNOME PICT "@!"
ELSE
MENSAGEM("Cliente nao Cadastrado",2)
LOOP
ENDIF
IF LASTKEY() = 27
EXIT
CLS
ENDIF
POSFIN()
DO WHILE .T.
MENSAGEM("Tecle <ESC> para retornar")
WCONTADOR := WCONTADOR + 1
WCOD_CAR := 0
WCOD_CON := 0
WTP_PG_CON := 0
WVL_PAR := 0
WNUM_PAR := 0
WDTVEN_PAR := DATAATU
WVL_PAR_PG := 0
WDT_PAR_PG := DATAATU
WCOD_VEN := 0
WENTRADA := 0
WVALOR_CON := 0
WRESTO := 0
WCAIXA := 0
WJUROS := 0
WDESCONTO := 0
WNUM_PAR := 0
WTIPOB := "D"
JANELA(04,10,20,69," BAIXA PARCELAS - CARNES ")
COR("MENU")
@ 06,13 SAY "Posicao(P/T).: (P)endentes ou (T)odos"
@ 08,13 SAY "Cliente......:"
@ 09,13 SAY "Contrato.....: "
@ 10,13 SAY "Data Emissao.: "
@ 11,13 SAY "Valor........: "
@ 11,40 SAY "Vencimento...: "
@ 12,13 SAY "Valor Juros..: "
@ 12,40 SAY "Dias Atraso..: "
@ 13,13 SAY "Valor Desc...: "
@ 14,13 SAY "Valor Pago...: "
@ 14,40 SAY "Data Baixa...: "
@ 16,13 SAY "Tipo Pagto...: [D-Dinheiro/Cheque, B-Banco, A-Acerto]"
IF WCONTA = "R"
@ 06,28 SAY WTIPO PICT "@!"
@ 08,28 SAY WCOD_CLI PICT "999999"
@ 08,28 SAY WNOME PICT "@!"
SELE CARNE
SET ORDER TO 1
IF WTIPO = "T"
SET FILTER TO WCODIGO = COD_CLI
ELSE
SET FILTER TO WCODIGO = COD_CLI .AND. VL_PAR_PG = 0
ENDIF
@ 09,28 GET WCOD_CAR VALID (WCOD_CAR>0) PICT "999999"
READ
WCOD_CON := WCOD_CAR
WNUM_PAR := NUM_PAR
IF LASTKEY() = 27
EXIT
CLS
ENDIF
SELE CARNE
SET FILTER TO WCODIGO = COD_CLI
SET ORDER TO 6
SEEK WCOD_CON + WNUM_PAR
IF FOUND()
WVL_PAR := VL_PAR
WDTVEN_PAR := DTVEN_PAR
WVL_PAR_PG := VL_PAR_PG
WDT_PAR_PG := DT_PAR_PG
SELE CONTRATO
SET ORDER TO 1
SET FILTER TO WCODIGO = COD_CLI
SEEK WCOD_CON
IF FOUND()
WDTEM_CON := DTEM_CON
WCOD_VEN := COD_VEN
WTP_PG_CON := TP_PG_CON
WVL_LIQ_CON := VL_LIQ_CON
SELE CARNE
ENDIF
SELE CARNE
SET ORDER TO 2
SET FILTER TO WCOD_CON = COD_CON
WNUM_PARX := 1
SEEK WNUM_PAR
IF FOUND()
WVL_PAR := VL_PAR
WQTDE_PAR := 0
WQTDE_PAR := (WVL_LIQ_CON / WVL_PAR)
ENDIF
ELSE
BEEP()
MENSAGEM("Cupom nÆo Existe",2)
LOOP
ENDIF
@ 10,28 SAY WDTEM_CON PICT "@D"
@ 11,28 SAY WVL_PAR PICT "@E 99,999.99"
@ 11,54 SAY WDTVEN_PAR PICT "@D"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
@ 14,54 SAY WDT_PAR_PG PICT "@D"
IF WVL_PAR_PG <> 0
WCONF := "N"
BEEP()
MENSAGEM("Parcela j Baixada",2)
MENSAGEM("Deseja Estorna-la ? (S/N):")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
WCONF = "N"
ENDIF
IF WCONF = "S"
WVALOR_CON := WVL_PAR_PG
WVL_PAR := WVL_PAR
WVL_PAR_PG := 0
WDT_PAR_PG := CTOD(" / / ")
SELE CARNE
SET ORDER TO 6
SET FILTER TO WCODIGO = COD_CLI
SEEK WCOD_CON + WNUM_PAR
IF FOUND()
IF RLOCK()
REPLACE VL_PAR WITH WVL_PAR
REPLACE VL_PAR_PG WITH WVL_PAR_PG
REPLACE DT_PAR_PG WITH WDT_PAR_PG
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
TONE(100)
TONE(100)
TONE(100)
ELSE
MENSAGEM("Cupom nÆo existe",2)
LOOP
ENDIF
SELE CAIXA
SET ORDER TO 3
SEEK WCOD_CON + WCODIGO
IF FOUND()
IF RLOCK()
DELETE
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
ENDIF
SELE CARNE
LOOP
ELSE
LOOP
CLS
ENDIF
ENDIF
IF WDTVEN_PAR < DATAATU
WDIAS := 0
WTAXA := 0
WJUROS := 0
WDESCONTO := 0
WDIAS := DATAATU - WDTVEN_PAR
WTAXA := (3/30) * WDIAS
WJUROS := (WVL_PAR * WTAXA)/100
WVL_PAR_PG := WVL_PAR + WJUROS
WDT_PAR_PG := DATAATU
@ 12,54 SAY WDIAS PICT "@E 9999"
@ 12,28 GET WJUROS PICT "@E 99,999.99"
@ 13,28 GET WDESCONTO PICT "@E 99,999.99"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
IF WJUROS <> 0 .OR. WDESCONTO <> 0
WVL_PAR_PG := (WVL_PAR + WJUROS) - WDESCONTO
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF
ELSE
WDIAS := 0
WTAXA := 0
WJUROS := 0
WDESCONTO := 0
WDT_PAR_PG := DATAATU
WTAXA := 10
WDESCONTO := 0
WJUROS := 0
IF WQTDE_PAR < 4
WDESCONTO := (WVL_PAR * WTAXA)/100
WVL_PAR_PG := WVL_PAR - WDESCONTO
WDT_PAR_PG := DATAATU
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF
@ 12,54 SAY WDIAS PICT "@E 9999"
@ 12,28 GET WJUROS PICT "@E 99,999.99"
@ 13,28 GET WDESCONTO PICT "@E 99,999.99"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
IF WJUROS <> 0 .OR. WDESCONTO <> 0
WVL_PAR_PG := (WVL_PAR + WJUROS) - WDESCONTO
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF
ENDIF
@ 14,28 GET WVL_PAR_PG VALID (WVL_PAR_PG>0) PICT "@E 99,999.99"
@ 14,54 GET WDT_PAR_PG PICT "@D"
@ 16,28 GET WTIPOB PICT "@!" VALID WTIPOB $ "DCA"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
WCONF := "S"
MENSAGEM("Confirma (S/N):")
@ 24,48 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
WCONF = "N"
ENDIF
IF WCONF = "S"
WCONF := "S"
MENSAGEM("Confirma Baixa....:")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
LOOP
CLS
ENDIF
IF WCONF = "S"
SELE CARNE
SET ORDER TO 1
SET FILTER TO WCOD_CON = COD_CON
SEEK WNUM_PAR
IF FOUND()
IF RLOCK()
REPLACE VL_PAR WITH WVL_PAR
REPLACE VL_PAR_PG WITH WVL_PAR_PG
REPLACE DT_PAR_PG WITH WDT_PAR_PG
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
TONE(100)
TONE(100)
TONE(100)
ELSE
MENSAGEM("Cupom nÆo existe",2)
LOOP
ENDIF
SELE CAIXA
SET ORDER TO 4
APPEND BLANK
REPLACE COD_CON WITH WCOD_CON
REPLACE DTEM_CON WITH WDT_PAR_PG
REPLACE COD_CLI WITH WCOD_CLI
REPLACE COD_VEN WITH WCOD_VEN
REPLACE TP_PG_CON WITH WTP_PG_CON
REPLACE VALOR_CON WITH WVL_PAR_PG
IF WVL_PAR_PG < WVL_PAR
IF (WVL_PAR - WDESCONTO) <> WVL_PAR_PG
WRESTO := (WVL_PAR - WDESCONTO) - WVL_PAR_PG
EXTRA()
ENDIF
ENDIF
WCONF = " "
MENSAGEM("Autentica Via Pagto(S/N):")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ
IF LASTKEY() = 27
WCONF = "N"
ENDIF
IF WCONF = "S"
AUTENTICA()
ELSE
RECIBO()
IF WTIPO = "B"
VALE()
ENDIF
IF WTIPO = "A"
VALE1()
ENDIF
ENDIF
LOOP
ENDIF
ENDIF
ENDIF
ENDDO
ENDDO
PROCEDURE RECIBO()
WOPCAO = "I"
WCONF = "S"
WPOSCARNE := 0
WRECIBO = SPACE(2)
IF WCONF = "S"
SET ORDER TO 1
SET SOFTSEEK ON
SEEK WCOD_CON
SET SOFTSEEK OFF
LIN := PRow()
MARCA = 61
LIN := PRow()
MARCA = 61
IF WOPCAO = "I"
IMPRESSORA()
ELSE
SET DEVICE TO PRINTER
SET PRINTER TO RECPG.TXT
ENDIF
// 1 2 3 4 5 6
// 0123456789012345678901234567890123456789012345678901234567890
@ LIN,02 SAY "<<<<< SISCREDI - SISTEMA DE CREDIARIO >>>>>"
LIN = LIN+1
@ LIN,01 SAY "==============================================="
LIN = LIN+1
@ LIN,01 SAY "|==== J A N Y ' S M O D A S =====|"
LIN = LIN+1
@ LIN,01 SAY "|= AV. PR, 944 - (44) 448-1011 - MARILENA-PR =|"
LIN = LIN+1
@ LIN,01 SAY "|= =|"
LIN = LIN+1
@ LIN,01 SAY "|=== R E C I B O D E P A G A M E N T O ===|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,03 SAY DATAATU
@ LIN,15 SAY "Recibo:"
@ LIN,23 SAY WCOD_CON
@ LIN,29 SAY "/"
WRECIBO := LTRIM(STR(WNUM_PAR))
@ LIN,30 SAY WRECIBO
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"
SELE CLIENTE
SET ORDER TO 1
SEEK WCOD_CLI
IF FOUND()
WNOME_CLI := CLIENTE-> NOME_CLI
WEND_CLI := CLIENTE-> END_CLI
WCID_CLI := CLIENTE-> CID_CLI
WUF_CLI := CLIENTE-> UF_CLI
WBAIRRO_CLI := CLIENTE-> BAIRRO_CLI
WCPF_CLI := CLIENTE-> CPF_CLI
WRG_CLI := CLIENTE-> RG_CLI
WFONE_CLI := CLIENTE-> FONE_CLI
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY WCOD_CLI
@ LIN,09 SAY LEFT(WNOME_CLI,38) PICT "@!"
@ LIN,47 SAY "|"
LIN := LIN+1
@ LIN,01 SAY "|"
@ LIN,09 SAY WCPF_CLI PICT "999.999.999-99"
@ LIN,26 SAY WRG_CLI PICT "@!"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|---------------------------------------------|"
ENDIF
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Numero do Contrato....:"
@ LIN,36 SAY WCOD_CON
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Numero da Parcela.....:"
@ LIN,36 SAY WNUM_PAR
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Data Vencimento.......:"
@ LIN,36 SAY WDTVEN_PAR
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Data Pagamento........:"
@ LIN,36 SAY WDT_PAR_PG
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Parcela.........:"
@ LIN,37 SAY WVL_PAR PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Juros...........:"
@ LIN,37 SAY WJUROS PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Desconto........:"
@ LIN,37 SAY WDESCONTO PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Pago............:"
@ LIN,37 SAY WVL_PAR_PG PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"
POSFINREC()
LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "SALDO DEVEDOR--------->"
@ LIN,37 SAY WPOSCARNE PICT "@E 99,999.99"
@ LIN,47 SAY "|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"
LIN = LIN+1
WCOD_MEN := 1
SELE MENSA
SET ORDER TO 1
SEEK WCOD_MEN
IF FOUND()
WDESC1_MEN := DESC1_MEN
WDESC2_MEN := DESC2_MEN
ENDIF
@ LIN,03 SAY WDESC1_MEN PICT "@!"
LIN = LIN+1
@ LIN,03 SAY WDESC2_MEN PICT "@!"
LIN = LIN+10
@ LIN,00 SAY " "
SetPrc(0,0)
SET DEVICE TO SCREEN
SET DEVICE TO SCREEN
IF WOPCAO = "T"
SET PRINTER TO
CLEAR
RUN LIST RECPG.TXT
RUN DEL RECPG.TXT
ENDIF
WPOSCARNE := 0
ENDIF
RETURN
PROCEDURE EXTRA()
SELE CARNE
SET ORDER TO 2
WCONTADOR := 0
WDATAP := WDTVEN_PAR
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
WCONTADOR := NUM_PAR
WCOD_UNICO := COD_UNICO
SKIP
ENDDO
WCONTADOR := WCONTADOR+1
IF! FOUND()
APPEND BLANK
ENDIF
REPLACE COD_CON WITH WCOD_CON
REPLACE COD_UNICO WITH WCOD_UNICO
REPLACE COD_CLI WITH WCOD_CLI
REPLACE NUM_PAR WITH WCONTADOR
REPLACE VL_PAR WITH WRESTO
REPLACE DTVEN_PAR WITH WDTVEN_PAR
RETURN
PROCEDURE EXTRA1()
SELE CARNE
SET ORDER TO 2
WULTIMA := 0
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
WULTIMA := NUM_PAR
WCOD_UNICO := COD_UNICO
SKIP
ENDDO
RETURN
PROCEDURE EXTRA2()
SELE CHEQUE
SET ORDER TO 5
WULTIMA := 0
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
IF DT_PG_CH = CTOD(" / / ")
WULTIMA := 1
ENDIF
SKIP
ENDDO
RETURN
PROCEDURE PARCON()
SELE CARNE
SET ORDER TO 2
WTESTE := 0
SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()
WTESTE := WTESTE + VL_PAR_PG
SKIP
ENDDO
IF WTESTE <> 0
BEEP()
BEEP()
MENSAGEM("Existe Parcelas j baixadas",2)
MENSAGEM("O processo ser encerrado !!",2)
RETURN
END
RETURN
PROCEDURE IMP25()
SET DEVICE TO PRINTER
TECLA = 0
SetPrc(0,0)
DO WHILE (! ISPRINTER()) .AND. TECLA <> 27
SET DEVICE TO SCREEN
MENSAGEM("Verifique impressora - [ESC Retorna] [ENTER Prossegue]")
BEEP()
TECLA = 0
DO WHILE TECLA <> 13 .AND. TECLA <> 27
TECLA = INKEY(0)
ENDDO
SET DEVICE TO PRINTER
ENDDO
IF TECLA = 27
SET DEVICE TO SCREEN
ENDIF
RETURN