PARAMETERS  gcini_file
gcini_path = LOWER(JUSTPATH(SYS(16)))
gcini_path = STRTRAN(m.gcini_path, "\progs", "")
gcini_path = gcini_path + IIF(RIGHT(m.gcini_path, 1)="\", "", "\")

gcverze = "2010-04-30"
m.gcverzex=m.gcverze

#IF VERSION(5) > 777
	SET enginebehavior 70
#ENDIF

CLOSE DATABASES
IF PARAMETERS() = 0
	IF EMPTY(GETENV("f600cfg") )
		#IF "SLOVAK"$UPPER(GETENV("language"))
			gcini_file = "m:\food600.ini"
		#ELSE
			gcini_file = "c:\food600.ini"
		#ENDIF
	ELSE
		gcini_file = GETENV("f600cfg")
	ENDIF
ENDIF
CLEAR

IF TYPE('_screen.label') = 'O'
	_SCREEN.REMOVEOBJECT('label')
ENDIF
IF TYPE('_screen.logo') = 'O'
	_SCREEN.REMOVEOBJECT('logo')
ENDIF
IF TYPE('_screen.label1') = 'O' THEN
	_SCREEN.REMOVEOBJECT('label1')
ENDIF
IF TYPE('_screen.label2') = 'O' THEN
	_SCREEN.REMOVEOBJECT('label2')
ENDIF
IF TYPE('tbscreen') = 'O' THEN
	RELEASE tbscreen
ENDIF

STORE "" TO gcusername, gcuser_id, gcjazyk, gcid_zkratka, gcera_cen, gcansw, machine, repo_name,gcklient, gcrepo_table
STORE "" TO gcpgm_path, gcrepo_path, gcdat_path, gccen_path, gcpgm_id, gcpgm, gcpgm_param, gcpri_path
STORE "" TO gcbour_skup, gcsetup_skup, gcpgmskupina, gcstredskup, gcid_klapky, gczadan_prn, gcpomocna, gczalohacesta
STORE "" TO err_h_info, mssg, semafor_id
STORE "" TO fn_karty, fn_skupiny, fn_bourak, fn_umisteni, fn_partneri, fn_polozky, fn_objednan, fn_jidelak, fn_parovaky, fn_umdruhy, fn_eany, fn_spotrebnadan
STORE "" TO fn_sklad, fn_doklady, fn_obraty, fn_dokl_a, fn_obra_a, fn_dokl_sto, fn_obra_sto, fn_davky, fn_dluhy, m.fn_dokl_s, m.fn_obra_s
STORE "" TO fn_food_dat, fn_users, fn_buffer, fn_bufdokl, fn_hesla, fn_uzav, fn_vahinv, fn_cas_hlav, fn_cas_pol, fn_hh_hlav, fn_hh_druhy
STORE "" TO fn_sk_pol, fn_sk_plt, fn_sk_sez, fn_sk_fin, fn_sk_txt, fn_sk_pol_a, fn_sk_plt_a, fn_sk_sez_a, fn_sk_fin_a, fn_sk_txt_a, fn_uctobd
STORE "" TO nazev_filter, dlouhy_log,txt_dodaku,uctobd,uctobdtxt

STORE .F. TO glis_admin, z_archivu, g0, g1, g2, g3, g4, g5, g6, g7, g8, g9, m.issql
STORE .T. TO m.prvespustenie,m.naozajspustit, m.gcrobitzalohudat


* nebere se z food_dat.pgm_path, ale rovnou ze spousteneho exace (tedy z ini_path)
gcpgm_path = m.gcini_path + "progs\"
gcrepo_path  = m.gcini_path + "reports\"

m.issql=.F.
PUBLIC ARRAY en_meny(2,5)
#IF "SLOVAK"$UPPER(GETENV("language"))
	en_meny(1,1)=1
	en_meny(2,1)=30.1260000000000
	en_meny(1,2)=1/en_meny(2,1)
	en_meny(2,2)=1
	en_meny(1,3)="SKK"
	en_meny(2,3)="EUR"
	en_meny(1,4)="200812"
	en_meny(2,4)="210001"
	en_meny(1,5)=1
	en_meny(2,5)=2
#ELSE
	en_meny(1,1)=1
	en_meny(2,1)=1.0000000000000
	en_meny(1,2)=1/en_meny(2,1)
	en_meny(2,2)=1
	en_meny(1,3)="Kč"
	en_meny(2,3)="EUR"
	en_meny(1,4)="201501"
	en_meny(2,4)="210001"
	en_meny(1,5)=1
	en_meny(2,5)=2
#ENDIF

PUBLIC ARRAY day_of_weak(7)
STORE 1 TO  m.cdata

STORE 2 TO m.giakt_mena,giref_mena,girep_mena,m.girep_round,m.gicennik_mena
STORE "" TO m.uctobd

gczurnal_info = ""
d1 = 0
d2 = 999999999
STORE "NIC" TO operace, operace_txt, d1_txt, d1_dat_dokl, d2_txt, d2_dat_dokl
smazana_karta = "xxx SMAZANO xxx"
ostatni = "__ostatni_"
nechci = "_*nevybran"

#IF "SLOVAK"$UPPER(GETENV("language"))
	gccopyright = " (C)Alto Slovakia, v." + gcverze
#ELSE
	gccopyright = " (C)Alto Praha, v." + gcverze
#ENDIF
STORE 0 TO gic_stredisk, m.gityp_inst
old_poloz = "!@#$%^&*"
gcjazyk = "0"
*is_admin = .F.
label_yes = "*"
gicolor0 = RGB(255, 255, 255)
gicolor1 = RGB(222, 222, 222)
gicolor2 = RGB(255,255,128)
gicolor3 = RGB(128,255,128)
DIMENSION acolor(4)
acolor(1)="RGB(255, 255, 255)"
acolor(2)="RGB(222, 222, 222)"
acolor(3)="RGB(255,255,128)"
acolor(4)="RGB(128,255,128)"
gio_scrwidth = _SCREEN.WIDTH
gio_scrheight = _SCREEN.HEIGHT
gcprava_skup = "^$"
rcprava_skup = "^$"
glfiltr_kalk_stredskup = .T.
gctxt_summary = ""

*DECLARE INTEGER ShellExecute IN "shell32.dll" LONG hwnd, STRING lpOperation, STRING lpFile, STRING lpParameters, STRING lpDirectory, INTEGER nShowCmd

DECLARE LONG FindWindow IN Win32API STRING, STRING
DECLARE LONG BringWindowToTop IN "user32" LONG
DECLARE LONG SHOWWINDOW IN "user32" LONG, LONG

DECLARE INTEGER GetPrivateProfileString IN Win32API  AS GetPrivStr ;
	STRING cSection, STRING cKey, STRING cDefault, STRING @cBuffer, INTEGER nBufferSize, STRING cINIFile

DECLARE INTEGER WritePrivateProfileString IN Win32API AS WritePrivStr ;
	STRING cSection, STRING cKey, STRING cValue, STRING cINIFile

gchom_path        = get_ini("Config", "HomPath")
gcgroup_id        = get_ini("Config", "GroupId")
gcpgm             = get_ini("Config", "Pgm")
gcdec_point       = get_ini("Config", "DecPoint")
gccollate         = "machine"

IF ("." $ gcdec_point) .OR. ("TEC" $ UPPER(gcdec_point)) .OR. ("POI" $ UPPER(gcdec_point))
	SET POINT TO "."
ELSE
	SET POINT TO ","
ENDIF

SET DEFAULT TO (m.gcini_path)
DO setpath
SET PROCEDURE TO semafory, ppgm

SET CLASSLIB TO "foodbase" ADDI
SET CLASSLIB TO "_app" ADDI
#IF "SLOVAK"$UPPER(GETENV("language"))
	SET CLASSLIB TO "_base" ADDI
#ENDIF

fn_food_dat = gchom_path + "food_dat"
IF !FILE(gchom_path + "food_dat.dbf")
	=MESSAGEBOX("Neexistuje FOOD_DAT.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF
IF !FILE(gchom_path + "uctobd.dbf")
	=MESSAGEBOX("Neexistuje UCTOBD.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF
IF !FILE(gchom_path + "errors.dbf")
	=MESSAGEBOX("Neexistuje ERRORS.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF
IF !FILE(gchom_path + "food_set.dbf")
	=MESSAGEBOX("Neexistuje FOOD_SET.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF
IF !FILE(gchom_path + "maxima.dbf")
	=MESSAGEBOX("Neexistuje MAXIMA.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF
IF !FILE(gchom_path + "users.dbf")
	=MESSAGEBOX("Neexistuje USERS.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF
IF !FILE(gchom_path + "semafory.dbf")
	=MESSAGEBOX("Neexistuje SEMAFORY.DBF",16,"Food600",2)
	CLOSE ALL
	DO shut_dn
ENDIF

ON ERROR DO err_hand WITH ERROR(), MESSAGE(), MESSAGE(1), LINE()

IF WEXIST ("Project Manager - Food600")
	HIDE WIND ("Project Manager - Food600")
ENDIF

systolb = CREATEOBJECT ('_systoolbars', .T.)

DO ini_set

DO n_ready
DO del_pripath WITH m.gcpri_path
DO jazykini
IF BITAND(VAL(OS(10)), 16) # 0    && terminal server
	_SCREEN.WIDTH  = VAL( get_ini("Windows", "ScreenWidth",  "900") )
	_SCREEN.HEIGHT = VAL( get_ini("Windows", "ScreenHeight", "666") )
ELSE
	_SCREEN.WIDTH  = VAL( get_ini(m.machine, "ScreenWidth",  "900") )
	_SCREEN.HEIGHT = VAL( get_ini(m.machine, "ScreenHeight", "666") )
ENDIF

SET SYSMENU SAVE
CLOSE DATABASES
m.gcuser_id="SUP"
gcusername = "Default User " + m.gcuser_id
glis_admin = .T.
chyba_pri_otevirani = .F.
TRY
	otevira_se = m.fn_food_dat
	USE (m.fn_food_dat) ALIAS food_dat	IN 0 SHARED
CATCH
	chyba_pri_otevirani = .T.
ENDTRY
IF chyba_pri_otevirani
	=MESSAGEBOX(jaz("prg_dbf_neprist_skuste_pozdeji")+CHR(13)+m.otevira_se,64,"Food600",2)
	DO zurnal_log WITH "OPERA", "Automatická archivácia", jaz("nejde_otevrit") + m.otevira_se
	CLOSE DATABASES
	RETURN .F.
ENDIF


SELECT *, "KASY" AS kas_man,.F. AS LABEL ;
	WHERE (((pgm LIKE "%KAS%") OR (pgm LIKE "%K32%")) AND (pgm_param LIKE "%MASTER%")).OR.(pgm LIKE "HOREC").OR.(pgm LIKE "EURO") ;
	FROM food_dat INTO CURSOR kasy
SELECT *, "MANAGERY" AS kas_man,.F. AS LABEL ;
	WHERE pgm LIKE "%MAN%" ORDER BY ID ;
	FROM food_dat INTO TABLE (m.gcpri_path + "strediska")
APPEND FROM DBF("kasy")
REPLACE ALL c_stredisk WITH - ABS(c_stredisk)
INDEX ON ID TAG ID
USE

SELECT food_dat
m.last_operace="KK"
m.fn_buffer=(m.gcpri_path+"buffer")
m.prepoc_ooo=0
SCAN FOR UPPER(ALLTRIM(pgm))="MAN" .AND. priority>0
	m.ponechatmesiace=food_dat.priority
	IF m.ponechatmesiace<3
		m.ponechatmesiace=3
	ENDIF
	m.gic_stredisk=food_dat.c_stredisk
	m.gcpgm_id=food_dat.ID
	m.gcpgm_path=ALLTRIM(food_dat.ID)
	IF povolena_oprava()
		IF povoleny_vydaj()
			DO prepni_sklad
			SELECT 0
			IF USED("uctobd")
				SELECT uctobd
			ELSE		
				USE (m.fn_uctobd) ALIAS uctobd
			ENDIF 
			LOCATE FOR c_stredisk=m.gic_stredisk
			IF FOUND()
				m.uctobd=uctobd.uctobd
			ELSE
				m.uctobd=LEFT(DTOS(DATE()),6)
			ENDIF
			USE IN uctobd
			FOR m.giakt_mena=1 TO ALEN(en_meny,1)
				IF m.uctobd<=en__meny(m.giakt_mena,4)
					EXIT
				ENDIF
			ENDFOR
			#IF "SLOVAK"$UPPER(GETENV("language"))
				USE (m.fn_uzav) IN 0 ALIAS uzaverka ORDER kedy
				SET FILTER TO c_stredisk=m.gic_stredisk
				COUNT TO m.pocetmesiacov FOR c_stredisk=m.gic_stredisk
				IF m.pocetmesiacov>(m.ponechatmesiace+1)
					GO BOTTOM
					SKIP -(m.ponechatmesiace)
					m.c_dokldo=uzaverka.c_dokldo
					m.max_datum_dokl=uzaverka.datum_dokl
					SELECT 0
					USE (m.fn_obraty) ALIAS obraty ORDER c_dokl
					LOCATE FOR c_stredisk=m.gic_stredisk .AND. c_dokl<m.c_dokldo-1
					IF FOUND()
						USE IN obraty
						DO arc_1 WITH m.c_dokldo,.T. IN archivac
						DO zurnal_log WITH "OPERA", "AUTOMATICKÁ ARCHIVÁCIA OBRATOV " + m.gcpgm_id, STR(m.c_dokldo)
					ENDIF
					DO pozavirej WITH "uzaverka, obraty"
				ELSE
					USE IN uzaverka
				ENDIF
			#ELSE
				USE (m.fn_doklady) IN 0 ALIAS doklady ORDER c_dokl
				max_datum_dokl=GOMONTH(DATE()-DAY(DATE())+1,-1*m.ponechatmesiace)+15
				SELECT c_dokl, datum_dokl FROM doklady WHERE c_stredisk=m.gic_stredisk .and. operace="KK" .and. datum_dokl<=m.max_datum_dokl ORDER BY c_dokl INTO CURSOR konec
				IF RECCOUNT()>0
					GO TOP 
					m.c_dokldo=konec.c_dokl
					m.max_datum_dokl=konec.datum_dokl
					SELECT 0
					USE (m.fn_obraty) ALIAS obraty ORDER c_dokl
					LOCATE FOR c_stredisk=m.gic_stredisk .AND. c_dokl<m.c_dokldo-1
					IF FOUND()
						USE IN obraty
						DO arc_1 WITH m.c_dokldo,.T. IN archivac
						DO zurnal_log WITH "OPERA", "AUTOMATICKÁ ARCHIVÁCIA OBRATOV " + m.gcpgm_id, STR(m.c_dokldo)
					ENDIF
				ENDIF 				
				DO pozavirej WITH "doklady, obraty, konec"
			#ENDIF
			DO n_sunlock WITH "BUF_OUT_"+m.gcpgm_id
			DO n_sunlock WITH "OPRAVA"
		ELSE
			DO n_sunlock WITH "OPRAVA"
		ENDIF
	ENDIF
	IF !USED("food_dat")
		SELECT 0
		USE (m.fn_food_dat) ALIAS food_dat
		LOCATE FOR c_stredisk=m.gic_stredisk
	ENDIF
ENDSCAN
CLOSE DATABASES
TRY
	otevira_se = m.fn_food_dat
	USE (m.fn_food_dat) ALIAS food_dat	IN 0 SHARED
CATCH
	chyba_pri_otevirani = .T.
ENDTRY
IF chyba_pri_otevirani
	=MESSAGEBOX(jaz("prg_dbf_neprist_skuste_pozdeji")+CHR(13)+m.otevira_se,64,"Food600",2)
	DO zurnal_log WITH "OPERA", "Automatická archivácia", jaz("nejde_otevrit") + m.otevira_se
	CLOSE DATABASES
	RETURN .F.
ENDIF
SELECT DISTINCT dat_path FROM food_dat WHERE UPPER(ALLTRIM(pgm))="MAN" INTO ARRAY cesty
FOR m.isweras=1 TO ALEN(cesty,1)
	IF USED("food_dat")
		SELECT food_dat
	ELSE
		SELECT 0
		USE (m.fn_food_dat) ALIAS food_dat
	ENDIF
	LOCATE FOR dat_path=cesty(m.isweras)
	IF FOUND()
		m.gic_stredisk=food_dat.c_stredisk
		IF m.prepoc_ooo=0
			DO set_scat WITH ALLTRIM(food_dat.pgm_path) + "food_set.dbf", m.gchom_path + "food_set.dbf"
			SELECT 0
			USE (m.fn_food_dat) ALIAS food_dat
			LOCATE FOR c_stredisk=m.gic_stredisk
		ENDIF
		DO prepni_sklad
		DO indexy
		DO prep_all_od WITH 0
		DO zurnal_log WITH "OPERA", "AUTOMATICKÁ ARCHIVÁCIA OBRATOV - prepočet " + ALLTRIM(cesty(m.isweras))
	ENDIF
ENDFOR

IF USED("food_dat")
	SELECT food_dat
ELSE
	SELECT 0
	USE (m.fn_food_dat) ALIAS food_dat
ENDIF
SELECT DISTINCT cen_path FROM food_dat WHERE UPPER(ALLTRIM(pgm))="MAN" INTO ARRAY cesty
IF ALEN(cesty,1)>0
	FOR m.isweras=1 TO ALEN(cesty,1)
		IF USED("food_dat")
			SELECT food_dat
		ELSE
			SELECT 0
			USE (m.fn_food_dat) ALIAS food_dat
		ENDIF
		LOCATE FOR cen_path=cesty(m.isweras)
		IF FOUND()
			m.gic_stredisk=food_dat.c_stredisk
			DO prepni_sklad
			IF m.archiv_sk=0
				m.archiv_sk=3
			ENDIF 
			IF f_acc_ex(m.gccen_path + "sk_sez")
			     uzav_arch  = DATE(YEAR(DATE() - (m.archiv_sk * 30)), month(DATE() - (m.archiv_sk * 30)), 1) - 1
			     LOCATE FOR uct_den <= m.uzav_arch
			     IF FOUND()
	        		   datum2 = m.uzav_arch
			           DO arch_sk_1 WITH m.datum2 IN arch_cz
			     ENDIF 
			ENDIF 
		ENDIF
	ENDFOR
ENDIF 
DO shut_dn

*!*****************************************************************************
*!*****************************************************************************
*!*****************************************************************************
*!*****************************************************************************
*!*****************************************************************************

*!*****************************************************************************
*!      Procedure: INI_SET
*!*****************************************************************************
PROCEDURE ini_set
CLEAR PROGRAM
CLEAR WINDOW
CLEAR MACROS
DO nastavsety
SET RESOURCE     OFF
SET STATUS       OFF
SET SCOREBOARD   OFF
SET STATUS BAR   OFF
#IF VERSION(5) > 777
	SET enginebehavior 70
#ENDIF

_SCREEN.CAPTION = "Food600 "
_SCREEN.BACKCOLOR = RGB(100, 100, 200)
_SCREEN.PICTURE = m.gcini_path + "BITMAPS\pozadi.gif"

*!*****************************************************************************
*!      Procedure: ERR_HAND
*!*****************************************************************************
PROCEDURE err_hand
PARAMETERS err_num, mssg, line_txt, mlineno
PRIVATE sta_debug, can_susp, lastw, old_errh, old_row, old_col, prog_chain, iii, otevreno
* takhle se aktivuje : ON ERROR DO err_hand WITH ERROR(), MESSAGE(), MESSAGE(1), LINE()

IF m.err_num = 1001    && function not available - kdyz se zapomene SUSPEND
	WAIT "zapomenutej suspeeeeeeeeend" WIND TIME .2 AT 22,22
	RETURN
ENDIF

PUSH KEY CLEAR

mssg = STR(m.err_num, 5) + ":" + LEFT(m.mssg, 222)
line_txt = STRTR(m.line_txt, "   ", " ")
line_txt = STRTR(m.line_txt, "   ", " ")
line_txt = ALLT(STRTR(m.line_txt, "  ", " "))
line_txt = STR(m.mlineno, 5) + ":" + LEFT(m.line_txt, 222)
otevreno = DBF() + IIF(EMPTY(DBF()), "", " as " + ALIAS() + IIF(EMPTY(ORDER()), " not ordered", " tag " + ORDER()))
otevreno = SUBSTR(STRTR( m.otevreno, ".DBF", ""), 4)
prog_chain = PROGRAM(2)
iii = 3
DO WHILE (PROGRAM(iii) # PROGRAM()) .AND. (m.iii < 32)
	prog_chain = ALLT(IIF ("..." $ PROGRAM(iii), "", PROGRAM(iii) + " ") + m.prog_chain)
	iii = m.iii + 1
ENDDO

DEFINE POPUP pop_errh FROM 11,0 TITLE " C H Y B A             " + m.gcverze + "  " + m.gchom_path + "  " + m.gcuser_id + "    " + m.machine IN SCREEN
DEFINE BAR  1 OF pop_errh PROMPT "\<Ignore . . . ignoruj chybu"
DEFINE BAR  2 OF pop_errh PROMPT "\<Retry. . . . opakuj akci"
DEFINE BAR  3 OF pop_errh PROMPT "\<Suspend. . . prerus" SKIP FOR "upport" $ VERS()
DEFINE BAR  4 OF pop_errh PROMPT "\<Cancel . . . ukonci program"
DEFINE BAR  5 OF pop_errh PROMPT "\-"
DEFINE BAR  6 OF pop_errh PROMPT "Err : " + PADR(TRIM(m.mssg),      111)
DEFINE BAR  7 OF pop_errh PROMPT "Line: " + PADR(TRIM(m.line_txt),  111)
DEFINE BAR  8 OF pop_errh PROMPT "      " + PADR(SUBSTR(TRIM(m.line_txt),112), 111)
DEFINE BAR  9 OF pop_errh PROMPT "Prog: " + PADR(TRIM(m.prog_chain),111)
DEFINE BAR 10 OF pop_errh PROMPT "      " + PADR(SUBSTR(TRIM(m.prog_chain),112),111)
DEFINE BAR 11 OF pop_errh PROMPT "Used: " + m.otevreno
DEFINE BAR 12 OF pop_errh PROMPT "Pozn: " + m.err_h_info

ON SELECTION POPUP pop_errh DEACTIVATE POPUP pop_errh
ACTIVATE POPUP pop_errh BAR 4
DO WHILE BAR() = 0 .OR. BAR() > 4
	ACTIVATE POPUP pop_errh BAR 4
ENDDO
RELEASE POPUP pop_errh
gcansw = PROMPT()
DO CASE
	CASE BAR() = 1    && Ignore
		DO app_log WITH m.line_txt
		POP KEY
		RETURN
	CASE BAR() = 2    && Retry
		DO app_log WITH m.line_txt
		POP KEY
		RETRY
	CASE BAR()=3      && Suspend
		DO app_log WITH m.line_txt
		DO sta_susp
	OTHERWISE        && Cancel
		DO app_log WITH m.line_txt
		ON KEY
		DO del_pripath WITH m.gcpri_path
		DO shut_dn
ENDCASE

*!*****************************************************************************
*!      Procedure: STA_SUSP
*!*****************************************************************************
PROCEDURE sta_susp
PRIVATE old_sel, old_errh, old_row, old_col, lastw
lastw = WOUTPUT()
old_errh = ON("ERROR")
old_row = ROW()
old_col = COL()
ACTIVATE SCREEN
SAVE SCREEN
ON ERROR
PUSH KEY CLEAR
SET SYSMENU TO DEFAULT
IF "EXE" $ VERSION(1)
	DO FORM SUSPEND
ELSE
	SUSPEND
ENDIF
DO ini_set
DO titulek
DO menu_def
ON ERROR &old_errh
ACTIVATE SCREEN
RESTORE SCREEN
IF .NOT. EMPTY(m.lastw)
	ACTIVATE WINDOW (m.lastw)
ENDIF
@ m.old_row, m.old_row SAY ""
POP KEY

*!*****************************************************************************
*!      Procedure: APP_LOG
*!*****************************************************************************
PROCEDURE app_log
LPARAMETERS line_txt
WAIT LEFT(m.line_txt, 111) WIND TIME .1 AT 22,22
PRIVATE cas, prg, aplog_sel
aplog_sel = SELE()
SELE 0
IF .NOT. FILE(m.gchom_path + "ERRORS.DBF")
	DO creafile WITH m.gchom_path + "ERRORS"
ENDIF
prg = PADR(ALLT(m.gcpgm) + " " + ALLT(m.gcpgm_param) + " " + ALLT(m.gcverze), 22) + "|" + m.gcpgm_id + ;
	"|" + LEFT(RIGHT(m.gchom_path, 9), 8) + "|" + RIGHT(m.gcpgm_path, 14)
cas = DATETIME()
kdo = m.gcuser_id + " " + m.gcansw
prog_chain = PROGRAM(1)
iii = 2
DO WHILE (PROGRAM(iii) # PROGRAM()) .AND. (m.iii < 32)
	prog_chain = ALLT(IIF ("..." $ PROGRAM(iii), "", PROGRAM(iii) + " ") + m.prog_chain)
	iii = m.iii + 1
ENDDO
prog_chain = STRTR( m.prog_chain, "APP_LOG", "")
prog_chain = STRTR( m.prog_chain, "ERR_HAND", "")
INSERT INTO (m.gchom_path + "ERRORS") FROM MEMVAR
USE IN errors
SELE (m.aplog_sel)

*!*****************************************************************************
*!      Function: shut_dn
*!*****************************************************************************
PROCEDURE shut_dn
DO n_sunlock
DO clos_data
DO n_sunlock
RELEASE systolb

DO clos_data
DO del_pripath WITH m.gcpri_path
_SCREEN.WIDTH  = gio_scrwidth
_SCREEN.HEIGHT = gio_scrheight
SET LIBRARY TO
ON ERROR
SET SYSMENU NOSAVE
SET SYSMENU TO DEFAULT
RELEASE ALL EXTENDED

IF WEXIST ("Project Manager - Food600")
	SHOW WIND ("Project Manager - Food600")
ENDIF
CANCEL

*!*****************************************************************************
*!      Procedure: del_pripath
*!*****************************************************************************
PROCEDURE del_pripath
LPARAMETERS cesta
PRIVATE cccc, dddd, iiii, cesta
IF ! EMPTY(m.cesta)
	err_h_old = ON ("ERROR")
	ON ERROR STORE .F. TO m.ok
	cesta = ALLT(cesta) + IIF(RIGHT(ALLT(cesta) ,1)="\", "", "\")
	cccc = ADIR(dddd, m.cesta + "*.*")
	FOR iiii = 1 TO cccc
		ERASE (m.cesta + dddd(iiii, 1))
	ENDFOR
	IF "SHUT_" $ UPPER(PROGRAM(1) + PROGRAM(2) + PROGRAM(3) + PROGRAM(4) + PROGRAM(5) + PROGRAM(6))
		RMDIR (m.cesta)
	ENDIF
	ON ERROR &err_h_old
	cccc = ADIR (dddd, ALLT(m.cesta) + "*.*")
	RETURN EMPT(m.cccc)
ENDIF

*!*****************************************************************************
*!      Procedure: MK_DIR
*!*****************************************************************************
PROCEDURE mk_dir
PARAMETERS cesta
err_h_old = ON ("ERROR")
ON ERROR a = 1
MKDIR ( m.cesta )
ON ERROR &err_h_old

*!*****************************************************************************
*!      Procedure: zamkni
*!*****************************************************************************
FUNCTION zamkni
PRIVATE _iii
_iii = 1
DO WHILE ! FLOCK() .AND. m._iii < 33 .AND. ! EMPT(DBF())
	WAIT "Cekejte, zamykam " + DBF() + STR(m._iii,6) WIND TIME m._iii
	_iii = m._iii + 1
ENDDO
RETURN FLOCK()

*!*****************************************************************************
*!       Function: PRAZDNA()
*!*****************************************************************************
FUNCTION prazdna
PARAMETERS mssg_taky
PRIVATE old_rec, rt
old_rec = RECNO()
GO TOP
rt = EOF()
IF m.rt .AND. m.mssg_taky
	WAIT jaz("db-empty") WINDOW TIME 2
ENDIF
IF RECCOUNT() >= m.old_rec
	GOTO (m.old_rec)
ELSE
	GO BOTTOM
ENDIF
RETURN m.rt

*!*****************************************************************************
*!      Function: GET_INI
*!*****************************************************************************
FUNCTION get_ini
LPARAM section, klic, defa_value, geti_soubor
IF PARAM() < 3
	m.defa_value = ""
ENDIF
IF PARAM() < 4
	m.geti_soubor = gcini_file
ENDIF
lcbuffer = SPACE(999) + CHR(0)
libufsize = getprivstr(m.section, m.klic, m.defa_value, @lcbuffer, LEN(lcbuffer), m.geti_soubor)
IF libufsize = 0
	*    do put_ini with section, klic, defa_value
	WAIT "neni klic" + m.klic + " v sekci " + section WIND TIME .1
	RETURN ""
ELSE
	RETURN LEFT( m.lcbuffer,m.libufsize )
ENDIF

*!*****************************************************************************
*!      Function: PUT_INI
*!*****************************************************************************
FUNCTION put_ini
LPARAM section, klic, hodnota
pom = writeprivstr( m.section, m.klic, m.hodnota, m.gcini_file )
RETURN (pom = 1)

*!*****************************************************************************
*!      Function: TITULEK
*!*****************************************************************************
PROC titulek
_SCREEN.CAPTION = "Food600 " + m.gcverze + "    " + m.rcid_zkratka + " (" + ALLTRIM(STR(ric_stredisk)) + ")        " + m.gcusername + "     " + gcini_file + "  " + m.gchom_path

*!*****************************************************************************
*!      Function: SET_SCAT
*!*****************************************************************************
FUNCTION set_scat
PARAM set_file1, set_file2
fn_pom = m.gcpri_path + "pom"
IF FILE(m.set_file1)
	USE (m.set_file1)
	IF FILE(m.set_file2)
		SELE 0
		IF .NOT. ("s_kas_" $ LOWER(m.set_file2))
			ALTER TABLE (m.set_file2) ALTER COLUMN var_name c(20)
		ENDIF
		USE(m.set_file2)
		DELETE FOR LOWER(var_name) = "ean_path"
		SELECT * FROM (m.set_file1) INTO TABLE (fn_pom) WHERE var_name NOT IN (SELECT var_name FROM (m.set_file2))
		DELE FOR EMPT(var_name)
		PACK
		CLOSE DATA
		USE (m.set_file2)
		IF FILE (m.fn_pom + ".dbf")
			APPEND FROM (m.fn_pom)
		ENDIF
		ERASE (m.fn_pom)
	ELSE
		COPY FOR (! DELETED()) .AND. (! EMPT(var_name)) FIELD var_name, var_value TO (m.set_file2)
		USE (m.set_file2)
	ENDIF
	SCAN FOR (! EMPTY(var_name)) .AND. (! EMPTY(var_value))
		SCATTER MEMVAR
		cmd = "type('" + ALLT(var_name) + "')"
		IF &cmd = "U"
			PUBLIC &var_name
		ENDIF
		&var_name = EVALUATE(m.var_value)
	ENDSCAN
	RETURN .T.
ELSE
	RETURN .F.
ENDIF


*!*****************************************************************************
*!      Procedure: F_ACC
*!*****************************************************************************
PROCEDURE f_acc
PARAMETERS fa_soubor
PRIVATE err_h_old, ok
ok = .T.
err_h_old = ON ("ERROR")
SELE 0
ON ERROR DO fa_errhand WITH ERROR(), MESSAGE()
fa_soubor = "USE " + m.fa_soubor
err_h_info = m.fa_soubor
&fa_soubor
err_h_info = ""
ON ERROR &err_h_old
RETURN m.ok

*!*****************************************************************************
*!       Function: F_ACC_EX()
*!*****************************************************************************
FUNCTION f_acc_ex
PARAMETERS fa_soubor
PRIVATE ok, err_h_old
IF ! FILE(m.fa_soubor + ".dbf")
	DO app_log WITH "F_ACC_EX : nonexistent " + m.fa_soubor
	WAIT CLEAR
ENDIF
ok = .T.
err_h_old = ON ("ERROR")
ON ERROR DO fa_errhand WITH ERROR(), MESSAGE()
err_h_info = m.fa_soubor
USE (m.fa_soubor) EXCLUSIVE
err_h_info = ""
IF m.ok
	USE (m.fa_soubor) EXCLUSIVE
ENDIF
ON ERROR &err_h_old
RETURN ok


*!*****************************************************************************
*!      Procedure: FA_ERRHAND
*!*****************************************************************************
PROCEDURE fa_errhand
PARAMETERS errno, messg
DO CASE
	CASE (m.errno = 108) .OR. (m.errno = 1705) .OR. (m.errno = 1718)   && File used by another/ Acces denied/Read only kvuli NT
		ok = .F.
		WAIT LEFT(m.fa_soubor,44) + ": " + m.messg WINDOW TIME 1 AT 22,22
	CASE m.errno = 114   && Index neodpovida databazi
		ok = .F.
		USE
		ERASE (m.fa_soubor + ".cdx")
		DO app_log WITH "FA_ERRHAND : index doesn't match database : " + m.fa_soubor
	OTHERWISE
		&err_h_old
ENDCASE


*!*****************************************************************************
*!      Procedure: JAZ2
*!*****************************************************************************
PROCEDURE jaz2
PARAMETERS klic
CLEAR TYPEAHEAD
PUSH KEY CLEAR
PRIVATE old_sel, rt
old_sel = SELE()
IF FILE(m.fn_hesla + ".DBF")
	IF USED("fn_hesla")
		SELE fn_hesla
	ELSE
		SELE 0
		USE (m.fn_hesla) ORDER klic ALIAS fn_hesla NOUPDATE
	ENDIF
	klic = PADR(LOWER(m.klic), 30)
	IF SEEK(m.klic)
		rt = fn_hesla.j
	ELSE
		rt = m.klic
	ENDIF
	SELE (m.old_sel)
ELSE
	WAIT "JAZYK : Nonexistent file (m.fn_hesla) , key:" + m.klic WINDOW NOWAIT
	rt = m.klic
ENDIF
POP KEY
RETURN TRIM(m.rt)

*!*****************************************************************************
*!      Procedure: JAZ
*!*****************************************************************************
PROCEDURE jaz
PARAMETERS klic, jaz_mut
jaz_mut = IIF(PARAM()>1, m.jaz_mut, "")
CLEAR TYPEAHEAD
PUSH KEY CLEAR
PRIVATE old_sel, rt
old_sel = SELE()
IF FILE(m.fn_hesla + ".DBF")
	IF USED("fn_hesla")
		SELE fn_hesla
	ELSE
		SELE 0
		USE (m.fn_hesla) ORDER klic ALIAS fn_hesla NOUPDATE
	ENDIF
	klic = PADR(LOWER(m.klic), 30)
	IF SEEK(m.klic)
		rt = "fn_hesla.j" + m.jaz_mut
		rt = &rt
	ELSE
*		WAIT "JAZYK : Key '" + m.klic +"' doesn't exist" WINDOW NOWAIT
*		DO add_klic
		rt = m.klic
		WAIT CLEAR
	ENDIF
	SELE (m.old_sel)
ELSE
	WAIT "JAZYK : Nonexistent file (m.fn_hesla) , key:" + m.klic WINDOW NOWAIT
	rt = m.klic
ENDIF
POP KEY
RETURN TRIM(m.rt)

*!*****************************************************************************
*!      Procedure: ADD_KLIC
*!*****************************************************************************
PROC add_klic
PRIVATE old_sel
old_sel = SELE()
DO use_sele WITH gcpgm_path + "jazyky", "jazyky"
LOCATE FOR jazyky.klic = m.klic
IF .NOT. FOUND()
	INSERT INTO (gcpgm_path + "jazyky") (klic,j0,j1,j2) VALUE (m.klic, m.klic, m.klic, m.klic)
ENDIF
USE IN jazyky
SELE (m.old_sel)

*!*****************************************************************************
*!      Procedure: USE_SELE
*!*****************************************************************************
PROC use_sele
PARAM soub_jm, soub_alias
IF USED(m.soub_alias)
	SELE (m.soub_alias)
ELSE
	IF ! FILE(m.soub_jm + ".dbf")
		DO creafile WITH m.soub_jm
	ENDIF
	=f_acc('(m.soub_jm) ALIAS (m.soub_alias)')
ENDIF

*!*****************************************************************************
*!      Procedure: CLOS_DATA
*!*****************************************************************************
PROCEDURE clos_data
PRIVATE o_oerr, aaa
o_oerr = ON ("ERROR")
ON ERROR aaa = 0
CLOSE DATA
ON ERROR &o_oerr


*!*****************************************************************************
*!      Procedure: POZAVIREJ
*!*****************************************************************************
PROC pozavirej
PARAM pom
DO WHILE "," $ m.pom
	por1 = AT(",", m.pom, 1)
	soub_alias = LEFT(m.pom, m.por1-1)
	pom = ALLT(SUBST(m.pom, por1+1))
	IF USED(m.soub_alias)
		USE IN (m.soub_alias)
	ENDIF
ENDDO
IF USED(m.pom)
	USE IN (m.pom)
ENDIF

*!*****************************************************************************
*!       Function: i_MAX()
*!*****************************************************************************
FUNCTION i_max
PARAMETERS soubor, pridaj
IF PARAMETERS()=1
	IF m.soubor = "c_dokl"
		m.pridaj=10
	ELSE
		m.pridaj=1
	ENDIF
ENDIF

PRIVATE i_max, stim_sel

stim_sel = SELE()
SELE 0
IF ! FILE(m.gchom_path + "maxima.dbf")
	DO creafile WITH m.gchom_path + "maxima"
	USE
ENDIF

err_h_old = ON ("ERROR")

_neotevreno = .T.
_zacatek_otvirani = SECONDS()
DO WHILE m._neotevreno .AND. BETWEEN(SECONDS() - _zacatek_otvirani, 0, 99)
	_neotevreno = .F.
	ON ERROR _neotevreno = .T.
	USE (m.gchom_path + "maxima.dbf") EXCLUSIVE
ENDDO

ON ERROR &err_h_old

IF _neotevreno
	DO zurnal_log WITH "OPERA", "I_MAX", m.soubor
	DO CASE
		CASE  m.soubor = "c_dokl"
			SELECT MAX(c_dokl) AS max_c FROM (m.fn_doklady) INTO CURSOR ii_max
			i_max  = ii_max.max_c + 22
			USE
		CASE  m.soubor = "karty"
			SELECT MAX(c_karty) AS max_c FROM (m.fn_karty) INTO CURSOR ii_max
			i_max  = ii_max.max_c_c + 22
			USE
		OTHERWISE
			m.i_max = 12345
	ENDCASE
ELSE
	LOCATE FOR soubor = m.soubor
	IF FOUND()
		i_max  = maxima.i_max + m.pridaj

		_nezapsano = .T.
		_zacatek_otvirani = SECONDS()
		DO WHILE m._nezapsano .AND. BETWEEN(SECONDS() - _zacatek_otvirani, 0, 5)
			_nezapsano = .F.
			ON ERROR _nezapsano = .T.
			GATHER FIELD i_max MEMVAR
		ENDDO

		IF m._nezapsano
			DO zurnal_log WITH "OPERA", "I_MAX - nelze zapsat", m.soubor, m.i_max
			i_max  = m.i_max + (9 * m.pridaj)
		ENDIF
		ON ERROR &err_h_old
	ELSE
		m.i_max = m.pridaj
		INSERT INTO (m.gchom_path + "maxima") FROM MEMVAR
	ENDIF
ENDIF

DO pozavirej WITH "maxima"
SELE (stim_sel)
RETURN m.i_max


*!*****************************************************************************
*!       Function: GET_MAX()
*!*****************************************************************************
FUNCTION get_max
PARAMETERS soubor
PRIVATE i_max, stim_sel
stim_sel = SELECT()
SELECT 0
IF ! FILE(m.gchom_path + "maxima.dbf")
	DO creafile WITH m.gchom_path + "maxima"
	USE
ENDIF

err_h_old = ON ("ERROR")
_neotevreno = .T.
_zacatek_otvirani = SECONDS()
DO WHILE m._neotevreno .AND. BETWEEN(SECONDS() - _zacatek_otvirani, 0, 99)
	WAIT "Cekejte, otviram MAXIMA.DBF   "+ ALLT(m.soubor) + STR(SECONDS() - _zacatek_otvirani, 6) WIND NOWA
	_neotevreno = .F.
	ON ERROR _neotevreno = .T.
	USE (m.gchom_path + "maxima.dbf") EXCLUSIVE
ENDDO
WAIT CLEAR

ON ERROR &err_h_old

IF _neotevreno
	DO zurnal_log WITH "OPERA", "I_MAX", DBF(), m._iii
	i_max = .F.
ELSE
	LOCATE FOR soubor = m.soubor
	IF FOUND()
		SCATTER FIELD i_max MEMVAR
	ELSE
		m.i_max=0
	ENDIF
ENDIF

DO pozavirej WITH "maxima"
SELECT (stim_sel)
RETURN m.i_max


*!*****************************************************************************
*!       Function: SET_MAX()
*!*****************************************************************************
FUNCTION set_max
PARAM soubor, cislo
PRIVATE i_max, stim_sel
stim_sel = SELE()
SELE 0
IF ! FILE(m.gchom_path + "maxima.dbf")
	DO creafile WITH m.gchom_path + "maxima"
	USE
ENDIF

err_h_old = ON ("ERROR")
_neotevreno = .T.
_zacatek_otvirani = SECONDS()
DO WHILE m._neotevreno .AND. BETWEEN(SECONDS() - _zacatek_otvirani, 0, 99)
	WAIT "Cekejte, otviram MAXIMA.DBF   "+ ALLT(m.soubor) + STR(SECONDS() - _zacatek_otvirani, 6) WIND NOWA
	_neotevreno = .F.
	ON ERROR _neotevreno = .T.
	USE (m.gchom_path + "maxima.dbf") EXCLUSIVE
ENDDO
WAIT CLEAR

ON ERROR &err_h_old

IF _neotevreno
	DO zurnal_log WITH "OPERA", "I_MAX", DBF(), m._iii
	i_max = .F.
ELSE
	LOCATE FOR soubor = m.soubor
	IF FOUND()
		REPLACE i_max WITH cislo
	ELSE
		INSERT INTO maxima (soubor,i_max) VALUES (m.soubor,m.cislo)
	ENDIF
ENDIF

DO pozavirej WITH "maxima"
SELE (stim_sel)



*!*****************************************************************************
*!       Procedure : Get_ComputerName
*!*****************************************************************************
FUNCTION get_computername

DECLARE INTEGER GetComputerName ;
	IN WIN32API STRING@ cComputerName, INTEGER@ nSize

lccomputer=SPACE(80)
lnsize=80

=getcomputername(@lccomputer,@lnsize)
IF lnsize < 2
	RETURN ""
ELSE
	RETURN SUBSTR(lccomputer,1,lnsize)
ENDIF


***********************************************************************
*         L.L Pridana pre slovensku verziu                            *
***********************************************************************
***L.L

*!*********************************************************************
PROCEDURE suppwd
SELECT 0
IF f_acc(gchom_path + "users")
	LOCATE FOR LOWER(username)="alto supervisor"
	IF !FOUND()
		INSERT INTO (m.gchom_path + "users") (heslo, username, user_id, jazyk) VALUE ("gm}ug", "ALTO Supervisor", "SUP", "0")
	ENDIF
	LOCATE FOR LOWER(username)="alto supervisor"
	m.den=DOW(DATE())-1
	IF m.den=0
		m.den=7
	ENDIF
	m.heslo_new=STRTRAN(STR(m.den+MONTH(DATE()),2)," ","0")+STRTRAN(STR(DAY(DATE())+m.den,2)," ","0")+STRTRAN(STR(MONTH(DATE())+DAY(DATE()),2)," ","0")
	m.heslo2=""
	FOR i=0 TO 5
		m.heslo2=m.heslo2+SUBSTR(m.heslo_new,6-i,1)
	ENDFOR
	m.heslo_new2=code_pwd(m.heslo2+SPACE(6))
	IF USERS.heslo<>m.heslo_new2 .OR. USERS.hash<>hash(m.heslo2+SPACE(6))
		REPLACE USERS.heslo WITH m.heslo_new2, USERS.hash WITH hash(m.heslo2+SPACE(6))
		TRY
			REPLACE USERS.hashfood WITH hash(m.heslo2+SPACE(6))
		CATCH
		ENDTRY
	ENDIF
	USE IN USERS
ENDIF

*!*****************************************************************************
*!      Function: GROUND
*!*****************************************************************************
* Pre spravne zaokruhlovanie cisel ako 0.25,...
FUNCTION ground
PARAMETERS xx,xy
IF ABS(ROUND(m.xx, m.xy)-m.xx)*10^(m.xy+1)=5
	IF INT(ROUND(m.xx, m.xy)*10^m.xy/2)*2=ROUND(m.xx, m.xy)*10^m.xy
		RETURN ROUND(m.xx,m.xy)
	ELSE
		RETURN (ROUND(m.xx,m.xy)*10^m.xy-1)/10^m.xy
	ENDIF
ELSE
	RETURN ROUND(m.xx,m.xy)
ENDIF
***********************************************************************
*         L.L Pridana pre slovensku verziu                            *
***********************************************************************
***L.L




*!*********************************************************************
*!      Function ROUND50
*!      zaokrouhluje pri prepocte medzi skk a eur
*!*********************************************************************
FUNCTION round50
PARAMETERS p_cislo, typ_zaok, m.p_mist
*typ_zaok=1 - Sk,Kc - 50halierniky
*typ_zaok=2 - EUR - 2desatinne miesta, po 4 dole, od 5 vratane hore
*typ_zaok=3 - EUR - 2desatinne miesta matematicky
*typ_zaok=4 - EUR - 3desatinne miesta, po 4 dole, od 5 vratane hore
IF PARAMETERS()<3
	m.p_mist=1
ENDIF
DO CASE
	CASE m.typ_zaok=1
		PRIVATE p_pom
		m.frac = ABS(m.p_cislo) - INT(ABS(m.p_cislo))
		DO CASE
			CASE m.p_mist >= 1
				DO CASE
					CASE (m.frac >= 0) .AND. (m.frac < 0.25)
						m.p_pom = SIGN(m.p_cislo)* ABS(INT(m.p_cislo))
					CASE (m.frac >= 0.25) .AND. (m.frac < 0.75)
						m.p_pom = SIGN(m.p_cislo)* ABS(INT(m.p_cislo))+SIGN(m.p_cislo)*0.5
					OTHERWISE
						m.p_pom = SIGN(m.p_cislo)* ABS(INT(m.p_cislo))+SIGN(m.p_cislo)*1.0
				ENDCASE
			OTHERWISE
				m.p_pom = ROUND(m.p_cislo, 0)
		ENDCASE
	CASE  m.typ_zaok=2
		PRIVATE p_pom
		m.p_cislo=m.p_cislo*100
		m.frac = ABS(m.p_cislo) - INT(ABS(m.p_cislo))
		DO CASE
			CASE (m.frac >= 0) .AND. (m.frac < 0.5)
				m.p_pom = SIGN(m.p_cislo)* ABS(INT(m.p_cislo))/100
			OTHERWISE
				m.p_pom = SIGN(m.p_cislo)* (ABS(INT(m.p_cislo))+1)/100
		ENDCASE
	CASE  m.typ_zaok=3
		PRIVATE p_pom
		m.p_pom=ground(m.p_cislo,2)
	CASE  m.typ_zaok=4
		PRIVATE p_pom
		m.p_cislo=m.p_cislo*1000
		m.frac = ABS(m.p_cislo) - INT(ABS(m.p_cislo))
		DO CASE
			CASE (m.frac >= 0) .AND. (m.frac < 0.5)
				m.p_pom = SIGN(m.p_cislo)* ABS(INT(m.p_cislo))/1000
			OTHERWISE
				m.p_pom = SIGN(m.p_cislo)* (ABS(INT(m.p_cislo))+1)/1000
		ENDCASE
ENDCASE
RETURN m.p_pom


*!*********************************************************************
*!      Function EN__MENY
*!*********************************************************************
FUNCTION en__meny
LPARAMETERS em_radek, em_sloupec

IF .NOT. BETWEEN(em_sloupec, 1, 5)
	em_sloupec = 1
ENDIF

IF BETWEEN(em_radek, 1, 2)
	ret_val = en_meny(m.em_radek  , m.em_sloupec)
ELSE
	ret_val = en_meny(m.giakt_mena, m.em_sloupec)
ENDIF
*IF TYPE("ret_val") = "N" .and. m.ret_val # 1
*    DO zurnal_log WITH "OPERA", "EN_MENY", STR(em_radek) + STR(em_sloupec)
*ENDIF
RETURN m.ret_val



*!*********************************************************************
PROCEDURE test_uni_idr
PARAMETERS kde
PRIVATE lastsel, sss,nahmeno
m.nahmeno="G"+SUBSTR(SYS(2015),4)
m.lastsel=SELECT()
SELECT idriadok, COUNT(idriadok) AS ss FROM (m.kde) GROUP BY idriadok INTO CURSOR aaa WHERE idriadok=0
*SELECT idriadok FROM bbb WHERE ss>1 INTO CURSOR aaa
SUM ss TO m.sss FOR ss>1

IF RECCOUNT("aaa")>0
	m.sss=i_max("idriadok "+m.kde,m.sss)
	SCAN ALL
		SELECT (m.kde)
		SCAN FOR idriadok=aaa.idriadok
			*			REPLACE idriadok WITH i_max("idriadok "+m.kde)
			REPLACE idriadok WITH m.sss
			m.sss=m.sss-1
		ENDSCAN
	ENDSCAN
ENDIF
USE IN aaa
*USE IN bbb
SELECT (m.lastsel)

PROCEDURE testuj_uni_idr
PRIVATE lastsel
m.lastsel=SELECT()
*=STRTOFILE(TTOC(DATETIME())+" "+"Zaciatok"+CHR(13)+CHR(10),"m:\casy.txt",1)
TRY
	IF !USED("karty")
		SELECT 0
		USE (m.fn_karty) ALIAS karty
		DO test_uni_idr WITH "karty"
		USE
	ELSE
		DO test_uni_idr WITH "karty"
	ENDIF
CATCH
ENDTRY
*=STRTOFILE(TTOC(DATETIME())+" "+"Karty"+CHR(13)+CHR(10),"m:\casy.txt",1)
TRY
	IF !USED("bourak")
		SELECT 0
		USE (m.fn_bourak) ALIAS bourak
		DO test_uni_idr WITH "bourak"
		USE
	ELSE
		DO test_uni_idr WITH "bourak"
	ENDIF
CATCH
ENDTRY
*=STRTOFILE(TTOC(DATETIME())+" "+"Bourak"+CHR(13)+CHR(10),"m:\casy.txt",1)
TRY
	IF !USED("polozky")
		SELECT 0
		USE (m.fn_polozky) ALIAS polozky
		DO test_uni_idr WITH "polozky"
		USE
	ELSE
		DO test_uni_idr WITH "polozky"
	ENDIF
CATCH
ENDTRY
*=STRTOFILE(TTOC(DATETIME())+" "+"Polozky"+CHR(13)+CHR(10),"m:\casy.txt",1)
TRY
	IF !USED("umisteni")
		SELECT 0
		USE (m.fn_umisteni) ALIAS umisteni
		DO test_uni_idr WITH "umisteni"
		USE
	ELSE
		DO test_uni_idr WITH "umisteni"
	ENDIF
CATCH
ENDTRY
*=STRTOFILE(TTOC(DATETIME())+" "+"Umisteni"+CHR(13)+CHR(10),"m:\casy.txt",1)
TRY
	IF !USED("sklad")
		SELECT 0
		USE (m.fn_sklad) ALIAS sklad
		DO test_uni_idr WITH "sklad"
		USE
	ELSE
		DO test_uni_idr WITH "sklad"
	ENDIF
CATCH
ENDTRY
*=STRTOFILE(TTOC(DATETIME())+" "+"Sklad"+CHR(13)+CHR(10),"m:\casy.txt",1)
SELECT (m.lastsel)


PROCEDURE test2uniidr
PARAMETERS kde
PRIVATE lastsel
m.lastsel=SELECT()
SELECT idriadok, COUNT(idriadok) AS ss FROM (kde) GROUP BY idriadok INTO CURSOR aaa HAVING ss>1
SUM ss TO m.sss FOR ss>1
IF RECCOUNT("aaa")>0
	m.sss=i_max("idriadok "+m.kde,m.sss)
	SCAN ALL
		SELECT (kde)
		SCAN FOR idriadok=aaa.idriadok
			REPLACE idriadok WITH m.sss
			m.sss=m.sss-1
		ENDSCAN
	ENDSCAN
ENDIF
USE IN aaa
SELECT (m.lastsel)

*!*****************************************************************************
PROCEDURE nastavsety
SET COLLATE TO	m.gccollate
SET SYSFORMATS	ON
SET BELL TO		888,1
SET BELL		OFF
SET CARRY		OFF
SET CLOCK		OFF
SET CENTURY		ON
SET CONFIRM		ON
SET ESCAPE		OFF
SET EXACT		OFF
SET MULTILOCKS	ON
SET MEMOWIDTH TO 100
SET TALK		OFF
SET ECHO		OFF
SET SAFETY		OFF
SET DELETED		ON
SET DATE TO		GERMAN
SET EXCLUSIVE	OFF
SET NEAR		ON
SET HOURS TO	24
SET REPROCESS TO AUTO
*set reprocess to 11 seconds
SET CPDIALOG	OFF
SET NULLDISPLAY TO ""
IF ("." $ gcdec_point) .OR. ("TEC" $ UPPER(gcdec_point)) .OR. ("POI" $ UPPER(gcdec_point))
	SET POINT TO "."
ELSE
	SET POINT TO ","
ENDIF




PROCEDURE setpath
*SET PATH TO progs, FORMS, libs, DATA, OTHER, reports, INCLUDE, HELP, bitmaps, xfrx, progs2, special
SET PATH TO progs, libs, OTHER


PROCEDURE prepni_sklad
*IF FOUND()
gcpgm_path   = ALLTRIM(food_dat.pgm_path)
gcrepo_path  = m.gcini_path + "reports\"
gcdat_path  = ALLTRIM(food_dat.dat_path)
gccen_path   = ALLTRIM(food_dat.cen_path)
gcpgm_id     = ALLTRIM(food_dat.ID)
gcpgm        = ALLTRIM(food_dat.pgm)
gcid_zkratka = ALLTRIM(food_dat.id_zkratka)
gcpgm_param  = ALLTRIM(food_dat.pgm_param)
gcsetup_skup = ALLTRIM(food_dat.setup_skup)
gcbour_skup  = food_dat.bour_skup
gcpgmskupina = food_dat.skupina
gcstredskup  = food_dat.stredskup
gczadan_prn  = food_dat.zadan_prn
gcera_cen    = food_dat.era_cen
gic_stredisk = food_dat.c_stredisk
gcprava_skup = food_dat.prava_skup

IF !DIRECTORY(m.gccen_path)
	MKDIR(m.gccen_path)
ENDIF
IF !DIRECTORY(m.gcdat_path)
	MKDIR(m.gcdat_path)
ENDIF
SELECT 0
fn_hh_hlav    = gccen_path + "hh_hlav"
IF !FILE(m.gccen_path+"hh_hlav.dbf")
	DO creafile WITH (m.gccen_path+"hh_hlav")
	USE
ENDIF
fn_hh_druhy    = gccen_path + "hh_druhy"
IF !FILE(m.gccen_path+"hh_druhy.dbf")
	DO creafile WITH (m.gccen_path+"hh_druhy")
	USE
ENDIF
fn_cas_hlav    = gccen_path + "cas_hlav"
IF !FILE(m.gccen_path+"cas_hlav.dbf")
	DO creafile WITH (m.gccen_path+"cas_hlav")
	USE
ENDIF
fn_cas_pol    = gccen_path + "cas_pol"
IF !FILE(m.gccen_path+"cas_pol.dbf")
	DO creafile WITH (m.gccen_path+"cas_pol")
	USE
ENDIF
IF !FILE(m.gccen_path+"limit_hl.dbf")
	DO creafile WITH (m.gccen_path+"limit_hl")
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.gccen_path+"limit_hl.cdx")
		DO opr_index WITH (m.gccen_path+"limit_hl")
	ENDIF
ENDIF
IF !FILE(m.gccen_path+"limitdni.dbf")
	DO creafile WITH (m.gccen_path+"limitdni")
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.gccen_path+"limitdni.cdx")
		DO opr_index WITH (m.gccen_path+"limitdni")
	ENDIF
ENDIF
IF !FILE(m.gccen_path+"limity.dbf")
	DO creafile WITH (m.gccen_path+"limity")
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.gccen_path+"limity.cdx")
		DO opr_index WITH (m.gccen_path+"limity")
	ENDIF
ENDIF
fn_eany     = gccen_path + "eany"
IF !FILE(m.fn_eany+".dbf")
	DO creafile WITH m.fn_eany
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_eany+".cdx")
		DO opr_index WITH m.fn_eany
	ENDIF
ENDIF
fn_karty     = gccen_path + "karty"
IF !FILE(m.fn_karty+".dbf")
	DO creafile WITH m.fn_karty
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_karty+".cdx")
		DO opr_index WITH m.fn_karty
	ENDIF
ENDIF
fn_skupiny   = gccen_path + "skupiny"
IF !FILE(m.fn_skupiny+".dbf")
	DO creafile WITH m.fn_skupiny
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_skupiny+".cdx")
		DO opr_index WITH m.fn_skupiny
	ENDIF
ENDIF
fn_bourak    = gccen_path + "bourak"
IF !FILE(m.fn_bourak+".dbf")
	DO creafile WITH m.fn_bourak
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_bourak+".cdx")
		DO opr_index WITH m.fn_bourak
	ENDIF
ENDIF
fn_umisteni  = gccen_path + "umisteni"
IF !FILE(m.fn_umisteni+".dbf")
	DO creafile WITH m.fn_umisteni
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_umisteni+".cdx")
		DO opr_index WITH m.fn_umisteni
	ENDIF
ENDIF
fn_partneri  = gccen_path + "partneri"
IF !FILE(m.fn_partneri+".dbf")
	DO creafile WITH m.fn_partneri
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_partneri+".cdx")
		DO opr_index WITH m.fn_partneri
	ENDIF
ENDIF
fn_polozky   = gccen_path + "polozky"
IF !FILE(m.fn_polozky+".dbf")
	DO creafile WITH m.fn_polozky
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_polozky+".cdx")
		DO opr_index WITH m.fn_polozky
	ENDIF
