Documente online.
Username / Parola inexistente
  Zona de administrare documente. Fisierele tale  
Am uitat parola x Creaza cont nou
  Home Exploreaza
Upload






























APLICATII DIVERSE IN FOXPRO

foxpro


APLICATII DIVERSE IN FOXPRO

1)GESTIUNEA MATERIALELOR INTR-O INTREPRINDERE(GESTOC)

* PROGRAM MENIU.PRG *

CLEAR

SET SYSMENU TO



SET SYSMENU AUTOMATIC

DEFINE PAD _rv20yk3ts OF _MSYSMENU PROMPT "\<Actualizare" COLOR SCHEME 3 ;

KEY ALT+A, "ALT+A"

DEFINE PAD _rv20yk3v1 OF _MSYSMENU PROMPT "\<Liste" COLOR SCHEME 3 ;

KEY ALT+L, "ALT+L"

DEFINE PAD _rv20yk3vb OF _MSYSMENU PROMPT "\<Iesire" COLOR SCHEME 3 ;

KEY ALT+I, "ALT+I"

ON PAD _rv20yk3ts OF _MSYSMENU ACTIVATE POPUP actualizar

ON PAD _rv20yk3v1 OF _MSYSMENU ACTIVATE POPUP liste

ON PAD _rv20yk3vb OF _MSYSMENU ACTIVATE POPUP iesire

DEFINE POPUP actualizar MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF actualizar PROMPT "\<Cautare" ;

KEY CTRL+C, "CTRL+C"

DEFINE BAR 2 OF actualizar PROMPT "I\<esire" ;

KEY CTRL+E, "CTRL+E"

DEFINE BAR 3 OF actualizar PROMPT "I\<ntrare" ;

KEY CTRL + N, "CTRL + N"

DEFINE BAR 4 OF actualizar PROMPT "\<Stergere" ;

KEY CTRL + S, "CTRL + S"

ON SELECTION BAR 1 OF actualizar DO cauta

ON SELECTION BAR 2 OF actualizar DO iesi

ON SELECTION BAR 3 OF actualizar DO intr

ON SELECTION BAR 4 OF actualizar DO sterg

DEFINE POPUP liste MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF liste PROMPT "Depo\<zit" ;

KEY CTRL+Z, "CTRL+Z"

ON SELECTION BAR 1 OF liste DO depoz

DEFINE POPUP iesire MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF iesire PRO 444j93e MPT "\<Dos" ;

KEY CTRL+D, "CTRL+D"

DEFINE BAR 2 OF iesire PROMPT "\<FoxPro" ;

KEY CTRL+F, "CTRL+F"

ON SELECTION BAR 1 OF iesire QUIT

ON SELECTION BAR 2 OF iesire SET SYSMENU TO DEFAULT

* PROGRAM INTR.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE STOCURI

m.codp = SPACE(5)

m.denp = SPACE(20)

m.int = 0

m.stoci = 0

m.stocf = 0

m.pret = 0

@5 ,5 SAY "CODUL PRODUSULUI :" GET m.codp PICTURE "@!"

READ

LOCATE ALL FOR Codp = m.codp

IF FOUND()

m.stoci = Stocf

@5 ,5 SAY "DENUMIREA PRODUSULUI :" + Denp

@6 ,5 SAY "STOC INITIAL :" + STR(m.stoci,7,2)

@7 ,5 SAY "UNITATE DE MASURA :" + Um

@8 ,5 SAY "PRET :" + STR(Pret,9,2)

@9 ,5 SAY "INTRARE :" GET m.int PICTURE "9999.99"

READ

m.stocf = m.stoci + m.int

@10 ,5 SAY "STOC FINAL :" + STR(m.stocf,7,2)

@12,5 SAY "CORECT? [D/N] :" GET m.cond PICTURE "@!" DEFAULT "D"

READ

IF m.cond = "D"

REPLACE Stoci WITH m.stoci

REPLACE Stocf WITH m.stocf

REPLACE Intp WITH m.int

ELSE

WAIT "Inregistrarea nu a fost adaugata!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

ELSE

WAIT "Produs nou!" WINDOW NOWAIT

@6 ,5 SAY "DENUMIREA PRODUSULUI :" GET m.denp PICTURE "@!"

@7 ,5 SAY "UNITATE DE MASURA :" GET m.um PICTURE "@!" DEFAULT SPACE(5)

@8 ,5 SAY "PRET :" GET m.pret PICTURE "999999.99"

@9 ,5 SAY "INTRARE :" GET m.int PICTURE "9999.99"

READ

@11,5 SAY "CORECT? [D/N] :" GET m.cond PICTURE "@!" DEFAULT "D"

READ

IF m.cond = "D"

m.stoci = 0

m.stocf = m.int

APPEND BLANK

REPLACE Codp WITH m.codp

REPLACE Denp WITH m.denp

REPLACE Stoci WITH m.stoci

REPLACE Stocf WITH m.stocf

REPLACE Intp WITH m.int

REPLACE Um WITH m.um

REPLACE Pret WITH m.pret

ELSE

WAIT "Inregistrarea nu a fost adaugata!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

ENDIF

CLEAR

SET SAFETY ON

SET TALK ON

USE

* PROGRAM IESI.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE STOCURI

m.codp = SPACE(5)

m.denp = SPACE(20)

m.ies = 0

m.stoci = 0

m.stocf = 0

@5 ,5 SAY "CODUL PRODUSULUI :" GET m.codp PICTURE "@!"

READ

LOCATE ALL FOR Codp = m.codp

IF FOUND()

m.stoci = Stocf

@5 ,5 SAY "DENUMIREA PRODUSULUI :" + Denp

@6 ,5 SAY "STOC :" + STR(m.stoci,7,2)

@7 ,5 SAY "UNITATE DE MASURA :" + Um

@8 ,5 SAY "IESIRE :" GET m.ies PICTURE "9999.99"

READ

IF m.ies > m.stoci

WAIT "Stoc insuficient!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ELSE

m.stocf = m.stoci - m.ies

@9 ,5 SAY "STOC FINAL :" + STR(m.stocf,7,2)

@11,5 SAY "CORECT? [D/N] :" GET m.cond PICTURE "@!" DEFAULT "D"

READ

IF m.cond = "D"

REPLACE Stoci WITH m.stoci

REPLACE Stocf WITH m.stocf

REPLACE Iesp WITH m.ies

ELSE

WAIT "Inregistrarea nu a fost adaugata!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

ENDIF

ELSE

WAIT "Produsul nu a fost gasit!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

CLEAR

SET SAFETY ON

SET TALK ON

USE

* PROGRAM CAUTA.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE STOCURI

m.codp = SPACE(5)

@4 ,5 SAY "CODUL PRODUSULUI :" GET m.codp PICTURE "@!"

READ

LOCATE ALL FOR Codp = m.codp

IF FOUND()

@5 ,5 SAY "DENUMIREA PRODUSULUI :" + Denp

@6 ,5 SAY "STOC :" + STR(Stocf,7,2)

@7 ,5 SAY "UNITATE DE MASURA :" + Um

@8 ,5 SAY "ULTIMA INTRARE :" + STR(Intp,7,2)

@9 ,5 SAY "ULTIMA IESIRE :" + STR(Iesp,7,2)

@10,5 SAY "PRET :" + STR(Pret,9,2)

WAIT "Apasa orice tasta pentru terminare." WINDOW

ELSE

WAIT "Codul nu a fost gasit!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

CLEAR

SET SAFETY ON

SET TALK ON

USE

* PROGRAM DEPOZ.PRG *

SET TALK OFF

SET SAFETY OFF

CLEAR

USE STOCURI

?

?" Lista produselor din depozit"

?

?"-------- ----- ------ ----- ----- -------"

?"Cod Denumire UM Stoc Pret"

?"-------- ----- ------ ----- ----- -------"

DO WHILE .NOT. EOF()

?Codp, Denp, Um, Stocf, Pret

SKIP

ENDDO

?"-------- ----- ------ ----- ----- -------"

* PROGRAM STERG.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE STOCURI

m.codp = SPACE(5)

