go top
do while not eof()
scrC=subdat1(pok.twd,sgr.rgr)
IF NOT empty(scrC)
typeC=substr(scrC,1,1)
sc1N=at('(',scrC)
sc2N=at(')',scrC)
zpN=at(',',scrC)
IF zpN=0
lenN=val(substr(scrC,sc1N+1,sc2N-sc1N-1))
decN=0
ELSE
lenN=val(substr(scrC,sc1N+1,zpN-sc1N-1))
decN=val(substr(scrC,zpN+1,sc2N-zpN-1)) ENDIF
ELSE
IF pok.td='U'
typeC=substr(pok.td1,sgr.rgr,1)
ELSE
typeC=pok.td
ENDIF
DO CASE
CASE typeC='C'
lenN=15
decN=0
CASE typeC='D'
lenN=8
decN=0
OTHERWISE
typeC='N'
lenN=15
decN=3
ENDCASE
ENDIF
if pok.td=='U'
if len(alltrim(pok.td1))>=SGR.RGR
TypeC=substr(pok.td1,SGR.RGR,1)
else
TypeC='N'
endif
else
TypeC=pok.td
endif
YKodN=POK.YKOD
KodPN=POK.KODP
KodSC=strtran(POK.KODS,':','')
KodGN=SGR.KODGR
RGRN=SGR.RGR
GNIN=iif(SGR.GNI=1,1,0)
TxtPokC='П'
TxtPokC=TxtPokC+iif(KodPN>=10,str(KodPN,2),'0'+str(KodPN,1))
TxtPokC=TxtPokC+replicate('0',5-len(alltrim(KodSC)))+alltrim(KodSC)
TxtPokC=TxtPokC+iif(KodGN>=10,str(KodGN,2),'0'+str(KodGN,1))
FieldNameC=DocList.KODF+alltrim(str(YKodN,3))+'_'+alltrim(str(RGRN,2))
select ExpDcPok
append blank
replace KODF with DocList.KODF, ;
WDATA with DocList.WDATA, ;
TxtPok with TxtPokC, ;
FieldName with FieldNameC, ;
type WITH typeC, ;
len WITH lenN, ;
dec WITH decN
select SGR
skip
enddo
endif
select POK
skip
enddo
USE IN pok
endif
&&-----------------------------------------------------------------
aPath=alltrim(upper(bPath))
if right(aPath,1)<>'\'
aPath=aPath+'\'
endif
aDrv=left(aPath,1)
if !cdrv(aDrv)
if aDrv='A' .or. aDrv='B'
do while !cdrv(aDrv)
if MESSAGEBOX('Вставьте диск в дисковод '+aDrv+':',64+1)<>1
RETURN .F.
endif
enddo
else
MESSAGEBOX('Диск '+aDrv+': не существует.', 16)
RETURN .F.
endif
endif
isOkPath=.t.
PRIVATE olderrC
olderrC=ON('ERROR')
on error isOkPath=.f.
SetDefault(aPath) &&&&set default to &aPath
ON ERROR &olderrC
SetDefault(root_dir) &&&&set default to &root_dir
if !isOkPath
MESSAGEBOX('Неправильный путь к файлу.', 16)
RETURN .F.
endif
&& формирование текстового файла
wait window nowait 'Идет подготовка файла'
define window wtxt from 24,79 to 24,79 none
activate window wtxt noshow
set alternate to (old_vtemp+aFileName)
set alternate on
set console off
?? 'ИдФайл:'+alltrim(sIdOtp)
? 'ТипИнф:'+alltrim(sType)
? 'НаимОтпрЮл:'+alltrim(sDan)
? 'ТелОтпр:'+alltrim(sTel)
? 'ДолжнОтпр:'+alltrim(sDol)
? 'ФИООтпр:'+alltrim(sFIO)
? 'КолДок:1'
? 'ВерсПрог:'+alltrim(sVer)
? '@@@'
? 'ИдДок:'+alltrim(sIdDoc)
isOkAll=.f.
do AddDoc
? '@@@'
? '==='
release window wtxt
set alternate to
set console on
wait clear
if !isOkAll
MESSAGEBOX('Нет передаваемых показателей во всех передаваемых документах. Копируемый файл не создан', 16)
else
wait window nowait 'Выполняется копирование файла'
DO WinToDos IN _bin+'oninit.prg' WITH old_vtemp+aFileName, aPath+aFileName
wait clear
messagebox('Выгрузка завершена.', 64)
endif
clear read
SELECT 0
USE (_bases+'NOMFILE')
LOCATE FOR year=_sysYearN
REPLACE nomfile WITH nomfile+1
USE
return .t.
&&-----------------------------------------------------------------
procedure AddDoc
select DocList
go topdo while not eof()
wait wind nowait 'Идет подготовка данных'
select ExpDcPok
set filter to KODF=DocList.KODF and WDATA=DocList.WDATA
count to PkCntN
if PkCntN>0
isOkAll=.t.
do AddDoc01
else
MESSAGEBOX('Документ: '+DocList.NAIM + CHR(13) +;
'Уточнение: '+iif(val(DocList.UT)=0,'Основной расчет',DocList.UT+' уточнение')+;
'Нет передаваемых показателей. Документ будет пропущен.',64)
endif select DocList
skip
enddo
wait clear
return