ENDIF
fn_sklad     = gcdat_path + "sklad"
IF !FILE(m.fn_sklad+".dbf")
	DO creafile WITH m.fn_sklad
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sklad+".cdx")
		DO opr_index WITH m.fn_sklad
	ENDIF
ENDIF
fn_doklady   = gcdat_path + "doklady"
IF !FILE(m.fn_doklady+".dbf")
	DO creafile WITH m.fn_doklady
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_doklady+".cdx")
		DO opr_index WITH m.fn_doklady
	ENDIF
ENDIF
fn_obraty    = gcdat_path + "obraty"
IF !FILE(m.fn_obraty+".dbf")
	DO creafile WITH m.fn_obraty
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_obraty+".cdx")
		DO opr_index WITH m.fn_obraty
	ENDIF
ENDIF
fn_dokl_a    = gcdat_path + "dokl_a"
IF !FILE(m.fn_dokl_a+".dbf")
	DO creafile WITH m.fn_dokl_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_dokl_a+".cdx")
		DO opr_index WITH m.fn_dokl_a
	ENDIF
ENDIF
fn_obra_a    = gcdat_path + "obra_a"
IF !FILE(m.fn_obra_a+".dbf")
	DO creafile WITH m.fn_obra_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_obra_a+".cdx")
		DO opr_index WITH m.fn_obra_a
	ENDIF