m.cond = "D"

@4 ,5 SAY "CODUL PRODUSULUI :" GET m.codp PICTURE "@!"

READ

LOCATE ALL FOR Codp = m.codp

IF FOUND()

@5 ,5 SAY "DENUMIREA PRODUSULUI :" + Denp

@6 ,5 SAY "STOC :" + STR(Stocf,7,2)

@7 ,5 SAY "UNITATE DE MASURA :" + Um

@8 ,5 SAY "PRET :" + STR(Pret,9,2)

@9 ,5 SAY "ULTIMA INTRARE :" + STR(Intp,7,2)

@10,5 SAY "ULTIMA IESIRE :" + STR(Iesp,7,2)

@12,5 SAY "STERG? [D/N] :" GET m.cond PICTURE "@!"

READ

IF m.cond = "D"

DELETE

WAIT "Inregistrarea a fost stearsa."+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ELSE

WAIT "Inregistrarea nu a fost stearsa."+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

ELSE

WAIT "Codul nu a fost gasit!"+;

CHR(13)+"Apasa orice tasta pentru terminare." WINDOW

ENDIF

CLEAR

PACK

SET SAFETY ON

SET TALK ON

USE

2)OPERATIUNI BANCARE DE DEPUNERE SI SCOATERE BANI LA DIFERITE BANCI

* BANCA.PRG *

CLEAR

SET SYSMENU TO

SET SYSMENU AUTOMATIC

DEFINE PAD actpad OF _MSYSMENU PROMPT "\<Actualizare" COLOR SCHEME 3 ;

KEY ALT+A, "ALT+A"

DEFINE PAD lispad OF _MSYSMENU PROMPT "\<Liste" COLOR SCHEME 3 ;

KEY ALT+L, "ALT+L"

DEFINE PAD iespad OF _MSYSMENU PROMPT "\<Iesire" COLOR SCHEME 3 ;

KEY ALT+I, "ALT+I"

ON PAD actpad OF _MSYSMENU ACTIVATE POPUP actualizar

ON PAD lispad OF _MSYSMENU ACTIVATE POPUP liste

ON PAD iespad OF _MSYSMENU ACTIVATE POPUP iesire

DEFINE POPUP actualizar MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF actualizar PROMPT "\<Adaugare" ;

KEY CTRL+A, "CTRL+A"

DEFINE BAR 2 OF actualizar PROMPT "\<Cautare" ;

KEY CTRL+C, "CTRL+C"

ON SELECTION BAR 1 OF actualizar DO Adaug

ON SELECTION BAR 2 OF actualizar DO Cauta

DEFINE POPUP liste MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF liste PROMPT "\<Extrase" ;

KEY CTRL+E, "CTRL+E"

DEFINE BAR 2 OF liste PROMPT "\<Total ..." ;

KEY CTRL+T, "CTRL+T"

ON SELECTION BAR 1 OF liste DO Extra

ON SELECTION BAR 2 OF liste DO Total

DEFINE POPUP iesire MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF iesire PRO 444j93e MPT "\<Dos" ;

KEY CTRL+D, "CTRL+D"

DEFINE BAR 2 OF iesire PROMPT "\<FoxPro" ;

KEY CTRL+F, "CTRL+F"

ON SELECTION BAR 1 OF iesire QUIT

ON SELECTION BAR 2 OF iesire SET SYSMENU TO DEFAULT

* ADAUG.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE BANCA

INDEX ON CONT TAG CONT

SET ORDER TO CONT

@5,5 SAY "Introduce contul:" GET m.cont PICTURE "999999999";

DEFAULT 0

READ

SEEK m.cont

IF FOUND()

CLEAR

@ 5,5 SAY "Cont :" + STR(Cont,9)

@ 6,5 SAY "Banca :"+Banca

@ 7,5 SAY "Nume :" + Nume

@ 8,5 SAY "Prenume :" + Prenume

@ 9,5 SAY "Operatiune [D/R]:" GET m.op PICTURE "@!";

DEFAULT " "

READ

IF m.op <> "D" .AND. m.op <> "R"

WAIT WINDOW "Tipul operatiunii este invalid!"+;

CHR(13)+"Apasa o tasta pentru terminare."

CANCEL

ENDIF

@10,5 SAY "Suma :" GET m.suma PICTURE "999999999";

DEFAULT 0

READ

@13,5 SAY "Corect? [D/N]:" GET m.cond PICTURE "@!" DEFAULT "D"

READ

IF m.cond="D"

IF m.op = "D"

m.sold=Sold+m.suma

REPLACE Dep WITH m.suma

REPLACE Sold WITH m.sold

ELSE

IF m.suma < Sold

m.sold = Sold-m.suma

REPLACE Ret WITH m.suma

REPLACE Sold WITH m.sold

ELSE

WAIT WINDOW "Sold insuficient!"

ENDIF

ENDIF

ELSE

WAIT WINDOW "Inregistrarea nu a fost adaugata!" NOWAIT

ENDIF

ELSE

WAIT WINDOW "Inregistrare noua." NOWAIT

@ 6,5 SAY "Operatiune [D] :" GET m.op PICTURE "@!" DEFAULT " "

READ

IF m.op <> "D"

WAIT WINDOW "Tipul operatiunii este invalid!"+;

CHR(13)+"Apasa o tasta pentru terminare."

CANCEL

ENDIF

@ 7,5 SAY "Banca :" GET m.banca PICTURE "@!";

DEFAULT SPACE(15)

@ 8,5 SAY "Nume :" GET m.nume PICTURE "@!";

DEFAULT SPACE(15)

@ 9,5 SAY "Prenume :" GET m.prenume PICTURE "@!";

DEFAULT SPACE(15)

@10,5 SAY "Suma :" GET m.suma PICTURE "999999999";

DEFAULT 0

READ

@12,5 SAY "Corect? [D/N]:" GET m.cond PICTURE "@!" DEFAULT "D"

READ

IF m.cond="D"

APPEND BLANK

REPLACE Nume WITH m.nume

REPLACE Prenume WITH m.prenume

REPLACE Banca WITH m.banca

REPLACE Cont WITH m.cont

REPLACE Dep WITH m.suma

REPLACE Sold WITH m.suma

ELSE

WAIT WINDOW "Inregistrarea nu a fost adaugata." NOWAIT

ENDIF

ENDIF

* CAUTA.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE BANCA

@5,5 SAY "Introduce contul:" GET m.cont PICTURE "999999999";

DEFAULT 0



READ

SET ORDER TO CONT

SEEK m.cont

IF FOUND()

CLEAR

@ 5,5 SAY "Cont :" + STR(Cont,9)

@ 6,5 SAY "Banca :"+Banca

@ 7,5 SAY "Nume :" + Nume

@ 8,5 SAY "Prenume :" + Prenume

@ 9,5 SAY "Sold :" + STR(Sold,9)

ELSE

WAIT WINDOW "Contul nu exista!" NOWAIT

ENDIF

* EXTRAS.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

SET DATE TO DMY

@5,15 SAY "Extrasele se gasesc in fisierul EXTRASE.LST"

SET CONSOLE OFF

SET ALTERNATE TO EXTRASE.LST

SET ALTERNATE ON

USE BANCA

SET ORDER TO CONT

GO TOP

SCAN

?"-------- ----- ------ --------"

?Nume AT 3

??Banca AT 30

?Prenume AT 3

??DATE() AT 30

?"Cont:" AT 3

??Cont AT 8 PICTURE "@B"

?

?"Ultima depunere :" AT 3

??Dep AT 20 PICTURE "@B"

?"Ultima retragere:" AT 3

??Ret AT 20 PICTURE "@B"

?"Sold :" AT 3

??Sold AT 20 PICTURE "@B"

?"-------- ----- ------ --------"

ENDSCAN

CLOSE ALTERNATE

SET ALTERNATE OFF

SET CONSOLE ON

* TOTAL.PRG *

CLEAR

SET TALK OFF

SET SAFETY OFF

USE BANCA

@ 2,5 SAY "Total pentru:"

@ 4,5 SAY "Nume :" GET m.nume PICTURE "@!" DEFAULT SPACE(15)

