DOC TO DOC

Материал из Фабиус wiki
Версия от 09:46, 28 сентября 2017; Hisava (обсуждение | вклад) (Текст)

(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

DOC_TO_DOC - это программа из справочника R266

Копирование первого этажа любого документа

DOC_TO_DOC( kinddoc, data, flt, lvlnum )

kinddoc - тип документа из справочника R169

data - дата, для определения месяца, за который переносятся документы

flt - дополнительный фильтр для sql - запроса

Текст

parameters kinddoc, data, flt, lvlnum, ip

// Протокол переноса документов из УУ в НУ
FILL_U_N( kinddoc )

local path, ocd1, del, aa, fld, i, sql, msg, lvl

if Empty( lvlnum )
  lvl := '1'
else
  lvl := lvlnum
endif

if !Empty( flt )
  flt := ' and ' + flt
else
  flt := 
endif

fld := {}
path := '\\FABIUS\FABIUS\OPDATA'

if Empty( ip )
  del := [ KINDDOC = '] + kinddoc + [' and LVLNUM = '] + lvl + [' ]
else
  del := [ KINDDOC = '] + kinddoc + [' and LVLNUM = '] + lvl + [' and KSHIFT >= '] + ip[1] + [1' and KSHIFT <= '] + ip[2] + [1' ]
endif

ocd1 := OpenChildDoc( kinddoc, lvl, ~ParentForm := "", ~IsCondition := false, ~Month := Month( data ), ~Year := Year( data )  )
( ocd1 )->( SetFilter( del ) )
( ocd1 )->( Refresh() )

aa := ( ocd1 )->( DbStruct() )
if !IsEmpty( aa )
  for i := 6 to len( aa )
    Aadd( fld, aa[i,1] )
  next
endif

sql := [ Select ]
if !Empty( fld )
  for i := 1 to len( fld )
    sql := sql + fld[i] + [, ]
  next
endif
sql := Left( sql, len( sql ) - 2 )
sql := StrTran( sql, [ SUM,], [ "SUM",] )
sql := sql + [ From DOCS] + Ret_f_ext( data ) + [ ;
  Where ] + del + flt

if !Empty( ip )
 sql := sql + [ and KSHIFT between '] + ip[1] + [1' and '] + ip[2] + [1' ]
endif

try
  msg := WaitMsg( 'Выполняется перенос документов' + Chr( 10 ) + kinddoc + ' ' + RealName( 'R169', kinddoc ) )
  aa := SelectSqlToArr( sql, fld, path, false, false )
  if !IsEmpty( aa )
    AddAll( kinddoc, lvl, " ",, fld, aa,,,, Year( data ), Month( data ),,, false,, del, { false, false, false, false, false } )
  endif
finally
  HideMsg( msg )
end

Смотрите также

Полезные функции

Функции Delphi