ENDIF
fn_dokl_sto  = gcdat_path + "dokl_sto"
IF !FILE(m.fn_dokl_sto+".dbf")
	DO creafile WITH m.fn_dokl_sto
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_dokl_sto+".cdx")
		DO opr_index WITH m.fn_dokl_sto
	ENDIF
ENDIF
fn_obra_sto  = gcdat_path + "obra_sto"
IF !FILE(m.fn_obra_sto+".dbf")
	DO creafile WITH m.fn_obra_sto
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_obra_sto+".cdx")
		DO opr_index WITH m.fn_obra_sto
	ENDIF
ENDIF
fn_davky     = gccen_path + "davky"
IF !FILE(m.fn_davky+".dbf")
	DO creafile WITH m.fn_davky
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_davky+".cdx")
		DO opr_index WITH m.fn_davky
	ENDIF
ENDIF
fn_dluhy     = gcdat_path + "dluhy"
IF !FILE(m.fn_dluhy+".dbf")
	DO creafile WITH m.fn_dluhy
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_dluhy+".cdx")
		DO opr_index WITH m.fn_dluhy
	ENDIF
ENDIF
fn_uzav      = gcdat_path + "uzaverka"
IF !FILE(m.fn_uzav+".dbf")
	DO creafile WITH m.fn_uzav
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_uzav+".cdx")
		DO opr_index WITH m.fn_uzav
	ENDIF