@ 5,5 SAY "Prenume :" GET m.prenume PICTURE "@!" DEFAULT SPACE(15)

READ

CLEAR

m.total=0

?"Total pentru:"

?

?"Numele :"+m.nume

?"Prenumele:"+m.prenume

?

?"Banca Cont Sold"

?"-------- ----- ------ ------"

SCAN FOR Nume=m.nume .AND. Prenume=m.prenume

?Banca, Cont,' ', Sold

m.total=m.total + Sold

ENDSCAN

?"-------- ----- ------ ------"

?"Total: " + STR(m.total,12)

3)GESTIONAREA INTRARILOR DE BOLNAVI PE DIFERITE SECTII SI IESIREA ACESTORA DIN SPITAL

* PROGRAM MENIU.PRG *

CLEAR

SET SYSMENU TO

SET SYSMENU AUTOMATIC

define pad actpad of _MSYSMENU prompt;

"\<Actualizari" key alt+A

define pad sitpad of _MSYSMENU prompt;

"\<Situatii" key alt + S

define pad exitpad of _MSYSMENU prompt;

"\<Iesire" key alt+I

on pad actpad of _MSYSMENU activate popup actualiz

on pad sitpad of _MSYSMENU activate popup situatii

on pad exitpad of _MSYSMENU activate popup exit

define popup actualiz

define bar 1 of actualiz prompt "\<Adaugare" key ctrl+A;

message "Adaugari inregistrari."

define bar 2 of actualiz prompt "\<Cautare" key ctrl+C;

message "Cautare inregistrari."

define bar 3 of actualiz prompt "\<Stergere" key ctrl + S;

message"Stergere inregistrari."

on selection bar 1 of actualiz do adaug.prg

on selection bar 2 of actualiz do caut.prg

on selection bar 3 of actualiz do sterg.prg

define popup situatii

define bar 1 of situatii prompt "S\<ectii" KEY CTRL+E;

MESSAGE "Situatia pacientilor pe sectii."

define bar 2 of situatii prompt "E\<xternati" KEY CTRL+X;

MESSAGE "Situatia pacientilor care se externeaza pe sectii."

define bar 3 of situatii prompt "\<Baza de date" KEY CTRL+B;

MESSAGE "Vizualizare baza de date."

on selection bar 1 of situatii do sitsec.prg

on selection bar 2 of situatii do sitext.prg

on selection bar 3 of situatii do vizbdd.prg

define popup exit

define bar 1 of exit prompt "\<FoxPro" KEY CTRL+F;

MESSAGE "Iesire in FoxPro."

define bar 2 of exit prompt "\<MSDOS" KEY CTRL+D;

MESSAGE "Iesire in MSDOS."

on selection bar 1 of exit do IFOX IN MENIU.PRG

on selection bar 2 of exit do IDOS IN MENIU.PRG

PROCEDURE IFOX

SET SYSMENU TO DEFAULT

CLEAR

RETURN

PROCEDURE IDOS

QUIT

RETURN

* PROGRAM ADAUG.PRG *

CLEAR

SET TALK OFF

SET DATE TO DMY

USE Sectie

m.rasp="D"

m.cod_s=0

m.den_s=SPACE(20)

m.nume_p=SPACE(15)

m.pren_p=SPACE(15)

m.virsta_p=0

m.adresa=SPACE(25)

m.ocupatie=SPACE(10)

m.data_n=

m.localit_n=SPACE(10)

m.act_iden=SPACE(10)

m.diagn_int=SPACE(30)

m.data_int=DATE()

@3,20 SAY "Adaugare inregistrari"

@ 5,5 SAY "Introduceti sectia :" GET m.cod_s PICTURE "999"

@ 6,5 SAY "Introduceti denumirea sectiei :" GET m.den_s PICTURE "@!"

@ 7,5 SAY "Introduceti numele pacientului :" GET m.nume_p PICTURE "@!"

@ 8,5 SAY "Introduceti prenumele pacientului :" GET m.pren_p PICTURE "@!"

@ 9,5 SAY "Introduceti virsta pacientului :" GET m.virsta_p PICTURE "99"

@10,5 SAY "Introduceti adresa pacientului :" GET m.adresa PICTURE "@!"

@11,5 SAY "Introduceti ocupatia pacientului :" GET m.ocupatie PICTURE "@!"

@12,5 SAY "Introduceti data nasterii :" GET m.data_n

@13,5 SAY "Introduceti localitatea nasterii :" GET m.localit_n PICTURE "@!"

@14,5 SAY "Introduceti actul de identitate :" GET m.act_iden PICTURE "@!"

@15,5 SAY "Introduceti diagnosticul pacientului:" GET m.diagn_int PICTURE "@!"

@16,5 SAY "Introduceti data internarii :" GET m.data_int

READ

@18,5 SAY "Datele introduse sunt corecte? [D/N]:" GET m.rasp PICTURE "@!"

READ

IF m.rasp="D"

APPEND BLANK

REPLACE Cod_s WITH m.cod_s

REPLACE Den_s WITH m.den_s

REPLACE Nume_p WITH m.nume_p

REPLACE Pren_p WITH m.pren_p

REPLACE Varsta WITH m.virsta_p

REPLACE Adresa WITH m.adresa

REPLACE Ocupatie WITH m.ocupatie

REPLACE Data_n WITH m.data_n

REPLACE Localit_n WITH m.localit_n

REPLACE Act_iden WITH m.act_iden

REPLACE Diagn_int WITH m.diagn_int

REPLACE Data_int WITH m.data_int

ELSE

WAIT WINDOW "Inregistrarea nu a fost adaugata!" NOWAIT

ENDIF

CLEAR

* PROGRAM CAUT.PRG *

CLEAR

SET TALK OFF

SET DATE TO DMY

USE Sectie

m.nume_p=SPACE(15)

m.pren_p=SPACE(15)

m.act_iden=SPACE(10)

@3,20 SAY "Modificare inregistrari"

@ 5,5 SAY "Introduceti numele pacientului :" GET m.nume_p PICTURE "@!"

@ 6,5 SAY "Introduceti prenumele pacientului :" GET m.pren_p PICTURE "@!"

@ 7,5 SAY "Introduceti actul de identitate :" GET m.act_iden PICTURE "@!"

READ

CLEAR

GO TOP

LOCATE FOR Nume_p = m.nume_p .AND. Pren_p = m.pren_p .AND. Act_iden = m.act_iden

IF FOUND() = .T.

@ 5,5 SAY "Numele :" + Nume_p

@ 6,5 SAY "Prenumele :" + Pren_p

@ 7,5 SAY "Data nasterii :"+DTOC(Data_n)

@ 8,5 SAY "Locul nasterii :"+Localit_n

@ 9,5 SAY "Virsta :" + STR(Varsta,2)

@10,5 SAY "Adresa :"+Adresa

@11,5 SAY "Ocupatia :"+Ocupatie

@12,5 SAY "Act de identitate:"+Act_iden

@13,5 SAY "Sectia :"+Den_s

@14,5 SAY "Data internarii :"+DTOC(Data_int)

@15,5 SAY "Diagnosticul :"+Diagn_int

ELSE

WAIT WINDOW "Inregistrarea nu a fost gasita!"

ENDIF

CLEAR

SET DATE TO DMY

SET TALK OFF

USE SECTIE

?

?"Pacientii care trebuie externati din sectia 101 INTERNE"

?

DO CAPTAB IN SITSEC.PRG

SET FILTER TO Cod_s = 101

m.i = 1

GO TOP

DO WHILE .NOT. EOF()

IF DATE()-Data_int > 10

?"ł" + STR(m.i,3)+"ł" + Nume_p+"ł" + Pren_p+"ł"+Diagn_int+"ł"+DTOC(Data_int)+" ł"

m.i=m.i+1

ENDIF

SKIP

ENDDO

?"Ŕ A A AÁ A A A A AÁ A A A A AÁ A A A A A A A A A AÁ A A A A A A A A AŮ"

?

?"Pacientii care trebuie externati din sectia 102 CHIRURGIE"

?

