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
|