ENDIF
fn_parovaky  = gcdat_path + "parovaky"
IF !FILE(m.fn_parovaky+".dbf")
	DO creafile WITH m.fn_parovaky
	DO indexuj IN indexy
	USE
ENDIF
fn_uctobd  = gchom_path + "uctobd"
IF !FILE(m.fn_uctobd+".dbf")
	DO creafile WITH m.fn_uctobd
ENDIF

fn_vahinv    = gccen_path + "vahinv"

fn_dokl_s    = m.fn_doklady    && tyhle 2 promenne se pouzivaji v sestavach, resi se jimi prepinani archivu
fn_obra_s    = m.fn_obraty

fn_sk_sez    = gccen_path + "sk_sez"
IF !FILE(m.fn_sk_sez+".dbf")
	DO creafile WITH m.fn_sk_sez
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_sez+".cdx")
		DO opr_index WITH m.fn_sk_sez
	ENDIF
ENDIF
fn_sk_pol    = gccen_path + "sk_pol"
IF !FILE(m.fn_sk_pol+".dbf")
	DO creafile WITH m.fn_sk_pol
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_pol+".cdx")
		DO opr_index WITH m.fn_sk_pol
	ENDIF
ENDIF
fn_sk_fin    = gccen_path + "sk_fin"
IF !FILE(m.fn_sk_fin+".dbf")
	DO creafile WITH m.fn_sk_fin
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_fin+".cdx")
		DO opr_index WITH m.fn_sk_fin
	ENDIF