DO CAPTAB IN SITSEC.PRG

SET FILTER TO Cod_s = 102

m.i = 1

GO TOP

DO WHILE .NOT. EOF()

IF DATE()-Data_int > 10

?"ł" + STR(m.i,3)+"ł" + Nume_p+"ł" + Pren_p+"ł"+Diagn_int+"ł"+DTOC(Data_int)+" ł"

m.i=m.i+1

ENDIF

SKIP

ENDDO

?"Ŕ A A AÁ A A A A AÁ A A A A AÁ A A A A A A A A A AÁ A A A A A A A A AŮ"

SET FILTER TO

PROCEDURE CAPTAB

?"Ú A A AÂ A A A A AÂ A A A A AÂ A A A A A A A A A AÂ A A A A A A A A Aż"

?"łNr.łNume łPrenume łDiagnostic łData int.ł"

?"Ă A A AĹ A A A A AĹ A A A A AĹ A A A A A A A A A AĹ A A A A A A A A A´"

RETURN

* PROGRAM SITSEC.PRG *

CLEAR

SET DATE TO DMY

SET TALK OFF

USE SECTIE

?

?"Pacienti in sectia 101 INTERNE"

?

DO CAPTAB IN SITSEC.PRG

SET FILTER TO Cod_s = 101

m.i = 1

GO TOP

DO WHILE .NOT. EOF()

?"ł" + STR(m.i,3)+"ł" + Nume_p+"ł" + Pren_p+"ł"+Diagn_int+"ł"+DTOC(Data_int)+" ł"

m.i=m.i+1

SKIP

ENDDO

?"Ŕ A A AÁ A A A A AÁ A A A A AÁ A A A A A A A A A AÁ A A A A A A A A AŮ"

?

?"Pacienti in sectia 102 CHIRURGIE"

?

DO CAPTAB IN SITSEC.PRG

SET FILTER TO Cod_s = 102

m.i = 1

GO TOP

DO WHILE .NOT. EOF()

?"ł" + STR(m.i,3)+"ł" + Nume_p+"ł" + Pren_p+"ł"+Diagn_int+"ł"+DTOC(Data_int)+" ł"

m.i=m.i+1

SKIP

ENDDO

?"Ŕ A A AÁ A A A A AÁ A A A A AÁ A A A A A A A A A AÁ A A A A A A A A AŮ"

SET FILTER TO

PROCEDURE CAPTAB

?"Ú A A AÂ A A A A AÂ A A A A AÂ A A A A A A A A A AÂ A A A A A A A A Aż"

?"łNr.łNume łPrenume łDiagnostic łData int.ł"

?"Ă A A AĹ A A A A AĹ A A A A AĹ A A A A A A A A A AĹ A A A A A A A A A´"

RETURN

* PROGRAM STERG.PRG *

CLEAR

SET TALK OFF

SET DATE TO DMY

USE Sectie

m.nume_p=SPACE(15)

m.pren_p=SPACE(15)

m.act_iden=SPACE(10)

@3,20 SAY "Modificare inregistrari"

@ 5,5 SAY "Introduceti numele pacientului :" GET m.nume_p PICTURE "@!"

@ 6,5 SAY "Introduceti prenumele pacientului :" GET m.pren_p PICTURE "@!"

@ 7,5 SAY "Introduceti actul de identitate :" GET m.act_iden PICTURE "@!"

READ

CLEAR

GO TOP

LOCATE FOR Nume_p = m.nume_p .AND. Pren_p = m.pren_p .AND. Act_iden = m.act_iden

IF FOUND() = .T.

@ 5,5 SAY "Numele :" + Nume_p

@ 6,5 SAY "Prenumele :" + Pren_p

@ 7,5 SAY "Data nasterii :"+DTOC(Data_n)

@ 8,5 SAY "Locul nasterii :"+Localit_n

@ 9,5 SAY "Virsta :" + STR(Varsta,2)

@10,5 SAY "Adresa :"+Adresa

@11,5 SAY "Ocupatia :"+Ocupatie

@12,5 SAY "Act de identitate:"+Act_iden

@13,5 SAY "Sectia :"+Den_s

@14,5 SAY "Data internarii :"+DTOC(Data_int)

@15,5 SAY "Diagnosticul :"+Diagn_int

ELSE

WAIT WINDOW "Inregistrarea nu a fost gasita!"

ENDIF

IF FOUND()=.T.

@17,5 SAY "Sterg? [D/N]:" GET m.rasp PICTURE "@!" DEFAULT "N"

READ

IF m.rasp = "D"

DELETE

PACK

ELSE

WAIT WINDOW "Inregistrarea nu a fost stearsa!"

ENDIF

ENDIF

* PROGRAM VIZBDD.PRG *

CLEAR

SET TALK OFF

USE SECTIE

DEFINE WINDOW VIZ FROM 5,5 TO 15,75

ACTIVATE WINDOW VIZ

BROWSE IN WINDOW VIZ NOMODIFY NOAPPEND

DEACTIVATE WINDOW VIZ

RELEASE WINDOW VIZ

4)GESTIUNEA PERMISELOR DE CONDUCERE (SUSPENDAT ,RIDICARE ,VALABILITATE)

* PROGRAM MENIU.PRG *

CLEAR

SET SYSMENU TO

SET SYSMENU AUTOMATIC

DEFINE PAD _rv211bzps OF _MSYSMENU PROMPT "\<Actualizare" COLOR SCHEME 3 ;

KEY ALT+A, "ALT+A"

DEFINE PAD _rv211bzpt OF _MSYSMENU PROMPT "\<Liste" COLOR SCHEME 3 ;

KEY ALT+L, "ALT+L"

DEFINE PAD _rv211bzpu OF _MSYSMENU PROMPT "\<Iesire" COLOR SCHEME 3 ;

KEY ALT+I, "ALT+I"

ON PAD _rv211bzps OF _MSYSMENU ACTIVATE POPUP actualizar

ON PAD _rv211bzpt OF _MSYSMENU ACTIVATE POPUP liste

ON PAD _rv211bzpu OF _MSYSMENU ACTIVATE POPUP iesire

DEFINE POPUP actualizar MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF actualizar PROMPT "\<Adaugare" ;

KEY CTRL+A, "CTRL+A"

DEFINE BAR 2 OF actualizar PROMPT "\<Modificare" ;

KEY CTRL + M, "CTRL + M"

ON SELECTION BAR 1 OF actualizar DO ADAUG

ON SELECTION BAR 2 OF actualizar DO MODIF

DEFINE POPUP liste MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF liste PROMPT "\<Raport" ;

KEY CTRL+R, "CTRL+R"

ON SELECTION BAR 1 OF liste DO RAPOR

DEFINE POPUP iesire MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF iesire PRO 444j93e MPT "\<Dos" ;

KEY CTRL+D, "CTRL+D"

DEFINE BAR 2 OF iesire PROMPT "\<Fox Pro" ;

KEY CTRL+F, "CTRL+F"

ON SELECTION BAR 1 OF iesire QUIT

ON SELECTION BAR 2 OF iesire SET SYSMENU TO DEFAULT

* PROGRAM ADAUG.PRG *

#REGION 0

REGIONAL m.currarea, m.talkstat, m.compstat

IF SET("TALK") = "ON"

SET TALK OFF

m.talkstat = "ON"

ELSE

m.talkstat = "OFF"

ENDIF

m.compstat = SET("COMPATIBLE")

SET COMPATIBLE FOXPLUS

m.currarea = SELECT()

IF NOT WEXIST("adaug") ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.PJX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.SCX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.MNX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.PRG" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.FRX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.QPR"

DEFINE WINDOW adaug ;

FROM INT((SROW()-19)/2),INT((SCOL()-57)/2) ;

TO INT((SROW()-19)/2)+18,INT((SCOL()-57)/2)+56 ;

TITLE " Adauga inregistrari " ;

FOOTER " Apasa <ESC> pentru iesire " ;

NOFLOAT ;

CLOSE ;

SHADOW ;

NOMINIMIZE ;

DOUBLE ;

COLOR SCHEME 1

ENDIF

#REGION 1

