modifdbf.prg

System "somaj" for city Beius

procedure modifdbf

set sysm off
set mouse off
use someri
name=" "
do nume with name,"Care este numele somerului cautat ?"
locate for left(upper(numele),len(name))=trim(name)
if found()
	do modif

else
	do atentie with "Nu cunosc aceasta persoana !"
	do doresti
endif
show gets
          

procedure doresti
lady=" "
DEACTIVATE WINDOW beve
do iesire with lady,"Mai avem de modificat date ?"
if lady="D" then
        close data
		do modifviz
else
   close databases
  DEACTIVATE WINDOW beve
set sysm on
set mouse on
    return
endif


procedure modif

	DEFINE WINDOW beve FROM 1,8 TO 23,69 ;
    DOUBLE COLOR w+/gr shado
	ACTIVATE WINDOW beve
    @1,4 say 'Numele                  : '
    @1,30 get numele pict'@!xxxxxxxxxxxxxxxxxxxx';
             COLOR w+/r, w/r;                 
    				messa 'Care este numele persoanei ?'
    @ 3,4 say 'Initiala tatalui        : '
    @3,30 get init_tata pict'@!xxxxxxxxxxxxxxxxxxxx';
             COLOR w+/r, w/r;                 
    				messa 'Care este initiala tatalui ?'
    @ 5,4 say 'Initiala mamei          : '
    @5,30 get init_mama pict'@!xxxxxxxxxxxxxxxxxxxx';
             COLOR w+/r, w/r;                     		
    				messa 'Care este initiala mamei ?'
    @ 7,4 say 'Prenumele               : '
    @7,30 get prenume pict'@!xxxxxxxxxxxxxxxxxxx';
                COLOR w+/r, w/r;                 
                       messa 'Spune-mi prenumele persoanei !'
    @ 9,4 say 'Prenumele 1             : '
    @9,30 get prenume_1 pict'@!xxxxxxxxxxxxxxxxxxxx';
    			 COLOR w+/r, w/r;                 
    				messa 'Persoana are si alt prenume ?'
    @11,4 say 'Prenumele 2             : '
    @11,30 get prenume_2 pict'@!xxxxxxxxxxxxxxxxxxxx';
    		 COLOR w+/r, w/r;                 
    				messa 'Persoana are si alt prenume ?'						    
   @13,4 say 'Prenumele 3             : '
   @13,30 get prenume_3 pict'@!xxxxxxxxxxxxxxxxxxxx';
    				 COLOR w+/r, w/r;                 
    				messa 'Persoana are si alt prenume ?'
    @15,4 say 'Zi nastere              : '
    @15,30 get zi_nastere pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                  
                    messa 'In ce zi s-a nascut acesta persoana ?'
    @17,4 say 'Luna nastere            : '
    @17,30 get luna_naste pict'@!xxxxxxxxxxxxxxxxxxx';
             COLOR w+/r, w/r;                  
              messa 'In ce luna s-a nascut acesta persoana ?'
    @19,4 say 'Anul nasterii           : '
    @19,30 get an_nastere pict'@!xxxxxxxxxxxxxxxxxxx';
                COLOR w+/r, w/r;                  
                    messa 'In ce an s-a nascut acesta persoana ?'

read
*    set colo to w+/gr
    
lady=" "
do aproba with lady,"Totul e-n regula ?"
if lady="D" then
	do modif1
else 
	do modif
endif

procedure modif1
    clea
    @1,4 say 'Varsta                  : '
    @1,30 get varsta pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                  
                    messa 'Citi ani are acesta persoana ?'
    @3,4 say 'Localitatea nastere     : '
    @3,30 get locul_nast pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                                  
                    messa 'In ce localitate s-a nascut acesta persoana ?'
    @5,4 say 'Domiciliu in ?          : '
    @5,30 get oras_domic pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                               
                    messa 'In ce oras s-a nascut acesta persoana ?'
    @7 ,4 say 'Codul orasului          : '
    @7 ,30 get cod_oras pict'xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                                  
                    messa 'Care este codul acestui oras ?'
    @9 ,4 say 'Strada domiciliu        : '
    @9 ,30 get str_domic pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                                  
                    messa 'Pe ce strada locuieste aceasta persoana ?'
    @11,4 say 'Numar domiciliu         : '
    @11,30 get nr_domicil pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                  
                    messa 'La ce numar locuieste aceasta persoana ?'
    @13,4 say 'Bloc_domiciliu          : '
    @13,30 get bloc_domic pict'@!xxxxxxxxxxxxxxxxxxx';
                  COLOR w+/r, w/r;                                
                    messa 'In ce bloc locuiest aceasta persoana ?'
    @15,4 say 'Scara domiciliu         : '
    @15,30 get scara_domi pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                          
                    messa 'La ce scara sta acesta persoana ?'
    @17,4 say 'Etaj domiciliu          : '
    @17,30 get etaj_domic pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                              
                    messa 'La ce etaj sta acesta persoana ?'
    @19,4 say 'Apartament domiciliu    : '
    @19,30 get apart_domi pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                                
                    messa 'In ce apartament sta acesta persoana ?'
read
    set colo to w+/gr