ENDIF
fn_sk_plt    = gccen_path + "sk_plt"
IF !FILE(m.fn_sk_plt+".dbf")
	DO creafile WITH m.fn_sk_plt
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_plt+".cdx")
		DO opr_index WITH m.fn_sk_plt
	ENDIF
ENDIF
fn_sk_txt    = gccen_path + "sk_txt"
IF !FILE(m.fn_sk_txt+".dbf")
	DO creafile WITH m.fn_sk_txt
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_txt+".cdx")
		DO opr_index WITH m.fn_sk_txt
	ENDIF
ENDIF

fn_sk_sez_a  = gccen_path + "sk_sez_a"
IF !FILE(m.fn_sk_sez_a+".dbf")
	DO creafile WITH m.fn_sk_sez_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_sez_a+".cdx")
		DO opr_index WITH m.fn_sk_sez_a
	ENDIF
ENDIF
fn_sk_pol_a  = gccen_path + "sk_pol_a"
IF !FILE(m.fn_sk_pol_a+".dbf")
	DO creafile WITH m.fn_sk_pol_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_pol_a+".cdx")
		DO opr_index WITH m.fn_sk_pol_a
	ENDIF
ENDIF
fn_sk_fin_a  = gccen_path + "sk_fin_a"
IF !FILE(m.fn_sk_fin_a+".dbf")
	DO creafile WITH m.fn_sk_fin_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_fin_a+".cdx")
		DO opr_index WITH m.fn_sk_fin_a
	ENDIF