USE Permise

SET SAFETY OFF

SET DATE TO DMY

INDEX ON NUME TAG NUME ADDITIVE

INDEX ON STR(CNP,13) TAG CNP ADDITIVE

INDEX ON NRPERM TAG NRPERM ADDITIVE

SCATTER MEMVAR BLANK

#REGION 1

IF WVISIBLE("adaug")

ACTIVATE WINDOW adaug SAME

ELSE



ACTIVATE WINDOW adaug NOSHOW

ENDIF

@ 12,4 SAY "Data obtinerii categ.:" ;

SIZE 1,22, 0

@ 2,4 SAY "Nume :" ;

SIZE 1,22, 0

@ 3,4 SAY "Prenume :" ;

SIZE 1,22, 0

@ 5,4 SAY "Adresa :" ;

SIZE 1,22, 0

@ 7,4 SAY "Data nasterii :" ;

SIZE 1,22, 0

@ 9,4 SAY "Data eliberarii :" ;

SIZE 1,22, 0

@ 10,4 SAY "Data expirarii :" ;

SIZE 1,22, 0

@ 11,4 SAY "Categorii :" ;

SIZE 1,22, 0

@ 8,4 SAY "Numarul permisului :" ;

SIZE 1,22, 0

@ 4,4 SAY "Cod numeric personal :" ;

SIZE 1,22, 0

@ 2,26 GET m.nume ;

SIZE 1,20 ;

DEFAULT " " ;

PICTURE "@A! xxxxxxxxxxxxxxxxxxxx" ;

VALID _rv210jpng()

@ 3,26 GET m.prenume ;

SIZE 1,25 ;

DEFAULT " " ;

PICTURE "@A! xxxxxxxxxxxxxxxxxxxxxxxxx" ;

VALID _rv210jpu6()

@ 4,26 GET m.cnp ;

SIZE 1,13 ;

DEFAULT 0 ;

PICTURE "@Z 9999999999999"

@ 5,26 GET m.adresa ;

SIZE 2,25 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

@ 7,26 GET m.datan ;

SIZE 1,8 ;

DEFAULT

@ 8,26 GET m.nrperm ;

SIZE 1,10 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxx" ;

VALID _rv210jpzf()

@ 9,26 GET m.dataelp ;

SIZE 1,8 ;

DEFAULT

@ 10,26 GET m.dataexp ;

SIZE 1,8 ;

DEFAULT

@ 11,26 GET m.categ ;

SIZE 1,10 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxx"

@ 12,26 GET m.daobcat ;

SIZE 1,25 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxxxxxxxxxxxxxxxxx"

@ 14,15 GET m.aa ;

PICTURE "@*HN ADAUGA;ANULEZ" ;

SIZE 1,10,5 ;

DEFAULT 1 ;

VALID _rv210jq1t()

IF NOT WVISIBLE("adaug")

ACTIVATE WINDOW adaug

ENDIF

READ CYCLE

RELEASE WINDOW adaug

SELECT (m.currarea)

#REGION 0

IF m.talkstat = "ON"

SET TALK ON

ENDIF

IF m.compstat = "ON"

SET COMPATIBLE ON

ENDIF

FUNCTION _rv210jpng && m.nume VALID

#REGION 1

IF EMPTY(m.nume)

WAIT WINDOW 'Nume invalid !!!' TIMEOUT 2

_CUROBJ=1

ENDIF

FUNCTION _rv210jpu6 && m.prenume VALID

#REGION 1

IF EMPTY(m.prenume)

WAIT WINDOW 'Prenume invalid !!!' TIMEOUT 2

_CUROBJ=2

ENDIF

FUNCTION _rv210jpzf && m.nrperm VALID

#REGION 1

IF EMPTY(m.nrperm)

WAIT WINDOW 'Numar invalid !!!' TIMEOUT 2

_CUROBJ=6

ELSE

GO TOP

SET ORDER TO TAG NRPERM

SEEK m.nrperm

IF FOUND()

WAIT WINDOW 'Acest permis exista in baza de date !!!' TIMEOUT 2

_CUROBJ=6

ENDIF

ENDIF

FUNCTION _rv210jq1t && m.aa VALID

#REGION 1

IF m.aa = 1

APPEND BLANK

GATHER MEMVAR

WAIT WINDOW 'Inregistrarea a fost adaugata.' TIMEOUT 2

SCATTER MEMVAR BLANK

SHOW GETS

_CUROBJ=1

ELSE

WAIT WINDOW 'Inregistrarea a fost anulata.' TIMEOUT 2

SCATTER MEMVAR BLANK

SHOW GETS

_CUROBJ=1

ENDIF

* PROGRAM MODIF.PRG *

#REGION 0

REGIONAL m.currarea, m.talkstat, m.compstat

IF SET("TALK") = "ON"

SET TALK OFF

m.talkstat = "ON"

ELSE

m.talkstat = "OFF"

ENDIF

m.compstat = SET("COMPATIBLE")

SET COMPATIBLE FOXPLUS

m.currarea = SELECT()

IF NOT WEXIST("modif") ;

OR UPPER(WTITLE("MODIF")) == "MODIF.PJX" ;

OR UPPER(WTITLE("MODIF")) == "MODIF.SCX" ;

OR UPPER(WTITLE("MODIF")) == "MODIF.MNX" ;

OR UPPER(WTITLE("MODIF")) == "MODIF.PRG" ;

OR UPPER(WTITLE("MODIF")) == "MODIF.FRX" ;

OR UPPER(WTITLE("MODIF")) == "MODIF.QPR"

DEFINE WINDOW modif ;

FROM INT((SROW()-22)/2),INT((SCOL()-57)/2) ;

TO INT((SROW()-22)/2)+21,INT((SCOL()-57)/2)+56 ;

TITLE " Modifica inregistrari " ;

FOOTER " Apasa <ESC> pentru iesire " ;

NOFLOAT ;

CLOSE ;

SHADOW ;

NOMINIMIZE ;

DOUBLE ;

COLOR SCHEME 1

ENDIF

#REGION 1

USE Permise

SET SAFETY OFF

SET DATE TO DMY

INDEX ON NUME TAG NUME ADDITIVE

INDEX ON STR(CNP,13) TAG CNP ADDITIVE

INDEX ON NRPERM TAG NRPERM ADDITIVE

SCATTER MEMVAR BLANK

#REGION 1

IF WVISIBLE("modif")

ACTIVATE WINDOW modif SAME

ELSE

ACTIVATE WINDOW modif NOSHOW

ENDIF

@ 12,4 SAY "Data obtinerii categ.:" ;

SIZE 1,22, 0

@ 3,4 SAY "Nume :" ;

SIZE 1,22, 0

@ 4,4 SAY "Prenume :" ;

SIZE 1,22, 0

@ 7,4 SAY "Adresa :" ;

SIZE 1,22, 0

@ 6,4 SAY "Data nasterii :" ;

SIZE 1,22, 0

@ 9,4 SAY "Data eliberarii :" ;

SIZE 1,22, 0

@ 10,4 SAY "Data expirarii :" ;

SIZE 1,22, 0

@ 11,4 SAY "Categorii :" ;

SIZE 1,22, 0

@ 1,4 SAY "Numarul permisului :" ;

SIZE 1,22, 0

@ 5,4 SAY "Cod numeric personal :" ;

SIZE 1,22, 0

@ 13,4 SAY "Suspendare :" ;

SIZE 1,22, 0

@ 14,4 SAY "Data suspendarii :" ;

SIZE 1,22, 0

@ 15,4 SAY "Data restituirii :" ;

SIZE 1,22, 0

@ 16,4 SAY "Anulare :" ;

SIZE 1,22, 0

@ 1,26 GET m.nrperm ;

SIZE 1,10 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxx" ;

VALID _rv210ldiv()

@ 3,26 GET m.nume ;

SIZE 1,20 ;

DEFAULT " " ;

PICTURE "@A! xxxxxxxxxxxxxxxxxxxx" ;

VALID _rv210ldrf()

@ 4,26 GET m.prenume ;

SIZE 1,25 ;

DEFAULT " " ;