lady=" "
do aproba with lady,"Totul e-n regula ?"
if lady="D" then
	do modif2
else 
	do modif1
endif

procedur modif2
    clea
    @1,4 say 'Pasaport valabil an     : '
    @1,30 get pasaport pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Pina cind e valabil pasaportul ?'
    @3,4 say 'Buletin identitate      : '
    @3,30 get bulet_iden pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Buletin : Seria - Nr.  !'
    @5,4 say 'Categ. carnet sofer     : '
    @5,30 get carne_sofer pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                              
                    messa 'Categoria carnet sofer ?'
    @7,4 say 'Inaltimea (in metri)    : '
    @7,30 get inaltime  pict'x.xx';
         COLOR w+/r, w/r;                                                 
                    messa 'Ce inaltime are persoana ?'
    @9,4 say 'Masa (in kg)            : '
    @9,30 get masa_in_kg pict'xxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Ce greutate are persoana  ?'
    @11,4 say 'Culoarea parului        : '
    @11,30 get cul_par  pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Ce culoare are parul ?'
    @13,4 say 'Culoarea ochilor        : '
    @13,30 get cul_ochi pict'@!xxxxxxxxxxxxxxxxxxx';
        COLOR w+/r, w/r;                                
                    messa 'Ce culoare au ochii ?'
    @15,4 say 'Numar telefon           : '
    @15,30 get telefon  pict'@!xxxxxxxxxxxxxxxxxxx';
        COLOR w+/r, w/r;                                
                    messa 'Care este numarul de telefon ?'
    @17,4 say 'Semne particulare       : '
    @17,30 get semne_part pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Persoana are semne particulare ?'
    @19,4 say 'Forma fetei             : '
    @19,30 get forma_fata pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Forma fetei (rotunda/ovala) ?'

read
    set colo to w+/gr

lady=" "
do aproba with lady,"Totul e-n regula ?"
if lady="D" then
	do modif3
else 
	do modif2
endif

procedur modif3
    clea
    @1,4 say 'Automobil               : '
    @1,30 get automobil   pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                              
                    messa 'Dispune de masina persoana asta ?'
    @3,4 say 'Cartea de munca         : '
    @3,30 get cart_munca pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                        
    			messa 'Carte de munca (DA/NU) ?'
    @5,4 say 'Capacitate profesionala : '
    @5,30 get capac_prof  pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                        
    			messa 'Ce capacitate profesionala are persoana ?'
    @7,4 say 'Instruire  profesionala : '
    @7,30 get instr_prof  pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                        
    			messa 'Ce instruire profesionala are persoana ?'
    @9,4 say 'Ocupatia                : '
    @9,30 get ocupatia  pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                    
    			messa 'Cu ce se ocupa aceasta persoana ?'
    @11,4 say 'Profesia                : '
    @11,30 get profesia  pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                    
    			messa 'Ce profesie are aceasta persoana ?'
    @13,4 say 'Vechime in munca        : '
    @13,30 get vechime   pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                    
    			messa 'Ce vechime are persoana ?'
    @15,4 say 'Locul de munca          : '
    @15,30 get loc_munca pict '@!xxxxxxxxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                    
    			messa 'Unde lucreaza ? '
    @17,4 say 'Loc de munca anterior   : '
    @17,30 get loc_m_ante  pict '@!xxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                    
    			messa 'Unde a lucrat inainte ?'
    @19,4 say 'Conditii de munca       : '
    @19,30 get cond_munca pict '@!xxxxxxxxxxxxxxxxxxxxx';
     COLOR w+/r, w/r;                                    
    			messa 'In ce conditii lucreaza (grele/acceptabile/.../foarte bune) ? '
read
    set colo to w+/gr
lady=" "
do aproba with lady,"Totul e-n regula ?"
if lady="D" then
	do modif4
else 
	do modif3
endif

procedur modif4
    clea
    @1,4 say 'Referinte               : '
    @1,30 get referinte pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Referinte referitoare la  persoana ?'
    @3,4 say 'Scoala profesionala     : '
    @3,30 get scoal_prof pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                                  
                    messa 'A facut scoala profesionala persoana ?'
  	@4,4 say 'Scoala profesionala  2  : '
    @4,30 get scoalprof2 pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                                  
                    messa 'A facut scoala profesionala persoana ?'
    @5,4 say '10 clase                : '
    @5,30 get clase_10  pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Persoana are 10 clase facute ?'
    @7,4 say '11 clase                : '
    @7,30 get clase_11  pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Persoana are 11 clase facute ?'
    @9,4 say '12 clase                : '
    @9,30 get clase_12  pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Persoana are 12 clase facute ?'
    @11,4 say 'Bacalaureat             : '
    @11,30 get bacalaurea pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                
                    messa 'Are bacalaureat ?'
    @13,4 say 'Facultatea              : '
    @13,30 get facultate pict'@!xxxxxxxxxxxxxxxxxxx';
         COLOR w+/r, w/r;                                                  
                    messa 'Ce facultate a terminat ?'
    @15,4 say 'Studii postliceale      : '
    @15,30 get st_postlic pict'@!xxxxxxxxxxxxxxxxxxx';