DbCreate(File,Name,Code)               ; * Создание файла формата dBASE III *
 N prt,dev,lentit,lenrec
 ; File - имя файла
 ; Name - имя стркутурного глобала
 ; Code - имя кодовой страницы
 s:$g(Code)="" Code="cp866"
 S dev=$I
 S prt=$$FOpen^ASYS(File)
 D USE^ASYS3(dev)
 Q:prt=""  0 
 D DATA
 D USE^ASYS3(prt)
 D TITLE
 D WFLDS
 D USE^ASYS3(dev)
 C prt
 Q  1 
WFLDS                                  ; записать данные ополях
 N i
 S i=""
 F  S i=$O(@Name@(i)) Q:i=""  D WFLD
 D W($C($ZH("0D")))
 Q
WFLD                                   ;    записать поле
 N var
 S var=@Name@(i,"Fld")
 D W(var, 11 )
 S var=$G(@Name@(i,"Typ"),"C")
 D W(var)
 ; ? адрес данных поля в памяти
 D W(, 4 )
 S var=@Name@(i,"Len")
 S var=$$NSym(var)
 D W(var)
 S var=$G(@Name@(i,"Dec"), 0 )
 S var=$$NSym(var)
 D W(var)
 D W(, 14 )
 Q
DATA                                   ; сбор данных о структуре
 N i
 S i=$O(@Name@(""),- 1 )
 S lentit= 32 *(i+ 1 )+ 1 
 S lenrec= 0 
 S i=""
 F  S i=$O(@Name@(i)) Q:i=""  S lenrec=lenrec+@Name@(i,"Len")
 S lenrec=lenrec+ 1 
 Q
TITLE                                  ; титульные данные
 N dat,var
 S dat=$$Date^zfunc(, 1 )
 D W($C($ZH("03")))
 S var=$$ConvData^zfunc(dat)
 S var=$$DateSym(var)
 D W(var, 3 )
 D W(, 4 )
 S var=$$NSym(lentit)
 D W(var, 2 )
 S var=$$NSym(lenrec)
 D W(var, 2 )
 D W(, 17 )
 s val=$$Code
 D W(val)
 D W(, 2 )
 Q
W(Str,Len,Sym)                         ; записать данные
 S Str=$G(Str)
 S Len=$G(Len,$L(Str))
 S Sym=$G(Sym,$C( 0 ))
 W $$PadR^zfunc(Str,Len,Sym)
 Q
Code()                                 ; * Код кодовой страницы *
 q:Code="CP866" $c( 101 )
 q:Code="WINDOWS-1251" $c( 32 )
 q " "