PICTURE "@A! xxxxxxxxxxxxxxxxxxxxxxxxx" ;

VALID _rv210ldzg()

@ 5,26 GET m.cnp ;

SIZE 1,13 ;

DEFAULT 0 ;

PICTURE "@Z 9999999999999"

@ 6,26 GET m.datan ;

SIZE 1,8 ;

DEFAULT

@ 7,26 GET m.adresa ;

SIZE 2,25 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

@ 9,26 GET m.dataelp ;

SIZE 1,8 ;

DEFAULT

@ 10,26 GET m.dataexp ;

SIZE 1,8 ;

DEFAULT

@ 11,26 GET m.categ ;

SIZE 1,10 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxx"

@ 12,26 GET m.daobcat ;

SIZE 1,25 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxxxxxxxxxxxxxxxxx"

@ 13,26 GET m.su ;

SIZE 1,2 ;

DEFAULT " " ;

PICTURE "@A! xx" ;

WHEN _rv210le3s() ;

VALID _rv210le4o()

@ 14,26 GET m.dasusp ;

SIZE 1,10 ;

DEFAULT ;

DISABLE

@ 15,26 GET m.darest ;

SIZE 1,10 ;

DEFAULT ;

DISABLE

@ 16,26 GET m.an ;

SIZE 1,2 ;

DEFAULT " " ;

PICTURE "@A! xx" ;

WHEN _rv210le5e() ;

VALID _rv210le5p()

@ 18,15 GET m.aa ;

PICTURE "@*HN MODIFICA;ANULEAZA" ;

SIZE 1,10,5 ;

DEFAULT 1 ;

VALID _rv210le6v()

IF NOT WVISIBLE("modif")

ACTIVATE WINDOW modif

ENDIF

READ CYCLE

RELEASE WINDOW modif

SELECT (m.currarea)

#REGION 0

IF m.talkstat = "ON"

SET TALK ON

ENDIF

IF m.compstat = "ON"

SET COMPATIBLE ON

ENDIF

FUNCTION _rv210ldiv && m.nrperm VALID

#REGION 1

IF EMPTY(m.nrperm)

WAIT WINDOW 'Numar invalid !!!' TIMEOUT 2

_CUROBJ=1

ELSE

GO TOP

SET ORDER TO TAG NRPERM

SEEK m.nrperm

IF NOT(FOUND())

WAIT WINDOW 'Acest permis nu exista in baza de date !!!' TIMEOUT 2

_CUROBJ=1

ELSE

SCATTER MEMVAR

SHOW GETS

ENDIF

ENDIF

FUNCTION _rv210ldrf && m.nume VALID

#REGION 1

IF EMPTY(m.nume)

WAIT WINDOW 'Nume invalid !!!' TIMEOUT 2

_CUROBJ=2

ENDIF

FUNCTION _rv210ldzg && m.prenume VALID

#REGION 1

IF EMPTY(m.prenume)

WAIT WINDOW 'Prenume invalid !!!' TIMEOUT 2

_CUROBJ=3

ENDIF

FUNCTION _rv210le3s && m.su WHEN

#REGION 1

m.su='NU'

FUNCTION _rv210le4o && m.su VALID

#REGION 1

IF m.su='DA'

m.susp=.T.

SHOW GET m.dasusp ENABLED

SHOW GET m.darest ENABLED

SHOW GET m.an DISABLED

ELSE

SHOW GET m.dasusp DISABLED

SHOW GET m.darest DISABLED

SHOW GET m.an ENABLED

ENDIF

FUNCTION _rv210le5e && m.an WHEN

#REGION 1

m.an='NU'

FUNCTION _rv210le5p && m.an VALID

#REGION 1

IF m.an='DA'

m.anulat=.T.

ENDIF

FUNCTION _rv210le6v && m.aa VALID

#REGION 1

IF m.aa = 1

GATHER MEMVAR

WAIT WINDOW 'Inregistrarea a fost modificata.' TIMEOUT 2

SCATTER MEMVAR BLANK

SHOW GETS

SHOW GET m.dasusp DISABLED

SHOW GET m.darest DISABLED

SHOW GET m.an ENABLED

_CUROBJ=1

ELSE

WAIT WINDOW 'Inregistrarea nu a fost modificata.' TIMEOUT 2

SCATTER MEMVAR BLANK

SHOW GETS

SHOW GET m.dasusp DISABLED

SHOW GET m.darest DISABLED

SHOW GET m.an ENABLED

_CUROBJ=1

ENDIF

* PROGRAM RAPOR.PRG *

use permise

set talk off

set safety off

set order to nume

m.st=SPACE(7)

clear

?

?"Lista permiselor" at 30

?

?"-------- ----- ------ -------- ----- ------ ----------"

?"Nume Prenume Nr. perm. Categorii Stare "

?"-------- ----- ------ -------- ----- ------ ----------"

go top

do while .not. eof()

if susp

m.st="SUSPEN "

else

if anulat

m.st="ANULAT "

else

m.st="CIRCULA"

endif

endif

?Nume, Prenume, Nrperm, Categ, m.st

skip

enddo

?"-------- ----- ------ -------- ----- ------ ----------"

5)SALARIZAREA PERSONALULUI INTR-O UNITATE ECONOMICA TININD CONT DE TRANSE DE VECHIME,INDEMNIZATII,RETINERI ,..

* MENIU.PRG *

SET TALK OFF

SET SAFETY OFF

SET DATE TO DMY

USE SAL

CLEAR

DEFINE WINDOW SAL ;

FROM 1,0 TO 24,79 DOUBLE

ACTIVATE WINDOW SAL

DO AFIS

SET SYSMENU TO

SET SYSMENU AUTOMATIC

DEFINE PAD _rwp0iureg OF _MSYSMENU PROMPT "\<Actualizare" COLOR SCHEME 3 ;

KEY ALT+A, "ALT+A"

DEFINE PAD _rwp0iurei OF _MSYSMENU PROMPT "\<Calcule" COLOR SCHEME 3 ;

KEY ALT+C, "ALT+C"

DEFINE PAD _rwp0iurej OF _MSYSMENU PROMPT "\<Iesire" COLOR SCHEME 3 ;

KEY ALT+I, "ALT+I"



ON PAD _rwp0iureg OF _MSYSMENU ACTIVATE POPUP actualizar

ON PAD _rwp0iurei OF _MSYSMENU ACTIVATE POPUP calcule

ON PAD _rwp0iurej OF _MSYSMENU ACTIVATE POPUP iesire

DEFINE POPUP actualizar MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF actualizar PROMPT "\<Adaugare" ;

KEY CTRL+A, "CTRL+A"

DEFINE BAR 2 OF actualizar PROMPT "\<Modificare" ;

KEY CTRL + M, "CTRL + M"

DEFINE BAR 3 OF actualizar PROMPT "\<Stergere" ;

KEY CTRL + S, "CTRL + S"

DEFINE BAR 4 OF actualizar PROMPT "\-"

DEFINE BAR 5 OF actualizar PROMPT "Vi\<zualizare" ;

KEY CTRL+Z, "CTRL+Z"

ON SELECTION BAR 1 OF actualizar DO ADAUG

ON SELECTION BAR 2 OF actualizar DO MODIF

ON SELECTION BAR 3 OF actualizar DO STERG

ON BAR 5 OF actualizar ACTIVATE POPUP vizualizar

DEFINE POPUP vizualizar MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF vizualizar PROMPT "Ava\<ns" ;

KEY CTRL + N, "CTRL + N"

DEFINE BAR 2 OF vizualizar PROMPT "Lic\<hidare" ;

KEY CTRL+H, "CTRL+H"

ON SELECTION BAR 1 OF vizualizar MODIFY COMMAND AVA.LST

ON SELECTION BAR 2 OF vizualizar MODIFY COMMAND LIC.LST

DEFINE POPUP calcule MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF calcule PROMPT "A\<vans" ;

KEY CTRL+V, "CTRL+V"

DEFINE BAR 2 OF calcule PROMPT "\<Lichidare" ;

KEY CTRL+L, "CTRL+L"