ENDIF
fn_sk_plt_a  = gccen_path + "sk_plt_a"
IF !FILE(m.fn_sk_plt_a+".dbf")
	DO creafile WITH m.fn_sk_plt_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_plt_a+".cdx")
		DO opr_index WITH m.fn_sk_plt_a
	ENDIF
ENDIF
fn_sk_txt_a  = gccen_path + "sk_txt_a"
IF !FILE(m.fn_sk_txt_a+".dbf")
	DO creafile WITH m.fn_sk_txt_a
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_sk_txt_a+".cdx")
		DO opr_index WITH m.fn_sk_txt_a
	ENDIF
ENDIF

fn_umdruhy     = gccen_path + "umdruhy"
IF !FILE(m.fn_umdruhy+".dbf")
	DO creafile WITH m.fn_umdruhy
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_umdruhy+".cdx")
		DO opr_index WITH m.fn_umdruhy
	ENDIF
ENDIF

fn_spotrebnadan = gccen_path + "spdan"
IF !FILE(m.fn_spotrebnadan+".dbf")
	DO creafile WITH m.fn_spotrebnadan
	DO indexuj IN indexy
	USE
ELSE
	IF !FILE(m.fn_spotrebnadan+".cdx")
		DO opr_index WITH m.fn_spotrebnadan
	ENDIF
ENDIF

fn_objednan  = gchom_path + "objednan"
fn_jidelak   = gchom_path + "jidelak"
fn_users     = gchom_path + "users"


gcid_klapky = food_dat.id_klapky
IF EMPT(gcid_klapky)
	gcid_klapky = m.gcpgm_id
ENDIF

STORE "NIC" TO operace, operace_txt, d1_txt, d1_dat_dokl, d2_txt, d2_dat_dokl

PROCEDURE opr_index
PARAMETERS naopravu
PRIVATE olderror
m.olderror=ON("error")
ON ERROR USE (m.naopravu) EXCLU
USE (m.naopravu) EXCLUSIVE
DO indexuj IN indexy
USE
ON ERROR &olderror