DEFINE POPUP iesire MARGIN RELATIVE SHADOW COLOR SCHEME 4

DEFINE BAR 1 OF iesire PRO 444j93e MPT "MS-\<DOS" ;

KEY CTRL+D, "CTRL+D"

DEFINE BAR 2 OF iesire PROMPT "\<FOX PRO" ;

KEY CTRL+F, "CTRL+F"

ON SELECTION BAR 1 OF iesire QUIT

ON SELECTION BAR 2 OF iesire DO IESIRE IN MENIU.PRG

PROCEDURE IESIRE

DEACTIVATE WINDOW SAL

SET SYSMENU TO DEFAULT

CLEAR

RETURN

PROCEDURE AFIS

TEXT

P R O G R A M S A L A R I I

ENDTEXT

RETURN

CLEAR

SET TALK OFF

SET SAFETY OFF

SET ALTERNATE TO AVA.LST

SET ALTERNATE ON

SET CONSOLE OFF

USE SAL

SET ORDER TO TAG MARCA

?'Ú A A A A AÂ A A A A A A A A A AÂ A A A A A A A A A AÂ A A A A A A AÂ A A A A A A AÂ A A A A A A A A Aż'

?'łMARCAłNUMELE łPRENUMELE łSALARIUłAVANS łSEMNATURAł'

?'Ă A A A A AĹ A A A A A A A A A AĹ A A A A A A A A A AĹ A A A A A A AĹ A A A A A A AĹ A A A A A A A A A´'

GO TOP

DO WHILE .NOT. EOF()

?'ł' + STR(MARCA,5)+'ł' + NUME+'ł' + PREN+'ł' + STR(SALAR,7)+'ł' + STR(AVANS,7)+'ł'+' '+'ł'

SKIP

ENDDO

?'Ŕ A A A A AÁ A A A A A A A A A AÁ A A A A A A A A A AÁ A A A A A A AÁ A A A A A A AÁ A A A A A A A A AŮ'

SET CONSOLE ON

CLOSE ALTERNATE

SET ALTERNATE OFF

WAIT WINDOW 'LISTA AVANSURILOR SE AFLA IN FISIERUL AVA.LST' TIMEOUT 2

CLEAR

SET TALK OFF

SET SAFETY OFF

SET ALTERNATE TO LIC.LST

SET ALTERNATE ON

SET CONSOLE OFF

USE SAL

SET ORDER TO TAG MARCA

?'Ú A A A A AÂ A A A A A A A A A AÂ A A A A A A A A A AÂ A A A A A A AÂ A A A A A A AÂ A A AÂ A A A A A A A AÂ A A A A A AÂ A A A A AÂ A A A A A A AÂ A A A A A A AÂ A A A A A A A A Aż'

?'łMARCAłNUMELE łPRENUMELE łSALARIUłAVANS łVECłSPOR VECłPENSIEłSOMAJłIMPOZITłREST PLłSEMNATURAł'

?'Ă A A A A AĹ A A A A A A A A A AĹ A A A A A A A A A AĹ A A A A A A AĹ A A A A A A AĹ A A AĹ A A A A A A A AĹ A A A A A AĹ A A A A AĹ A A A A A A AĹ A A A A A A AĹ A A A A A A A A A´'

GO TOP

DO WHILE .NOT. EOF()

M.SALB=0

M.PENS=0

M.SOMA=0

M.REST=0

M.SPVEC=0

M.IMPO=0

M.IMPO1=0

M.IMPO2=0

M.IMPO3=0

M.IMPO4=0

M.IMPO5=0

M.IMPO6=0

IF VECH<3 .AND. VECH>=1

M.SPVEC=SALAR*0.05

ENDIF

IF VECH<5 .AND. VECH>=3

M.SPVEC=SALAR*0.08

ENDIF

IF VECH<8 .AND. VECH>=5

M.SPVEC=SALAR*0.11

ENDIF

IF VECH<11 .AND. VECH>=8

M.SPVEC=SALAR*0.15

ENDIF

IF VECH<15 .AND. VECH>=11

M.SPVEC=SALAR*0.20

ENDIF

IF VECH>=15

M.SPVEC=SALAR*0.25

ENDIF

M.SALB=SALAR + M.SPVEC

M.IMPO1=250000*0

IF M.SALB>=0 .AND. M.SALB<250000

M.IMPO=M.IMPO1

ENDIF

IF M.SALB>=250000 .AND. M.SALB<500000

M.IMPO2=(M.SALB-250000)*0.1

M.IMPO=M.IMPO1 + M.IMPO2

ENDIF

IF M.SALB>=500000 .AND. M.SALB<1000000

M.IMPO2=(500000-250000)*0.1

M.IMPO3=(M.SALB-500000)*0.2

M.IMPO=M.IMPO1 + M.IMPO2 + M.IMPO3

ENDIF

IF M.SALB>=1000000 .AND. M.SALB<2500000

M.IMPO2=(500000-250000)*0.1

M.IMPO3=(1000000-500000)*0.2

M.IMPO4=(M.SALB-1000000)*0.3

M.IMPO=M.IMPO1 + M.IMPO2 + M.IMPO3 + M.IMPO4

ENDIF

IF M.SALB>=2500000 .AND. M.SALB<3500000

M.IMPO2=(500000-250000)*0.1

M.IMPO3=(1000000-500000)*0.2

M.IMPO4=(2500000-1000000)*0.3

M.IMPO5=(M.SALB-2500000)*0.4

M.IMPO=M.IMPO1 + M.IMPO2 + M.IMPO3 + M.IMPO4 + M.IMPO5

ENDIF

IF M.SALB>=3500000

M.IMPO2=(500000-250000)*0.1

M.IMPO3=(1000000-500000)*0.2

M.IMPO4=(2500000-1000000)*0.3

M.IMPO5=(3500000-2500000)*0.4

M.IMPO6=(M.SALB-3500000)*0.45

M.IMPO=M.IMPO1 + M.IMPO2 + M.IMPO3 + M.IMPO4 + M.IMPO5 + M.IMPO6

ENDIF

M.PENS=M.SALB*0.03

M.SOMA=M.SALB*0.01

M.REST=M.SALB-AVANS-M.PENS-M.SOMA-M.IMPO

?'ł' + STR(MARCA,5)+'ł' + NUME+'ł' + PREN+'ł' + STR(SALAR,7)+'ł' + STR(AVANS,7)+'ł' + STR(VECH,3)+'ł' + STR(M.SPVEC,8)+'ł' + STR(M.PENS,6)+'ł' + STR(M.SOMA,5)+'ł' + STR(M.IMPO,7)+'ł' + STR(M.REST,7)+'ł'+' '+'ł'

SKIP

ENDDO

?'Ŕ A A A A AÁ A A A A A A A A A AÁ A A A A A A A A A AÁ A A A A A A AÁ A A A A A A AÁ A A AÁ A A A A A A A AÁ A A A A A AÁ A A A A AÁ A A A A A A AÁ A A A A A A AÁ A A A A A A A A AŮ'

SET CONSOLE ON

CLOSE ALTERNATE

SET ALTERNATE OFF

WAIT WINDOW 'LISTA LICHIDARILOR SE AFLA IN FISIERUL LIC.LST' TIMEOUT 2

* MODIF.PRG *

#REGION 0

REGIONAL m.currarea, m.talkstat, m.compstat

IF SET("TALK") = "ON"

SET TALK OFF

m.talkstat = "ON"

ELSE

m.talkstat = "OFF"

ENDIF

m.compstat = SET("COMPATIBLE")

SET COMPATIBLE FOXPLUS

m.currarea = SELECT()

IF NOT WEXIST("adaug") ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.PJX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.SCX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.MNX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.PRG" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.FRX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.QPR"

DEFINE WINDOW adaug ;

FROM INT((SROW()-15)/2),INT((SCOL()-43)/2) ;

TO INT((SROW()-15)/2)+14,INT((SCOL()-43)/2)+42 ;

TITLE " Adaugare inregistrari " ;

FOOTER " Apasa <ESC> pentru iesire " ;

NOFLOAT ;

CLOSE ;

SHADOW ;

NOMINIMIZE ;

DOUBLE ;

COLOR SCHEME 1

ENDIF

#REGION 1

CLEAR

SET TALK OFF

SET SAFETY OFF

USE SAL

SET ORDER TO TAG MARCA

SCATTER MEMVAR BLANK

#REGION 1

IF WVISIBLE("adaug")

ACTIVATE WINDOW adaug SAME

ELSE

ACTIVATE WINDOW adaug NOSHOW

ENDIF

@ 5,5 SAY "Prenumele:" ;

SIZE 1,10, 0

@ 3,5 SAY "Marca :" ;

SIZE 1,10, 0

@ 4,5 SAY "Numele :" ;

SIZE 1,10, 0

@ 6,5 SAY "Vechime :" ;

SIZE 1,10, 0

@ 7,5 SAY "Salariu :" ;

SIZE 1,10, 0

@ 3,16 GET m.marca ;

SIZE 1,4 ;

DEFAULT 0 ;

PICTURE "9999" ;

VALID _rwp0ie2si()

@ 4,16 GET m.nume ;

SIZE 1,20 ;

DEFAULT " " ;

PICTURE "@!K xxxxxxxxxxxxxxxxxxxx" ;

DISABLE

@ 5,16 GET m.pren ;

SIZE 1,20 ;

DEFAULT " " ;

PICTURE "@!K xxxxxxxxxxxxxxxxxxxx" ;

DISABLE

@ 6,16 GET m.vech ;

SIZE 1,2 ;

DEFAULT 0 ;

PICTURE "@K 99" ;

DISABLE

@ 7,16 GET m.salar ;

SIZE 1,7 ;

DEFAULT 0 ;

PICTURE "@K 9999999" ;

DISABLE

@ 10,15 GET M.MD ;

PICTURE "@*HN MODIFICA" ;

SIZE 1,10,1 ;

DEFAULT 1 ;

VALID _rwp0ie2t6() ;

DISABLE

IF NOT WVISIBLE("adaug")

ACTIVATE WINDOW adaug

ENDIF

READ CYCLE

RELEASE WINDOW adaug

SELECT (m.currarea)

#REGION 0

IF m.talkstat = "ON"

SET TALK ON

ENDIF

IF m.compstat = "ON"

SET COMPATIBLE ON

ENDIF

#REGION 1

SET TALK ON

SET SAFETY ON

DO AVA.PRG

DO LIC.PRG

USE

CLEAR

FUNCTION _rwp0ie2si && m.marca VALID

#REGION 1

SEEK M.MARCA

IF FOUND()

SCATTER MEMVAR

_CUROBJ=2

SHOW GETS ENABLED

ELSE

WAIT WINDOW 'Marca '+ALLTRIM(STR(M.MARCA))+' nu exista!' TIMEOUT 2

_CUROBJ=1

SCATTER MEMVAR BLANK

SHOW GETS DISABLED

SHOW GET M.MARCA ENABLED

ENDIF

FUNCTION _rwp0ie2t6 && M.MD VALID

#REGION 1

M.AVANS=M.SALAR*0.4

GATHER MEMVAR

WAIT WINDOW 'Inregistrarea a fost modificata.' TIMEOUT 2

_CUROBJ=1

SCATTER MEMVAR BLANK

SHOW GETS DISABLED

SHOW GET M.MARCA ENABLED

* STERG.PRG *

#REGION 0

REGIONAL m.currarea, m.talkstat, m.compstat

IF SET("TALK") = "ON"

SET TALK OFF

m.talkstat = "ON"

ELSE

m.talkstat = "OFF"

ENDIF

m.compstat = SET("COMPATIBLE")

SET COMPATIBLE FOXPLUS

m.currarea = SELECT()

IF NOT WEXIST("adaug") ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.PJX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.SCX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.MNX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.PRG" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.FRX" ;

OR UPPER(WTITLE("ADAUG")) == "ADAUG.QPR"

DEFINE WINDOW adaug ;

FROM INT((SROW()-15)/2),INT((SCOL()-43)/2) ;

TO INT((SROW()-15)/2)+14,INT((SCOL()-43)/2)+42 ;

TITLE " Adaugare inregistrari " ;

FOOTER " Apasa <ESC> pentru iesire " ;

NOFLOAT ;

CLOSE ;

SHADOW ;

NOMINIMIZE ;

DOUBLE ;

COLOR SCHEME 1

ENDIF

#REGION 1

CLEAR

SET TALK OFF

SET SAFETY OFF

USE SAL

SET ORDER TO TAG MARCA

SCATTER MEMVAR BLANK

#REGION 1

IF WVISIBLE("adaug")

ACTIVATE WINDOW adaug SAME

ELSE

ACTIVATE WINDOW adaug NOSHOW

ENDIF

@ 5,5 SAY "Prenumele:" ;

SIZE 1,10, 0

@ 3,5 SAY "Marca :" ;

SIZE 1,10, 0

@ 4,5 SAY "Numele :" ;

SIZE 1,10, 0

@ 6,5 SAY "Vechime :" ;

SIZE 1,10, 0

@ 7,5 SAY "Salariu :" ;

SIZE 1,10, 0

@ 3,16 GET m.marca ;

SIZE 1,4 ;

DEFAULT 0 ;

PICTURE "9999" ;

VALID _rwp0iqx9e()

@ 4,16 GET m.nume ;

SIZE 1,20 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxxxxxxxxxxxx" ;

DISABLE

@ 5,16 GET m.pren ;

SIZE 1,20 ;

DEFAULT " " ;

PICTURE "@! xxxxxxxxxxxxxxxxxxxx" ;

DISABLE

@ 6,16 GET m.vech ;

SIZE 1,2 ;

DEFAULT 0 ;

PICTURE "99" ;

DISABLE

@ 7,16 GET m.salar ;

SIZE 1,7 ;

DEFAULT 0 ;

PICTURE "9999999" ;

DISABLE

@ 10,12 GET M.ST ;

PICTURE "@*HN STERG;CAUTA" ;

SIZE 1,7,3 ;

DEFAULT 1 ;

VALID _rwp0iqxa2() ;

DISABLE

IF NOT WVISIBLE("adaug")

ACTIVATE WINDOW adaug

ENDIF

READ CYCLE

RELEASE WINDOW adaug

SELECT (m.currarea)

#REGION 0

IF m.talkstat = "ON"

SET TALK ON

ENDIF

IF m.compstat = "ON"

SET COMPATIBLE ON

ENDIF

#REGION 1

SET TALK ON

SET SAFETY ON

DO AVA.PRG

DO LIC.PRG

USE

CLEAR

FUNCTION _rwp0iqx9e && m.marca VALID

#REGION 1

SEEK M.MARCA

IF FOUND()

SCATTER MEMVAR

_CUROBJ=2

SHOW GETS ENABLED

ELSE

WAIT WINDOW 'Marca '+ALLTRIM(STR(M.MARCA))+' nu exista!' TIMEOUT 2

_CUROBJ=1

SCATTER MEMVAR BLANK

SHOW GETS DISABLED

SHOW GET M.MARCA ENABLED

ENDIF

FUNCTION _rwp0iqxa2 && M.ST VALID

#REGION 1

IF M.ST=1

DELETE

PACK

SCATTER MEMVAR BLANK

_CUROBJ=1

SHOW GETS DISABLED

SHOW GET M.MARCA ENABLED

ELSE

SCATTER MEMVAR BLANK

_CUROBJ=1

SHOW GETS DISABLED

SHOW GET M.MARCA ENABLED

ENDIF





Document Info


Accesari: 4833
Apreciat: hand-up

Comenteaza documentul:

Nu esti inregistrat
Trebuie sa fii utilizator inregistrat pentru a putea comenta


Creaza cont nou

A fost util?

Daca documentul a fost util si crezi ca merita
sa adaugi un link catre el la tine in site


in pagina web a site-ului tau.




eCoduri.com - coduri postale, contabile, CAEN sau bancare

Politica de confidentialitate | Termenii si conditii de utilizare




Copyright © Contact (SCRIGROUP Int. 2024 )