// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.



#define _DEFAULT_PAROL '~`~`~`~`~`'
/*************************************************************/
/* Формирование справочника                                  */
/*************************************************************/
#include "s_refer.ch"
#include "s_public.ch"
#include "inkey.ch"
#include "my.ch"
#include "analit.ch"

STATIC aListGrupSchet := {}

// Для выравнивания аналитики - блок кода
#DEFINE  BlockAn(n)  NIL  //{|x| IF(x != NIL,aIn[n] := Global_Analit(x),aIn[n]) }

// Количество разделителей в шаблоне сумм
FUNCTION SummaZap( nDec, nLen )
RETURN( INT( (nLen-IF( nDec>0, 4, 3) )/3 ) )

FUNCTION NoDecSumm( nSumm, nDec, nLen )
RETURN(REMRIGHT(REMRIGHT(ALLTRIM( STR( nSumm, nLen, nDec) ), '0' ), '.' ))

FUNCTION SayTran( xVar, cPic )
  LOCAL cRez
  IF EMPTY(xVar)
    cRez := SPACE( LEN( TRANSFORM(SPACE(100),cPic) ) )
  ELSE
    cRez := TRANSFORM( xVar, cPic )
  ENDIF
RETURN( cRez )

// Формирование шаблона для вывода сумм
FUNCTION SummaPic( nDec, nLen, lRazd )
  LOCAL cFormat := '', nZ
  IF( ValType(nLen)<>'N',nLen:= _SUMMA_LEN, )
  IF( ValType(lRazd)<>'L',lRazd:=.F., )
  IF( nDec>0, nDec+=1, )
  IF lRazd
    FOR nZ = 1 TO INT((nLen-nDec)/3+0.9)
      cFormat = ',999'+cFormat
    NEXT
    cFormat = PADL(REMLEFT(RIGHT(cFormat,nLen-nDec),","),nLen-nDec,"9")
  ENDIF
RETURN (  PADL( cFormat+PADR( '.',nDec  ,'9' ), nLen, '9' ) )


PROCEDURE SetPublic(cTask)
IF TYPE('cProPath') <> 'C'
  PUBLIC cProPath := 'PRO\', cExePath := 'CMOD\'
  PUBLIC c_My_Code  := _DEFAULT_PAROL       // пароль доступа к базам
ENDIF
PUBLIC INST_COLOR := ISCOLOR(), ; // Цветной монитор
       INST_PAROL := "",        ; // Пароль Администратора
       INST_CFG   := "",        ; // Конфигурация поставки
       INST_DATE,               ; //
       GlobalDemo,              ; //
       lIsGlobValuta := .T.,    ; // валютный вариант
       GlobalValuta  := "РУБ"     // Основная валюта

PUBLIC lNewFirm := .F.

PUBLIC GlobalTask:= IF(ValType(cTask)=='C',cTask,'00'),;         // Номер задачи
       aPublicColors,;
       GlobalTmpPath := ''       // Путь к директории временных файлов

PUBLIC HelpFile:='', Help_Code:='00'

PUBLIC CURR_DATA :=DATE()     , ; //
       CURR_A_BEG:=BOM(DATE()), ; // Начало активного периода
       CURR_A_END:=EOY(DATE()), ; // Конец активного периода
       CURR_BEG  :=BOY(DATE()), ; // начало расчетного периода
       CURR_END  :=DATE(),      ; //
       CURR_BREAK:= .F.  ,      ; // Признак аварийного завершения
       CURR_MAIN :=  2   ,      ; // Значность основной валюты
       CURR_PROJE   :=  .F.,    ; // Номер проекта вводится?
       CURR_CURS    :=  .T.,    ; // Курс по ЦБ ?
       CURR_BCURS   :=  'Curs*Multy', ; // Расчет курса
       CURR_KARB    :=  1,      ; // Множитель для глобальной валюты
       CURR_ZAP     :=  .T.,    ; // Выводить суммы с разделителем
       CURR_PROF    := DATE(),;     // Дата последней пеpеиндексации в сети
       CURR_MDATA   := CTOD("  /  /  "),;  // Максимально возможная дата
       CURR_LDATA   := CTOD("  /  /  "),;  // Минимально возможная дата
       CURR_DTIME   := .F.,;              // Возможность вывода системной даты и времени при печати
       CURR_FTIME   := PADR("  Дата : "+CHR(38)+"DATE  Время :  "+CHR(38)+"TIME "+CHR(38)+"CTLF "+CHR(38)+"CTLF",50),;  // Формат вывода системной даты и времени при печати
       Global_BCURS   :=  {|Curs,Multy| Curs*Multy}, ; // Расчет курса
       Global_BVSUMMA :=  {|Curs,Multy,Sum| BS_ROUND(Curs*Multy*Sum,CURR_MAIN)},; // расчет валюты
       Global_Analit  := { 0, .F., ' ' },;
       WAIT_OPEN      := 0,;  // Задержка перед открытием
       Global_Set     := _GLOB_SET_DEF  // ГЛОБАЛЬНЫЕ НАСТРОЙКИ
/*
                  0 - { |x| x }                      Без выравнивания,
                  1 - { |x| PADR( ALLTRIM( x ), 6, ' '  ) }  В лево,
                  2 - { |x| PADL( ALLTRIM( x ), 6, ' ' ) }  В право

                 .T. - Есть короткое название
                 .F. - Нет

                 ' ' - Заполнитель
*/

PUBLIC PRN0_TYPE   :='1',;
       PRN0_WIDTH  :=80,;
       PRN0_WTYPE  :='1',;
       PRN0_PAPER  :=.T.,;
       PRN0_STR    := 58,;
       PRN0_PROBROS:=.F.,;
       PRN0_PAUSE  :=.T.,;
       PRN0_DEVICE := "LPT1",;
       PRN0_PSEVDO := .T.,;
       PRN0_E_YES  := .F.,;
       PRN0_E_PATH := '',;
       PRN0_E_FILE := '',;
       PRN0_FONT   := '',;
       PRN0_HEAD := '0',;
       PRN0_NUMSTR := .F.,;
       PRN0_BEGSTR := 1,;
       PRN0_LCODE := .F.,;
       PRN0_BCODE := "",;
       PRN0_ECODE := "",;
       PRN0_LSUM := .F.,;
       PRN0_TNAME := SPACE(50),;   // Изменение 3.30
       PRN0_PTYPE := 0,;   // Изменение 3.60
       PRN0_TDEVICE := "COM1",;
       PRN0_TVIEW := .F.,;
       PRN0_TNAST := .T.,;
       PRN0_TFILE := PADR("TERMO.STR",70),;
       PRN0_TERROR := .T.,;
       PRN0_TCOPY  := 1,;
       PRN0_TCODE  := {"      ","      "},;
       PRN0_TSHAB  := .F.,;
       PRN0_TWIN   := .F.,;
       PRN0_WIN    := .F.,;
       PRN0_ORINT  := '0',;   // Ориентация бумаги
       PRN0_OTSTUP := 0,  ;     // Отступ сверху
       PRN0_BEST_PRINT := ''  // Путь к БЭСТ принт серверу
Public PRN0_WIN_PRINT  := if('SCLADR'$ExeName().or.'ZAPASR'$ExeName(),1,0) 
Public PRN0_WPRINTER   := Space(254)

PUBLIC ;
       LBL_INDEKS:= '', ;
       LBL_NAME  := '', ;
       LBL_BOSS  := '', ;
       LBL_BOSS2 := '', ;
       LBL_SHEF  := '', ;
       LBL_SHEF2 := '', ;
       LBL_ADRES := '', ;
       LBL_ADRESF := '', ;
       LBL_TEL   := '', ;
       LBL_TEL2   := '', ;
       LBL_FAX   := '', ;
       LBL_POZ   := 1 , ;
       LBL_CODE  := '', ;
       LBL_OPER  := '', ;
       LBL_OKPO  := '',;
       LBL_WPPATH := '',;
       LBL_ORGNAME:= '',;
       LBL_BANK   := '',;
       LBL_RECV   := '',;
       LBL_BNKKOD := '',;
       LBL_RSCHET := '',;
       LBL_CORR   := '',;
       LBL_INNKPP := ''


Public Type_Filter := Space(10) 
RETURN


/*************************************************************/
/* Формирование справочника валют
/*************************************************************/
//                          1       2        3           4          5
PROCEDURE MakeValutaRefer(cRefer, cDest, nTypeRefer, cACCURACY, lFiltMain)
/*
  cRefer      - имя рефера
  cDest       - куда писать код валюты (строка с переменной)
  nTypeRefer  - тип справочника
  cACCURACY   - имя поля, куда помещать точность (из поля ACCURACY)
[ lFiltMain ] - признак фильтрации основной валюты (NEW!)
               (чтобы не делать валютные документы в рублях),
               по умолчанию .F. (ничего не фильтруется)
*/
LOCAL aAccuracy := {{0,"До целых   "},{1,"До десятых "},{2,"До сотых   "},{3,"До тысячных"}}
LOCAL aDest := {cDest}
LOCAL aSource := {'CODE'}
LOCAL cFilter
LOCAL bPostDisp, bDispSpr

If !(VALTYPE(cRefer)=="C")
  cRefer:="RefV"
EndIf
If !(VALTYPE(nTypeRefer)=="N")
  nTypeRefer:=1
EndIf
If VALTYPE(cACCURACY) == 'C'
  AADD(aDest, cACCURACY)
  AADD(aSource, 'ACCURACY')
EndIf
If !(VALTYPE(lFiltMain)=='L')
  lFiltMain:=.F.
EndIf

If lFiltMain
  bDispSpr :={|| cFilter:=DBFilter(), DBSETFILTER({|| !(FIELD->CODE==GlobalValuta)}, '!(FIELD->CODE==GlobalValuta)')}
  bPostDisp:={|| If(EMPTY(cFilter), DbClearFilter(), DBSetFilter(&("{|| "+cFilter+"}"), cFilter))}
EndIf
MakeRefer(cRefer, 'Справочник валют', nTypeRefer,; // 3
          {'Код','Наименование'}, {3,35,15},     ; // 5
          COL_REFER, aSource, aDest, 'UPPER('+cDest+')',;  // 9
          {FIELDBLOCK('CODE'),FIELDBLOCK('NAME')},      ;  // 10
          {{'','Код валюты?','CODE','TRIM(UPPER(aIn[1]))',Global_Set[1]+'XXX','!EMPTY(aIn[1])'}},; // 11
          If(nTypeRefer != 3.AND.!(GlobalTask$'SRZR') ,;
              {;
              {'Код..........................: ','CODE'},                                   ;
              {'Наименование.................: ','NAME'},;
              {'Точность представления.......: ','ACCURACY'},;
              {'Множитель для курса..........: ','MYLTIPLY'},;
              {'Написание основных  сумм - 1.: ','MM1'},;
              {'Написание разменных сумм - 1.: ','MC1'},;
              {'Написание основных  сумм - 3.: ','MM2'},;
              {'Написание разменных сумм - 3.: ','MC2'},;
              {'Написание основных  сумм - 5.: ','MM3'},;
              {'Написание разменных сумм - 5.: ','MC3'},;
              {'Код валюты по ISO............: ','MCODE'};
              },;
              NIL;
              ),;  // 12
            {,,,"999999.9999999"},; // 13
            ,{{||!EMPTY(aIn[1])},{||!EMPTY(aIn[2])}},; // 15
            ,,bPostDisp,; // 18
            ,,{,,{|oGet| RotateAndReader(oGet,aAccuracy)}},; // 21
            " F2:Справочник кодов валют ",;  // 22
            ,,,{,,{|x| RotateBlock(x,aAccuracy,"aIn[3]")}},; // 26
            ,,,,bDispSpr,; // 31
            ,,,," F2:Справочник кодов валют " ;  // 36
          )
RETURN


//
/*************************************************************/
/* Формирование справочника                                  */
/*************************************************************/
// Пример
// aDestSourse    =>     {{'nGrup','GRUP_SCHET'}}
PROCEDURE MakeSchetRefer( /*  1 */ cRefer,      /*  2 */ cDest,       ;
                          /*  3 */ nTypeRefer,  /*  4 */ bPreDisp,    ;
                          /*  5 */ bPostDisp,   /*  6 */ cHelp,       ;
                          /*  7 */ cHead,       /*  8 */ bColor,      ;
                          /*  9 */ cValutDest,  /* 10 */ cTypeSchet,  ;
                          /* 11 */ bYesArray,   /* 12 */ aDopHead,    ;
                          /* 13 */ aDestSourse, /* 14 */ cVidUch,     ;
                          /* 15 */ nLenName;
                        )
  //nTypeRefer=1-обязательный ввод счетов и аналитики при ее наличии
  //nTypeRefer=2-необязательный ввод счетов и аналитики при ее наличии

  // [ nLenName ] - длина наименования счета (по умолчанию 35)

  LOCAL aDest := {cDest},;
        aSourse := { "Schet" },aYXN:={4,37-_LEN_SCHET,11},cKeyaHeads,abFields
  LOCAL bCoProc, cFilter

  cRefer     := IF( ValType(cRefer)=="C",     cRefer,    "Plan" )
  nTypeRefer := IF( ValType(nTypeRefer)=="N", nTypeRefer, 1     )
  bPreDisp   := IF( ValType(bPreDisp)=="B",   bPreDisp,   NIL   )
  bPostDisp  := IF( ValType(bPostDisp)=="B",  bPostDisp,  NIL   )
  cHead:=IF(cHead=NIL,"План счетов",cHead)
  If nLenName==NIL
    nLenName:=35
  EndIf
  If nLenName>35
    aYXN[2] -= nLenName-35
  EndIf

  IF ValType( aDestSourse ) == 'A'
    AEVAL( aDestSourse, {|x| AADD( aDest,   x[1] ), ;
                             AADD( aSourse, x[2] )  ;
                        }                           ;
         )
  ENDIF

  IF VALTYPE(cValutDest) == 'C'
    AADD( aDest, cValutDest )
    AADD( aSourse, "(Valuta=='1')")
  ENDIF

  IF VALTYPE(cTypeSchet) == 'C'
    AADD( aDest, cTypeSchet )
    AADD( aSourse, "TYPE_SCH")
  ENDIF
  IF VALTYPE(cVidUch) == 'C'
    AADD( aDest, cVidUch )
    AADD( aSourse, "NLG_SCHET")
  ENDIF

  cKeyaHeads := { "Счет", "Наименование" }
  abFields   := {{|| LEFT(FIELD->Schet,_LEN_SCHET)}, {|| LEFT(FIELD->Name_Sch,nLenName)}}

  IF ValType( aDopHead ) == 'A'
    AEVAL( aDopHead, {|x| AADD(cKeyaHeads, x[1]),;
                          AADD(abFields, x[2]),;
                          aYXN[2] -= LEN( EVAL(x[2]) ) } )
  ENDIF

  bCoProc:={|| IIF(FIELDPOS("VID_SCHETA")<>0.AND.!EMPTY(FIELD->VID_SCHETA),;
                    (SETPOS(18,34),DISPOUT(" Вид счета: "+FIELD->VID_SCHETA+" ",COL_REFER)),;
                    (SETPOS(18,34),DISPOUT(REPLICATE("─",23),COL_REFER));
                  );
           }
  /*if Global_Set[34]
   if Empty(dbFilter())
    cFilter:= "FIELD->NLG_SCHET<>' Н '"
   else
    cFilter:="("+dbFilter()+") .and. FIELD->NLG_SCHET<>' Н '"
    //SET FILTER TO &cFilter
   endif
  else
   if Empty(dbFilter())
    cFilter:= "FIELD->NLG_SCHET<>' У '"
   else
    cFilter:="("+dbFilter()+") .and. FIELD->NLG_SCHET<>' У '"
    //SET FILTER TO &cFilter
   endif
  endif
  DBSetFilter(&("{|| "+cFilter+"}"), cFilter)*/
  //          1       2        3            4        5
  MakeRefer(cRefer, cHead, nTypeRefer, cKeyaHeads, aYXN,;
            COL_REFER, aSourse, aDest, 'UPPER('+cDest+')', abFields,; // 10
            {{"","Номер счета?:","Schet","TRIM(UPPER(aIn[1]))",;
            Global_Set[1]+_PIC_SCHET,'!EMPTY(aIn[1])'}}, , , , ,;
            ,bPreDisp, bPostDisp,; // 18
            {|| If(FIELD->NLG_SCHET==' Н ' .or. FIELD->NLG_SCHET==' У ', IF(FIELD->STATUS=="1","B+/w","B/w"), If(FIELD->STATUS=='1',"n/w","n+/w"))},,,;
         ;//  22    23
            cHelp, bCoProc,,,,;
         ;//       27
            'cFind$UPPER(NAME_SCH)',,,,,;
         ;//   32
            bYesArray,,,,,,,,,,,,,,;
         ;//       46
            if(GlobalTask<>"00",{|oGet| "#" $ oGet:varGet().OR.EMPTY(oGet:varGet())},NIL),;
            /*'CODE'*/1)//,{||Upper(Plan->Schet)})           //victor заменил на 1, т.к. у меня другое имя тега
/*
  MakeRefer( cRefer, cHead, nTypeRefer,cKeyaHeads, aYXN,;
            COL_REFER, aSourse, aDest, 'UPPER('+cDest+')',abFields,;
            {{"","Номер счета?:","Schet","TRIM(UPPER(aIn[1]))",Global_Set[1]+_PIC_SCHET,'!EMPTY(aIn[1])'}}, , , , ,;
             ,bPreDisp, bPostDisp, , ,; // 20
             ,cHelp,bCoProc, , ,;
             ,'cFind$UPPER(NAME_SCH)', , , ,; // 30
             ,bYesArray, , , ,;
             , , , , ,; // 40
             , , , ,IIF(GlobalTask=="02".OR.GlobalTask=="01",{|oGet|"#" $ oGet:varGet().OR.EMPTY(oGet:varGet())},NIL),;
             1,'CODE',)//{||Upper(Plan->Schet)})
*/
RETURN


/*************************************************************/
/* Формирование справочника                                  */
/*************************************************************/
//                 1        2          3         4      5
FUNCTION SAnalit(cRefer, cVarCode, nTypeRefer, cHelp, NoInput,;
;//                  6           7        8          9
                 cKeyValDisp, bAppend, bMyPreget, aYesValue;
                )
/* параметры
  cRefer      -  Имя справочника ( "RefA" по умолчанию )
  cVarCode    -  имя переменной куда поместить результат
  nTypeRefer  -  тип рефера      ( 1      по умолчанию )
[ aYesValue ] -  если задано, то работает блок кода bYesValue (46-й параметр в MakeRefer()).
                Это массив допустимых значений для поля со справочником (плюс ещё пустое значение).
                Перед сравнением элемента массива со значением поля
               значение поля и допустимое значение обрезается от пробелов с обоих сторон.
 */
LOCAL cKeyaHeads, aYXN, cColor, aSource,   ;
      aDest, cKeyVal, abFields, aSortSeek, aInputHead, aPict,       ;
      aWhen, aValid, bPost, bPreDisp, bPostDisp, bColor,;
      aRef, bCoProc, nRowHelp, nColHelp, aGetBlock, cFindMacro,cHead,;
      bMacro1,bMacro2,bPostRead,bPreGet,;
      aNameSpraw :={},i, nNewPos := 2,;
      nGrup := 0
LOCAL bYesValue

LOCAL lSclad:=GlobalTask$'030905'.AND.TYPE('Ana_')='N'

LOCAL OldSelect := Select()

If Select('NANALIT') == 0 
  M_Open_Base( {{'NANALIT',0 }})
  Select(OldSelect)
EndIf

bPostRead := {|lUpdates,nLastKey| If( nLastKey<>K_ESC.AND.nApp==2, AddGruppSchet( SaveLoadType(), aIn[1], '', '', .F. ),.T.)}
If VALTYPE(aYesValue)=='A'
  bYesValue:={|oGet| fYesValue(aYesValue, oGet:varGet())}
EndIf

If !(VALTYPE(bMyPreget)=='B')
  bMyPreget:={||.T.}
EndIf

cRefer     := If(ValType(cRefer)=="C", cRefer,  "RefA")
cHead      := "Аналит. учет по счету " // Название справочника
nTypeRefer := IF( ValType(nTypeRefer)<>"N", 1, nTypeRefer)            /* Тип справочника          */
cKeyaHeads := {"Код","Наименование"}/* Наименования столбцов    */
aYXN := { 3, 35, 11-_MAX_SPRAW }           /* Координаты               */
cColor := COL_REFER             /*                          */
aSource := { 'CODE' }          /*                          */
aDest   := { cVarCode }      /*                          */
cKeyVal := "UPPER(SaveLoadType()+"+cVarCode+")" /*           */
If EMPTY(cKeyValDisp)
  cKeyValDisp:= "SaveLoadType()"
ENDIF
abFields := { {|| FIELD->CODE },;
              {|| FIELD->NAME } }/*                         */
aSortSeek := {;
              { "- по кодам                ", "Код аналитики.:",         ;
                                "CODE",                        ;
                                "UPPER(SaveLoadType()+RTRIM(aIn[1]))",      ;
                                Global_Set[1]+REPLICATE('X',6) , "((aIn[1]:=Global_Analit(aIn[1]))!=NIL).AND.!EMPTY(aIn[1])", ,1     ;
              },;
              { "- по наименованию         ", "Наименование.:",;
                                        "LEFT(NAME,10)",                               ;
                                        "UPPER(SaveLoadType()+RTRIM(aIn[1]))",      ;
                                        Global_Set[1]+REPLICATE('X',10), "!EMPTY(aIn[1])", ,2            ;
                } ;
                }                  /* Сортировка и Поиск       */

  // Построим временные поиски
/*
{"- по коду  ",{" Код доп. анал.: "},{"NANALIT->CODE"},;
"UPPER('03'+aIn[1])",{"@K"},{,},{,},;
"CODE",,,,,.T.,;
"UPPER(NANALIT->CODE)"};
*/
AADD( aSortSeek,;
{"- по коду доп. аналитики ",{" Код доп. аналитики.: "},{"CODE"},;
"'03'+UPPER(aIn[1])",{"XXXXXX"},{NIL},{NIL},;
"CODE",;
{NIL},;
"NANALIT","OPER_ANAL","STR(NANALIT->OPER_ANAL,17,0)",.T.};
    )
AADD( aSortSeek,;
{"- по наименованию доп. аналитики ",{" Наименование доп. аналитики.: "},{"NAME"},;
"'03'+UPPER(aIn[1])",{"@S20"},{NIL},{NIL},;
"NAMEKEY",;
{NIL},;
"NANALIT","OPER_ANAL","STR(NANALIT->OPER_ANAL,17,0)",.T.};
    )

// Краткое наменование
If Global_Analit[2]
  AADD(cKeyaHeads, 'Краткое имя')
  AADD(abFields, {|| FIELD->KEY})
  aYXN := { 3, 25, 11-_MAX_SPRAW}           /* Координаты               */
  AADD(aSortSeek, { "- по краткому имени       ", "Краткое имя.:",;
                                      "KEY",                               ;
                                      "UPPER(SaveLoadType()+RTRIM(aIn[1]))",      ;
                                      IF(EMPTY(Global_Set[1]),"@!",Global_Set[1]+'!')+REPLICATE('X',15),;
                                      "!EMPTY(aIn[1])", ,3            ;
                  })
EndIf
If NoInput==NIL
    aInputHead := {;
                { "Шифр анал. учета.........:",   "CODE" },;
                { "Наименование анал. учета.:",   "NAME" } ;
              }                 /*                          */
  aGetBlock := {,}
  aRef := { 'Spraw', }
  aPict := {  Global_Set[1]+AnalPict(), Global_Set[1]+REPLICATE('X',25) }
  aValid := { {||aIn[1]:=Global_Analit(aIn[1]),!EMPTY(aIn[1])},;
            {||!EMPTY(aIn[2]) .AND. !EMPTY(SaveLoadType())} } /*                       */
  IF Global_Analit[2]
    AADD( aInputHead, { "Краткое наименование.....:", "KEY" } )
    ASIZE( aGetBlock, 3 )
    ASIZE( aRef,      3 )
    nNewPos++
    AADD( aPict,  IF(EMPTY(Global_Set[1]),"@!",Global_Set[1]+'!')+REPLICATE('X',15) )   /* Шаблоны */
  ENDIF

  FOR i:= 1 TO _MAX_SPRAW
    AADD( aInputHead, { PADR( _NAME_SPRAW,25,'.' )+":", SPACE(_LEN_ANALIT)     } )
    AADD( aGetBlock, {|x,oGet,y/*,y,lDisplay*/|;
                        y := aNameSpraw,;
                        IF(x<>NIL,aIn[oGet:name[3],4]:=x, ),;
                            IF( aNameSpraw[oGet:name[3]-nNewPos,4], ;
                            ( SAYSCREEN( PADR(aNameSpraw[oGet:name[3]-nNewPos,1],25,'.'), oGet:Row, oGet:Col-26),;
                              aNameSpraw[oGet:name[3]-nNewPos,5] )->( dbSEEK( UPPER(aIn[oGet:name[3],4]) ),;
                              SAYSCREEN( PADR(FIELDGET(aNameSpraw[oGet:name[3]-nNewPos,3]),18), oGet:Row, oGet:Col+7),;
                              aIn[oGet:name[3],4];
                            ),(CLEARWIN( oGet:Row, oGet:Col-26,oGet:Row, oGet:Col+23, COL_REF1),;
                  ''));
                            } )
    AADD( aRef, 'SPRAW'+STR(i,1))
    AADD( aPict, REPLICATE( 'X', _LEN_ANALIT ) )
  NEXT

ENDIF


If ValType( bAppend ) == 'B'
  aWhen := { bAppend } /* Предусловие              */
Else
  bPreGet :={|| ;
    AEVAL(aIn, {|x,xi|aIn[xi] := {0,'1','  ',SPACE( _LEN_ANALIT ),0, SPACE(20)}},nNewPos+1, _MAX_SPRAW ),;
              nGrup := NomGrupSchet( SaveLoadType() ),;
              QHelp( ,, 1, ;
                      IF( nGrup <> 0, STR(nGrup,17,0), SaveLoadType())/*+_ANALIT_PREFIKS*/,;
                      "CODE",,,;
                      {|| AppendAnalit( SaveLoadType(), .F.,nNewPos ) }, ;
                      IF( nGrup <> 0, 'GRUP', 'CODE' ),,,,,_ANALIT_PREFIKS;
                    ),;
          EVAL(bMyPreget)}
  aWhen := { {|oGet|!EMPTY(SaveLoadType()) } }     /* Предусловие              */
EndIf
bPost:={||AppendAnalit(SaveLoadType(),.T.,nNewPos)}

bPreDisp  := {|| OpenSpraw(,,,{ SaveRefPos(cRefer)[3], ;
                                SaveRefPos(cRefer)[2]+2,"" },,,,,,,,cRefer,;
                                aNameSpraw, nNewPos, 1 ),;
                  IF(LEN(aNameSpraw)==0,hb_keyput(K_ESC),NIL),;
                  SETKEY(K_ALT_F6,{||FiltName('cFind$UPPER(NAME)',DBFILTER(),ScopeMacro())}),;
                  SETKEY(K_ALT_F12,{||FiltName('cFind$UPPER(NAME)',DBFILTER(),ScopeMacro())}),;
                  SETKEY(K_CTRL_F6,{||QSetFilter(,,"Снять")}),;
                  SetScope( "UPPER(Schet)", SaveLoadType() ) }
bPostDisp := {|| SayDopAnalit(1,EMPTY(NoInput),aNameSpraw,aYXN,Global_Analit[2]),;
                  SetScope(),IF(lSclad,SETKEY(K_ESC,NIL),NIL)}      /*                       */

bCoProc := {|| SayDopAnalit(2, EMPTY(NoInput),aNameSpraw,aYXN,Global_Analit[2]) }

cFindMacro := 'cFind$UPPER(NAME)'

ASIZE(aWhen,     2+IF( Global_Analit[2], 1, 0 ))
FOR i:= 1 TO _MAX_SPRAW
  AADD( aWhen, {|oGet| aNameSpraw[oGet:name[3]-nNewPos,4] } )
NEXT
//          1                      2                       3           4
MakeRefer(cRefer, {|| cHead+TRIM(SaveLoadType())+' '}, nTypeRefer, cKeyaHeads,;
          aYXN, cColor, aSource, aDest, cKeyVal, abFields,; // 10
          aSortSeek, aInputHead, aPict, aWhen, aValid,;    // 15
          bPost, bPreDisp, bPostDisp, bColor, cKeyValDisp,; // 20
          aRef, cHelp, bCoProc, nRowHelp, nColHelp,;        // 25
          aGetBlock, cFindMacro, , , , , , , , ,;
;//         36        38
          bPreGet, ,bPostRead, , , , , , , ,;
;//          46       47
          bYesValue, 'NAME',;
;//                                 48
          {|| If(FIELDPOS('SCHET') != 0, UPPER(FIELD->SCHET),'')})
RETURN .T.

STATIC PROCEDURE SayDopAnalit( nSave, lYesAppend,aNameSpraw, aYXN, lYesName )
  STATIC cSreen := '', cOldOrd
  LOCAL nRow := 20-_MAX_SPRAW, nCol :=aYXN[2]
  LOCAL i, nOper := FIELD->NNOPER,;
        lNotEmpty:=.F., nRight := IF(lYesAppend,42+IF( lYesName, 8,0),34+IF( lYesName, 16,0))

     IF SELECT("PARTNER")<>0
       cOldOrd:=PARTNER->(OrdSetFocus('FULLCODE'))
     ENDIF

  AEVAL( aNameSpraw, {|x| lNotEmpty := lNotEmpty .OR. !EMPTY(x[1])} )

  IF lNotEmpty .AND. SELECT( 'NANALIT' ) > 0
    IF (nSave == 0 .OR. EMPTY(cSreen)) .AND. nSave <> 1
       cSreen := BrSaveScreen(nRow,nCol,nRow+3+_MAX_SPRAW,nCol+nRight+1 )
       ShadowBox("[ Дополнительная аналитика ]",nRow,nCol,nRow+2+_MAX_SPRAW,nCol+nRight-1,COL_REFER,"┌─┐│┘─└│ ")
       SAYSCREEN( ' Справочник   Код   Наименование', nRow+1,nCol+1)
       FOR i := 1 TO _MAX_SPRAW
         SAYSCREEN( PADR(aNameSpraw[i,1],10,'.')+':', nRow+2,nCol+2)
       NEXT
    ENDIF

    IF nSave == 2
       FOR i := 1 TO _MAX_SPRAW
         IF NANALIT->( dbSEEK( STR(nOper,17,0)+STR(i,1) ) ) .AND. ;
                ( aNameSpraw[i,5] )->( dbSEEK( UPPER(NANALIT->(FIELDGET(4)))) )
         SAYSCREEN( PADR( NANALIT->(FIELDGET(4))+' '+;
                          ( aNameSpraw[i,5] )->( FIELDGET(aNameSpraw[i,3]) ),;
                          nRight-15;
                        ), nRow+2,nCol+14)
         ELSE
           SAYSCREEN( SPACE( nRight-15 ), nRow+2,nCol+14)
         ENDIF
       NEXT
    ENDIF

    IF nSave == 1 .AND. !EMPTY(cSreen )
       BrRestScreen(cSreen )
       cSreen := ''
    ENDIF
  ENDIF
     IF SELECT("PARTNER")<>0
       PARTNER->(OrdSetFocus(cOldOrd))
     ENDIF
RETURN

// Принимает номер счета
// Возвращает номер группы
FUNCTION NomGrupSchet( cSchet )
  LOCAL lOpen, nSelect, nGrup := 0
  FIELD GRUP_SCHET

  cSchet := UPPER( cSchet )

  IF EMPTY( aListGrupSchet )
    IF (lOpen:= ( SELECT('PLAN') == 0 )  )
      nSelect := SELECT()
      M_Open_Base( { 'PLAN' } )
    ENDIF

    PLAN->( dbEval( {|| AADD( aListGrupSchet, { UPPER(FIELD->SCHET),GRUP_SCHET } )},;
                    {||!EMPTY(GRUP_SCHET)};
                  );
          )
    IF lOpen ;  PLAN->( dbCloseArea() ) ;    SELECT(nSelect) ;  ENDIF
    IF EMPTY(aListGrupSchet) // для пустого массива сделаем псевдо элемент
      AADD( aListGrupSchet, {'    ', 0 } )
    ENDIF
  ENDIF

  IF (nSelect := ASCAN( aListGrupSchet, {|x| x[1] == cSchet } )) <> 0
    nGrup := aListGrupSchet[ nSelect][ 2 ]
  ENDIF

RETURN( nGrup )

// вернет по ссылке список номеров счетов входящих в группу
PROCEDURE ListGrupSchet( aGrupSchet, cSchet, nGrup )
  LOCAL lOpen := .F., nSelect

  IF (lOpen:= ( SELECT('PLAN') == 0 )  )
    nSelect := SELECT()
    M_Open_Base( { 'PLAN' } )
  ENDIF

  IF !EMPTY( cSchet )
    PLAN->( dbSeek( UPPER(cSchet) ).AND.!EMPTY(FIELD->GRUP_SCHET),nGrup := FIELD->GRUP_SCHET )
  ENDIF
  PLAN->( IF( !EMPTY(nGrup), ;
             ( dbPush(,'GRUP',,{'',STR(nGrup,17,0),,{'GRUP'}}),;
               dbEVAL( {|| AADD( aGrupSchet, UPPER(FIELD->SCHET))},;
                       {|| UPPER(FIELD->SCHET)<>cSchet} ),;
               dbPop();
             ),) )
  IF lOpen
    PLAN->( dbCloseArea() )
    SELECT(nSelect)
  ENDIF
RETURN

// Раскидывание аналитики по группе счетов
FUNCTION AddGruppSchet( cSchet, cCode, cName, cKey, lYesGrupVvod, nOper, nGrup )
LOCAL nRec:= RecNo(), aGrupSchet := {},;
      lNoSeek := .T., i
LOCAL aViewErr:={},lErr:=.F.
LOCAL lOpen := .F., nSelect
FIELD GRUP_SCHET, SCHET

// PVP - для правки типовых операций по 60-м счетам
IF (lOpen:= ( SELECT('PLAN') == 0 )  )
  nSelect := SELECT()
  M_Open_Base( { 'PLAN' } )
  SELECT(nSelect)
ENDIF

// Список счетов в группе
ListGrupSchet( aGrupSchet, @cSchet, @nGrup )
IF lYesGrupVvod
  DBPUSH()
  ORDSETFOCUS("CODE")
  IF nOper==0
    AADD(aViewErr,"Проверьте доп. аналитику в счетах:")
    AEVAL( aGrupSchet, {|x| IIF(PLAN->(DBSEEK(x)).AND.!EMPTY(PLAN->NEW_SPRAW),(AADD(aViewErr,ALLTRIM(x)),lErr:=.T.),NIL) })
    IF lErr
      SayError(aViewErr)
    ENDIF
  ENDIF
  AEVAL( aGrupSchet, {|x| IF( !dbSeek( UPPER(x+cCode) ),;
                              PutNetAdd( {x,cCode, cName, cKey,IIF(PLAN->(DBSEEK(x)).AND.!EMPTY(PLAN->NEW_SPRAW),nOper,0),nGrup} ),;
                            )} )
  DBPOP()
ELSE
  IF !EMPTY(aGrupSchet) .AND. !(lNoSeek := ( (i := ASCAN( aGrupSchet, {|x| dbSeek( UPPER(x+cCode) ) } ) )== 0 ))
    SayError({'Код аналитики уже использован',;
              'на счете: '+aGrupSchet[i]+' данной группы счетов!'})
  ENDIF
ENDIF
dbGoTo( nRec )

// PVP - для правки типовых операций по 60-м счетам
IF lOpen
  PLAN->( dbCloseArea() )
  SELECT(nSelect)
ENDIF
RETURN( lNoSeek )

// Запись уже заблокирована в области ANALIT
// lYesGrupVvod - Групповой ввод возможен при необходимости
STATIC PROCEDURE  AppendAnalit( cSchet, lYesGrupVvod,nNewPos )
  LOCAL aScope := SetScope(), aNewSpraw := {},;
        nOper:=0, i, nGrup:=0
  FIELD NAME, SCHET, GRUP_SCHET, CODE, KEY, NNOPER
  // для всех справочников
  SCHET := cSchet
  IF( EMPTY(NAME), NAME := REPLICATE('1',25), )
  nGrup := NomGrupSchet( cSchet )
  GRUP_SCHET := nGrup  // Запишем в ANALIT номер группировки для поиска
  //altd()
  FOR i := nNewPos+1 TO nNewPos + _MAX_SPRAW
    IF !EMPTY( aIn[i,3] )  // Сформироем вторичный файл
      AADD( aNewSpraw, aIn[i] )
    ENDIF
  NEXT
  IF !EMPTY( aNewSpraw )
    nOper := AnalitStep()
    NANALIT->( AEVAL( aNewSpraw,{|x| x[1]:= nOper,;
                                     x[4] := UPPER(x[4]),;
                                     PutNetAdd(x) } ) )
    NNOPER := nOper
  ENDIF

  // Проверим на необходимость группового ввода аналитики
  // если надо добавим на все счета
  IF lYesGrupVvod
    AddGruppSchet(UPPER(cSchet), CODE, NAME, KEY, lYesGrupVvod, nOper )
  ENDIF

  SetScope(aScope)
RETURN


//
FUNCTION SaveLoadType( cSchet ) // Сохраним номер типа для потомков
  STATIC cStaticSchet := "          "
   IF ValType( cSchet ) == "C"
     cStaticSchet := UPPER(cSchet)
   ENDIF
RETURN( cStaticSchet )


*******************************
* Функция для блока кода bYesValue в SAnalit()
*
STATIC FUNCTION fYesValue(aYesValue, xBuffer)
RETURN EMPTY(xBuffer) .OR. ASCAN(aYesValue, {|x| ALLTRIM(x)==ALLTRIM(xBuffer)})>0


//                    1        2        3        4
FUNCTION OpenSpraw(cSpraw, cMemCode, cMemName, cHelp,;
                   cTypeSpr, cDestName, nTypeRef, bPostDisp,; // 8
                   aSource, aDest, lNoAdd,;                   // 11
                   cRefer, aNameSpraw, nBegin, nCode, lPl )
/*
Параметры:
  cSpraw   - имя справочника
  cMemName - имя Private-переменной, куда записывать при выборе
            из справочника значение, вычисляемое по формуле в cDestName
  cHelp - строка - HELP
          массив - автоматический HELP на рамке
  bPostDisp - для передачи в MakeRefer() - для справочника партнёров не реализован!
*/
  LOCAL nSel:=ALIAS(),nOpen, iJ, cOldOrd
  LOCAL lScope := .F., /*cNamePart := "Партнеры",*/ nType_A/*, aTag, nPoz*/
  LOCAL /*aHeads, aPict, aValid, aWhen, aGetBlock, aRef,*/ aNewSpraw,;
        aBase:={}, i, bPost := {|| FIELD->NNOPER:= _SprawStep() },;
        j,;
        aNewAnal := ;
         {;
          { '01', { 'Подразделения',   'SHORTNAME',0,.T., 'STRUCT' }},;
          { '02', { 'Сотрудники',      'SHORTNAME',0,.T., 'PEOPLE' }},;
          { '03', { 'Партнеры',        'SHORTNAME',0,.T., 'PARTNER'}},;
          { '04', { 'Статьи расходов', 'NAME',     0,.T., 'RASXOD' }} ;
         }
  lPl:=if(lPl==NIL,.t.,lPl)
  IF(ValType(lNoAdd) = "L",,lNoAdd := .F.)
  cMemCode := IF( ValType(cMemCode) = "C" .and. (cTypeSpr != NIL .OR. TYPE(cMemCode) = "C"), cMemCode, "aIn[1]")
  cMemName := IF( ValType(cMemName) = "C" .and. (cTypeSpr != NIL .OR. TYPE(cMemName) = "C"), cMemName, "aIn[2]")
  cSpraw := IF( ValType(cSpraw) = "C", cSpraw, "Spraw")
  If(ValType(nBegin) == "N",, nBegin := 1)
  If(ValType(nCode) == "N",, nCode := 1)

  IF (nOpen:=SELECT('PLAN')) == 0 .AND. cTypeSpr = NIL
    M_Open_Base( { 'PLAN' } )
  ENDIF

  IF cTypeSpr != NIL .OR. PLAN->( dbSEEK( SaveLoadType() ) )

    If(ValType(aNameSpraw) == 'A', ASIZE(aNameSpraw, 0), )

    IF EMPTY( cTypeSpr ) .AND. if(lPl,!EMPTY( PLAN->NEW_SPRAW ),.f.) .AND. ValType(aNameSpraw) == 'A'
        // Для сантехкомплекта
        aNewSpraw := LineToArray(PLAN->NEW_SPRAW,',')
        FOR i := 1 TO LEN( aNewSpraw )
          IF (j := ASCAN( aNewAnal, {|x| x[1] == aNewSpraw[i] } )) <> 0
            IF SELECT( aNewAnal[j,2,5]) == 0
              AADD( aBase, aNewAnal[j,2,5] )
            ENDIF
            AADD( aNameSpraw, aNewAnal[j,2] )
          ENDIF
        NEXT
      IF SELECT('NANALIT') == 0 // Откроем если кому надо
        AADD( aBase, 'NANALIT' )
      ENDIF

     IF SELECT("PARTNER")<>0 .and. (iJ:=aScan(aBase, "PARTNER"))<>0
       aDel(aBase,iJ)
       aSize(aBase,Len(aBase)-1)
     endif
     if !Empty(aBase)
       M_Open_Base( aBase,,,.T. )    // закрывать небудем
     endif

      // Построем справочники
      FOR i := 1 TO LEN( aNewSpraw )
        IF !EMPTY( aNewSpraw[i] )
          ( aNameSpraw[i,5] )-> (;
                 OpenSpraw( 'SPRAW'+STR(i,1), ;
                     "aIn["+STR(i+nBegin,1)+",4]",,;
                     IF(!EMPTY(cRefer),{ SaveRefPos(cRefer)[3], SaveRefPos(cRefer)[2]+2,"" },),;
                     aNewSpraw[i],,;
                     1, /*bPostDisp*/,;
                     { "'"+STR(i,1)+"'","'"+aNewSpraw[i]+"'",'CODE',;
                       'NNOPER',"UPPER(PADR("+aNameSpraw[i,2]+",20))"},;
                     { "aIn["+STR(i+nBegin,1)+",2]",;
                       "aIn["+STR(i+nBegin,1)+",3]",;
                       "aIn["+STR(i+nBegin,1)+",4]",;
                       "aIn["+STR(i+nBegin,1)+",5]",;
                       "aIn["+STR(i+nBegin,1)+",6]" },.T. /*lNoAdd*/,,,,,lPl),;
                    aNameSpraw[i,3] := FIELDPOS( aNameSpraw[i,2] );
          )
        ENDIF
      NEXT

      // Для Лени - Автоматический сброс данных
      IF aNewSpraw[1] == PLAN->SPRAW
        i := 1
        aSource := { "'"+STR(i,1)+"'","'"+aNewSpraw[i]+"'",'CODE','NNOPER',;
                     "UPPER(PADR("+aNameSpraw[i,2]+",20))",;
                     'CODE',;
                     "PADR("+aNameSpraw[i,2]+",LEN(aIn["+STR(nCode+1,1)+"]))" }
        aDest   := { "aIn["+STR(i+nBegin,1)+",2]",;
                     "aIn["+STR(i+nBegin,1)+",3]",;
                     "aIn["+STR(i+nBegin,1)+",4]",;
                     "aIn["+STR(i+nBegin,1)+",5]",;
                     "aIn["+STR(i+nBegin,1)+",6]",;
                     "aIn["+STR(nCode,1)+"]",;
                     "aIn["+STR(nCode+1,1)+"]" }
      ENDIF

    ENDIF

    IF ValType(aNameSpraw) == 'A'  // Чтобы пусто было
      aNameSpraw := ASIZE( aNameSpraw, _MAX_SPRAW )
      AEVAL(  aNameSpraw, {|x,xi| IF( EMPTY(x),aNameSpraw[xi]:={'','',0,.F.,''},) } )
    ENDIF
     IF SELECT("PARTNER")<>0
       cOldOrd:=PARTNER->(OrdSetFocus('FULLCODE'))
     ENDIF

    IF cTypeSpr != NIL .OR. !EMPTY(PLAN->SPRAW)
      // Мягкая или жестская привязка справочников
      IF(ValType(nTypeRef) = "N",,nTypeRef := IF( PLAN->TYPE_PRIV == '1', 1, 3  ))
      IF  IF(cTypeSpr = NIL,PLAN->SPRAW,cTypeSpr) == '01'
        IF cTypeSpr = NIL
          NetUse( 'SPRAW', 'STRUCT')
        ENDIF
        IF ValType(cHelp) = "A" .AND. EMPTY(cHelp[3])
          cHelp[3] := " F2:Подразделения "
        ELSEIF EMPTY( cHelp )
          cHelp :=  "F2:Подразделения"
        ENDIF
        IF(aSource = NIL,aSource := {"Code",IF(cDestName = NIL,"PADR(ShortName,LEN("+cMemName+"))",cDestName)},NIL)
        IF(aDest = NIL,aDest := {cMemCode,cMemName},NIL)
        MakeRefer(cSpraw,"Подразделения",nTypeRef,{"Код","Наименование"},;
               {4,25,10},COL_REFER,;
							 aSource,;
							 aDest,;
               "UPPER("+cMemCode+")",;
               {{||FIELD->Code},{||FIELD->ShortName}},;
               {{'- по коду', 'Код подразделения?',;
                 'Code', 'UPPER(aIn[1])', 'XXXXXX'}},,,,,bPost,,;
               bPostDisp,,,, cHelp)

      ELSEIF IF(cTypeSpr = NIL,PLAN->SPRAW,cTypeSpr) == '02'
        IF cTypeSpr = NIL
          NetUse( 'SPRAW', 'PEOPLE')
        ENDIF
        IF ValType(cHelp) = "A" .AND. EMPTY(cHelp[3])
          cHelp[3] := " F2:Сотрудники "
        ELSEIF EMPTY( cHelp )
          cHelp :=  "F2:Сотрудники"
        ENDIF
        IF(aSource = NIL,aSource := {"Code",IF(cDestName = NIL,"PADR(ALLTRIM(ShortName)+' '+"+;
                                                                "ALLTRIM(FIELD->NAME1)+' '+"+;
                                                                "ALLTRIM(FIELD->NAME2), LEN("+cMemName+"))",cDestName)},NIL)
        IF(aDest = NIL,aDest := {cMemCode,cMemName},NIL)
        MakeRefer(cSpraw,"Сотрудники",nTypeRef,{"Таб.#","Фамилия","Имя","Отчество","Подразд"},;
					{4,5,10},COL_REFER,;
          aSource,;
					aDest,;
               "UPPER("+cMemCode+")",;
               {{||FIELD->Code},{||FIELD->ShortName},{||FIELD->Name1},;
               {||FIELD->Name2},{||FIELD->KODSTRU}},;
               {;
   {'- по табельн. номерам ',;
    'Введите табельн. номер','CODE','UPPER(TRIM(aIn[1]))',Global_Set[1]+'XXXXXX','ToRight(1)','',1,BlockAn(1)},;
   {'- по фамилиям         ',;
    'Введите фамилию       ','SHORTNAME','UPPER(TRIM(aIn[1]))',Global_Set[1]+'XXXXXXXXXXXXXXXXXX','.T.','',2,},;
   {'- по подразделениям   ',;
    'Введите код подраздел.','KODSTRU','UPPER(TRIM(aIn[1]))',Global_Set[1]+'XXXXXX','ToRight(1)','',3,};
               },,,,,bPost,, bPostDisp,,,, cHelp, ,,,,,,,,,,,,,,,,,,,,,,,,2)

      ELSEIF IF(cTypeSpr = NIL,PLAN->SPRAW,cTypeSpr) == '03'
      // партнёры
        If !(bPostDisp==NIL)
          Alert("Ошибка в программе: параметр bPostDisp для партнеров.",{'Ok'})
        EndIf
        //aTag := {"_CODE","_NAME","_RSCHET","_TAG_INN"}
        If cTypeSpr = NIL
        // тип справочника задан особым образом
          NetUse("SPRAW", 'PARTNER')
          If PLAN->(FIELDPOS("TYPE_A"))>0
            nType_A := PLAN->TYPE_A // тип предприятия, указанный для счёта в плане счетов
            If !EMPTY(nType_A)
            // тип предприятия задан для счёта
            // будет использован для фильтрации справочника партнёров
              If NetUse('SPRAW_A', 'TYPE_A') // открыть базу типов предприятий
                ORDSETFOCUS("TAG_OPER")
                lScope := dbSeek(nType_A)
  /*
                If lScope
                // Такой тип предприятия есть в справочнике типов предприятий
                  cNamePart := ALLTRIM(PADR(SPRAW_A->NAME,30))
                  // Тогда ставить ещё один FILTER для партнёров
                  SPRAW->(ORDSETFOCUS("_CODE"),SetScope("STR(TYPE_A,17,0)",STR(nType_A,17,0),,aTag))
                Else
                  SPRAW->(ORDSETFOCUS("CODE"))
                EndIf
  */
                dbCloseArea()               // закрыть базу типов предприятий
              Else
                SayError('Ошибка открытия TYPE_A.DBF') // однажды была ошибка в режиме реорганизации
                // непонятно, куда вылетать
              EndIf
            EndIf
          EndIf
          SELECT SPRAW                  // справочник партнёров
        EndIf
        IF ValType(cHelp) = "A" .AND. EMPTY(cHelp[3])
          cHelp[3] := " F2:Партнеры "
        ELSEIF EMPTY( cHelp )
          cHelp :=  "F2:Партнеры"
        ENDIF
/*
        aHeads :=;
         {;
 { "Код ......................:",'CODE'       },;
 { "Hаименование .............:",'SHORTNAME'  },;
 { "Hаименование (полное).....:",'ORGNAME'     },;
 { "Банк и его местоположение.:",'BANK'    },;
 { "Филиал банка..............:",'RECVIZIT'},;
 { "Код банка /БИК/...........:",'BNKKOD'},;
 { "..........................:",'BNKKOD1'},;
 { "Код участника ............:",'CODE_UH'      },;
 { "Номер расчетного счета....:",'RSCHET'       },;
 { "Код ИНН...................:",'CODE_PR'       },;
 { "Адрес ....................:",''       },;
 { "..........................:",''       },;
 { "..........................:",''       },;
 { "..........................:",''       },;
 { "Дополнительная информация.:",'ADRESS2'},;
 { "Код по ОКОНХ..............:",'CODE_OKOHX'},;
 { "Код по ОКПО...............:",'CODE_OKPO'},;
 { "Телефон (юридич.адрес)....:",'TELEFON1'},;
 { "Телефон (фактич.адрес)....:",'TELEFON2'};
                      }
        aPict := {"@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@KS30","@K 99999","@K 9999999999","@KR (999999)-999-99-99","@KR (999999)-999-99-99"}
        aWhen := { ;
                    {|oGet| QHelp( ,, 1,,"CODE") },;
                    {|| IF(EMPTY(aIn[3]),aIn[3] := PADR(aIn[2],LEN(aIn[3])),NIL),.T.};
                 }
        aValid := {}
        aGetBlock := {BlockAn(1)}
        aRef := {}
        IF !lScope .AND. FILE("TYPE_A.DBF") .AND. (SELECT("TYPE_A") != 0.OR. (nSel)->(NetUse("TYPE_A","TYPE_A")))
           //AADD(aHeads,{"Тип предприятия...........:",'TYPE_A'})
           nPoz := LEN(aHeads)                                                                       // 7
           TYPE_A->(ORDSETFOCUS("TAG_OPER"),MakeTypeA('TYPE_A',IF(TYPE_A->(dbGoTop(),!BOF()),1,2),,,,,nPoz))
           ASIZE(aRef,nPoz)
           ASIZE(aWhen,nPoz)
           ASIZE(aGetBlock,nPoz)
           ASIZE(aPict,nPoz)
           ASIZE(aValid,nPoz)
           aRef[nPoz] := 'TYPE_A'
           aWhen[nPoz] := {|| .T. }
           aValid[nPoz] := {|| .T. }
           aPict[nPoz] := "@S30"
           aGetBlock[nPoz] := {;
                                 |x, oGet|;
                                 If(x != NIL .AND. EMPTY(x),;
                                  aIn[oGet:Name[3]] := 0,),;
                                 TYPE_A->(;
                                            DBSeek(aIn[oGet:Name[3]]),;
                                            PADR(TYPE_A->NAME,30);
                                         );
                              }
        ENDIF
*/
        IF(aSource = NIL,aSource := {"Code",IF(cDestName = NIL,"PADR(ShortName,LEN("+cMemName+"))",cDestName)},NIL)
        IF(aDest = NIL,aDest := {cMemCode,cMemName},NIL)

      // PVP
      ReferPartSet(cSpraw, aDest, aSource, nTypeRef, cHelp, "UPPER("+cMemCode+")", !lNoAdd,,If(lScope,nType_A,))
/*
      //             1          2           3
      MakeRefer(  cSpraw, 'Организации',nTypeRef,                           ;
      ;        //                 4                    5         6
                  {"Шифp","Наименование","Р/счет"},{3,20,10},COL_REFER, ;
      ;        //    7
                  aSource,;
      ;        //   8
                  aDest,;
      ;       //    9
                  IF(lScope,"'"+STR(nType_A,17,0)+"'+","")+"UPPER("+cMemCode+")",;
      ;       //              10
                  {{||FIELD->Code},{||FIELD->ShortName},{||LEFT(FIELD->RSCHET,20)}},            ;
      ;       //              11
                  {;
                     {'- шифрам  счетов ', 'Шифр?:', 'Code', ;
                         IF(lScope,"'"+STR(nType_A,17,0)+"'+","")+'TRIM(UPPER(aIn[1]))', ;
                         Global_Set[1]+'XXXXXX','.T.','',IF(lScope,aTag[1],RIGHT(aTag[1],LEN(aTag[1])-1)),BlockAn(1);
                     },;
                     {'- наименованиям  ', 'Наименование?:','ShortName',;
                         IF(lScope,"'"+STR(nType_A,17,0)+"'+","")+'TRIM(UPPER(aIn[1]))', ;
                         ALLTRIM(IF(!EMPTY(Global_Set[1]),Global_Set[1],'@'))+'S30','.T.','',;
                         IF(lScope,aTag[2],RIGHT(aTag[2],LEN(aTag[2])-1)),;
                     },;
                     {'- по расч.счету  ' ,'Введите расч.счет'    ,'RSCHET',;
                         IF(lScope,"'"+STR(nType_A,17,0)+"'+","")+'UPPER(RTRIM(aIn[1]))',;
                         ALLTRIM(IF(!EMPTY(Global_Set[1]),Global_Set[1],'@'))+'S18','.T.','',;
                         IF(lScope,aTag[3],RIGHT(aTag[3],LEN(aTag[3])-1)),;
                     },;
                     {'- по коду ИНН    ' ,'Введите код ИНН'    ,'CODE_PR',;
                         IF(lScope,"'"+STR(nType_A,17,0)+"'+","")+'UPPER(RTRIM(aIn[1]))',;
                         ALLTRIM(IF(!EMPTY(Global_Set[1]),Global_Set[1],'@'))+'S18','.T.','',;
                         IF(lScope,aTag[4],RIGHT(aTag[4],LEN(aTag[4])-1)),;
                     };
                  },;
                  IF(lNoAdd,NIL,aHeads),;   // 12
                  aPict,;                   // 13
                  aWhen,aValid,;            // 14, 15
                  {||;                      // 16
                   IF(nType_A != NIL,FIELD->TYPE_A := nType_A,NIL),;
                   Field->Adress:=aIn[11]+aIn[12]+aIn[13]+aIn[14],;
                   FIELD->NNOPER := _SprawStep();
                    },;
                    {||SETKEY(K_ALT_F6,{||FiltName('cFind$UPPER(SHORTNAME)',DBFILTER(),ScopeMacro())}),;
                       SETKEY(K_ALT_F12,{||FiltName('cFind$UPPER(SHORTNAME)',DBFILTER(),ScopeMacro())}),;
                       SETKEY(K_CTRL_F6,{||QSetFilter(,,"Снять")})},; //17
                  bPostDisp,,,;  // 18 ???????????
                  aRef,;         // 21
                  cHelp,,,,aGetBlock, ;
                  'cFind$UPPER(STRTRAN(SHORTNAME,CHR(255),CHR(32)))', , , , , , , , ,;
                  {|| AEVAL(aIn,{|x,i| IF(i >= 11 .AND. i <= 14,aIn[i] := SPACE(60),aIn[i] := BLANK(x,.T.)) },2) };
                   ,,,,,;    // 40
                   ,,,,,;    // 45
                   , "Name";
               )
 */
      ELSEIF  IF(cTypeSpr = NIL,PLAN->SPRAW,cTypeSpr) == '04'
        IF cTypeSpr = NIL
          NetUse( 'SPRAW', 'RASXOD')
        ENDIF
        IF ValType(cHelp) = "A" .AND. EMPTY(cHelp[3])
          cHelp[3] := " F2:Статьи расходов "
        ELSEIF EMPTY( cHelp )
          cHelp :=  "F2:Статьи расходов"
        ENDIF
				IF(aSource = NIL,aSource := {"Code",IF(cDestName = NIL,"PADR(Name,LEN("+cMemName+"))",cDestName)},NIL)
				IF(aDest = NIL,aDest := {cMemCode,cMemName},NIL)
        MakeRefer(cSpraw,"Статьи расходов",nTypeRef,{"Код","Наименование"},;
               {4,25,10},COL_REFER,;
               aSource,;
							 aDest,;
               "UPPER("+cMemCode+")",;
               {{||FIELD->Code},{||FIELD->Name}},;
               {{'- по коду', 'Код статьи?', 'Code',;
                 'UPPER(aIn[1])', 'XXXXXX'}},,,,,bPost,, bPostDisp,,,, cHelp)
      ENDIF
    ELSE
       ClearRefer(cSpraw)
    ENDIF
  ENDIF

     IF SELECT("PARTNER")<>0
       PARTNER->(OrdSetFocus(cOldOrd))
     ENDIF

  // Закроем все, что открыли
//  AEVAL( aBase, {|x| (x)->( dbCloseArea() ) } )

  IF nOpen == 0
    PLAN->( dbCloseArea() )
  ENDIF
  SELECT (nSel)
RETURN NIL



PROCEDURE Boss_Sheff( nTmp,nSelectMode0 )
  Str2File( '', nTmp,,,nSelectMode0 )
  Str2File( LBL_BOSS2+': '+LBL_BOSS, nTmp,,,nSelectMode0)
  Str2File( LBL_SHEF2+': '+LBL_SHEF, nTmp,,,nSelectMode0)
/************
  Str2File( LBL_BOSS2+': '+LBL_BOSS+;
            SPACE( 74-LEN(LBL_BOSS2+LBL_BOSS+LBL_SHEF2+LBL_SHEF) )+;
            LBL_SHEF2+': '+LBL_SHEF, nTmp,,,nSelectMode0)
*****************/
RETURN

PROCEDURE Boss_Sh( nTmp )
  Str2File( '', nTmp )
  Str2File( 'Исполнитель:', nTmp )
  Str2File( '                  (должность)  (подпись)           (расшифровка подписи)', nTmp )
  Str2File( '', nTmp )
  Str2File( LBL_SHEF2+"                     " +RTrim(LBL_SHEF) , nTmp )
  Str2File( '                  (подпись)                        (расшифровка подписи)', nTmp )
  Str2File( '', nTmp )
  Str2File( 'Приложение на          листах', nTmp )
  Str2File( '', nTmp )
RETURN

PROCEDURE Boss_Tit( nTmp, n)
  n:=if(n==NIL,0,1)
  Str2File( '', nTmp )
  Str2File( '', nTmp )
  Str2File( space(35)+'М.П. (штампа)', nTmp )
  Str2File( '', nTmp )
  Str2File( space(25)+'Руководитель организации',nTmp)
  //Str2File( space(30)+PADC(if(n==1,Replicate("_",Len(LBL_BOSS2)),RTRIM(LBL_BOSS2)),if(len(RTRIM(LBL_BOSS2))>11,len(RTRIM(LBL_BOSS2)),11))+'             '+PADC(if(n==1,Replicate("_",Len(LBL_BOSS)),RTRIM(LBL_BOSS)),if(len(RTRIM(LBL_BOSS))>21,len(RTRIM(LBL_BOSS)),21)),nTmp)
  Str2File( space(50)+Replicate("_",12)+" "+Replicate("_",11)+" "+Replicate("_",21), nTmp )
  Str2File( space(50)+"(должность)   (подпись)  (расшифровка подписи)", nTmp )
  Str2File( '', nTmp )
  Str2File( space(25)+PADR('Главный бухгалтер',if(len(RTRIM(LBL_SHEF2))>11,len(RTRIM(LBL_SHEF2)),11))+"             "+PADC(if(n==1,space(Len(LBL_SHEF)),RTRIM(LBL_SHEF)),if(len(RTRIM(LBL_SHEF))>21,len(RTRIM(LBL_SHEF)),21)), nTmp )
  Str2File( space(63)+Replicate("_",11)+' '+Replicate("_",21)+' ', nTmp )
  Str2File( space(63)+' (подпись)  (расшифровка подписи)', nTmp )
  Str2File( '', nTmp )
  Str2File( space(45)+'"____" ______________  _____ г.', nTmp )
RETURN

PROCEDURE BossShNew( nTmp )
  Str2File( '', nTmp )
  Str2File( PADR(RTRIM(LBL_SHEF2),40)+RTrim(LBL_SHEF) , nTmp )
  Str2File( '                      (подпись)         (расшифровка подписи)', nTmp )
  Str2File( '', nTmp )
  Str2File( 'Исполнитель:', nTmp )
  Str2File( '                      (подпись)         (расшифровка подписи)', nTmp )
  Str2File( '', nTmp )
  Str2File( '"____" ______________  _____ г.', nTmp )
RETURN

PROCEDURE MakeLabelRefer( cRefer,cDest,nTypeRefer,cDestPath)
  //nTypeRefer=1-обязательный ввод счетов и аналитики при ее наличии
  //nTypeRefer=2-необязательный ввод счетов и аналитики при ее наличии
  cRefer     := IF( ValType(cRefer)=="C",     cRefer,    "LABEL" )
  nTypeRefer := IF( ValType(nTypeRefer)=="N", nTypeRefer, 1     )
  MakeRefer( cRefer, 'Список предприятий', nTypeRefer, ;
             {'Код','Наименование'}, {3,35,15},      ;
             COL_REFER, IF(cDestPath != NIL,{'LBL_PATH'},{'LBL_CODE'}), IF(cDestPath != NIL,{ cDestPath },{ cDest }), 'UPPER('+cDest+')', ;
             {FIELDBLOCK('LBL_CODE'),FIELDBLOCK('LBL_NAME')}             ;
            )
RETURN
//----------------------------------------------------------------------------//
                     FUNCTION SverkaBas()
//----------------------------------------------------------------------------//
// Сверка баз данных различный версий
   STATIC sIn
   LOCAL nTop := INT((MAXROW()-7)/2), nLeft := INT((MAXCOL()-65)/2), aSet := SaveSet(), aSetKeys := SaveSetKey()
   LOCAL oGetNew
   LOCAL cReport,nHandle, lError := .F.,cNCdx, cError, cLabel
   LOCAL aFile_1, aFile_2, aFile
   // Массив масок файлов для проверки на кол-во записей
   LOCAL aBase := {"base????.Dbf",;
                   "Sclad\stru.dbf",;
                   "real\stru.dbf",;
                   "zapas\stru.dbf",;
                   "b_menu.dbf",;
                   "menu?.dbf",;
                   "b_menu?.dbf",;
                   "k_menu?.dbf",;
                   "kb_menu?.dbf",;
                   "kb_menu?.dbf",;
                   "oc_menu?.dbf",;
                   "r_menu?.dbf",;
                   "s_menu?.dbf",;
                   "tz_menu?.dbf",;
                   "z_menu?.dbf",;
                   "menu_rep.dbf";
                   }
   // Файлы исключаемые из списка
   LOCAL bDel := {|aFile| !("." $ aFile[1]) .OR. CHARREM("1234567890",LEFT(aFile[1],AT(".",aFile[1]))) == "" .OR. ".CDX" $ aFile[1] .OR. ".IDX" $ aFile[1]  .OR. ".ERR" $ aFile[1] .OR. ".MEM" $ aFile[1]}
   LOCAL cMess
   LOCAL bRun := {|cFile| SetPos(nTop+5,nLeft+6),DispOut(PADR(cMess+cFile,50),COL_BROWSE) }
   LOCAL cNameCdx,cNameDbf,aCols,cFormat,aHeader,aFieldsHead, nLin

   PRIVATE aIn[5],GetList := {}
   Help_Code := "C01"

BEGIN SEQUENCE
   USE  ( _PRO_PATH+'LABEL.PRO' ) ALIAS LABEL SHARED NEW VIA 'DBFCDX'
   IF !USED()
     SayError( 'Ошибка открытия LABEL.PRO' )
     BREAK
   ENDIF
   cNCdx := TEMPFILE(MemVar->GlobalTmpPath, "IDX")
   FERASE(cNCdx)
   INDEX ON FIELD->LBL_CODE TAG CODE TO (cNCdx)

   LABEL->(MakeLabelRefer( "Label_1","''",3,"aIn[1]"))
   LABEL->(MakeLabelRefer( "Label_2","''",3,"aIn[2]"))


   IF VALTYPE(sIn) <> 'A'
     aIn[1] := PADR(LoadPath(),70)
     aIn[2] := SPACE(70)
     aIn[3] := SPACE(70)
   ELSE
     AEVAL( sIn, {|x,i| aIn[i] :=x } )
   ENDIF

   SETCOLOR(COL_BROWSE)
   DispBox(nTop+1, nLeft, nTop+6, nLeft+63, "╔═╗║╝═╚║ ", COL_BROWSE)
   ShadowBox("",nTop+1, nLeft, nTop+6, nLeft+63, COL_BROWSE, "╔═╗║╝═╚║" )
   SetPos(nTop+1, nLeft+2)
   DispOut("[ Контроль структур баз ]",COL_BROWSE)

   @ nTop+2, nLeft+6 SAY "       Путь к базам данных..."
   @ nTop+3, nLeft+6 SAY "Первого предприятия : "
   @ nTop+4, nLeft+6 SAY "Второго предприятия : "
   @ nTop+5, nLeft+6 SAY "Подсистема          : "
                       // 67890123456789012345678901234567890
   @ nTop+6, nLeft+6 SAY "     (производится сравнение структур баз данных)"

   SETCOLOR(COL_GET)
   oGetNew := GetNew(nTop+3, nLeft+28,{|x| IF(x != NIL,aIn[1] := x,aIn[1]) })
   oGetNew:reader := {|oGet| ReferGetReader(oGet,"Label_1") }
   oGetNew:picture := "@S30"
   oGetNew:display()
   AADD(GetList,oGetNew)
   oGetNew := GetNew(nTop+4, nLeft+28,{|x| IF(x != NIL,aIn[2] := x,aIn[2]) })
   oGetNew:reader := {|oGet| ReferGetReader(oGet,"Label_2") }
   oGetNew:picture := "@S30"
   oGetNew:display()
   AADD(GetList,oGetNew)
   @  nTop+5, nLeft+28 Get aIn[3] Picture '@KS30'
   SET CURSOR ON
   READ
   SET CURSOR OFF

   IF LASTKEY() == K_ESC
     BREAK
   ENDIF

   sIn := ACLONE(aIn)

   aIn[1] := ALLTRIM(aIn[1])
   aIn[2] := ALLTRIM(aIn[2])
   IF RIGHT(aIn[1],1) != "\"
     aIn[1] += "\"
   ENDIF
   IF RIGHT(aIn[2],1) != "\"
     aIn[2] += "\"
   ENDIF

   IF UPPER(aIn[1]) == UPPER(aIn[2])
     SayError("Пути к базам данных должны отличаться !")
     BREAK
   ENDIF

  if Empty(aIn[3])
   IF !FILE(aIn[1]+"MAIN.DBF") .OR. !FILE(aIn[2]+"MAIN.DBF")
     SayError("Не верно заданы пути к базам данных !")
     BREAK
   ENDIF
  else
     aIn[3] := AllTrim(aIn[3])
     IF RIGHT(aIn[3],1) != "\"
        aIn[3] += "\"
     ENDIF
     aIn[1] += aIn[3]
     aIn[2] += aIn[3]
  end


   SELECT(0)
   DBCREATE(;
       (cNameDbf := TEMPFILE(MemVar->GlobalTmpPath, "DBF")),;
       {;
        { 'LABEL',       'C', 2, 0 },;
        { 'FILE',        'C',40, 0 },;
        { 'ERROR',       'M',10, 0 };
        };
            )

   cNameCdx := LEFT(cNameDbf,AT(".",cNameDbf))+"IDX"
   IF !NetUseExc("__ERROR",cNameDbf )
      BREAK
   ENDIF
   SELECT __ERROR
   INDEX ON UPPER(FIELD->LABEL) TAG LABEL TO (cNameCdx)

   Busy(.T.,"Проверка соответствия структур")

   cMess := "Чтение: "
   aFile_1 := AllDirFile(aIn[1],"*.*",bDel,bRun)
   aFile_2 := AllDirFile(aIn[2],"*.*",bDel,bRun)
   aFile := IF(LEN(aFile_1) > LEN(aFile_2),aFile_1,aFile_2)
   cMess := "Обработка: "
   // После обработки остаются файлы с расширением не DBF и избыточные
   AEVAL(aFile,{|cFile,n| cLabel := "",cError := "",;
                          EVAL(bRun,cFile),;
                          IF(ASCAN(aFile_2,cFile) != 0 .AND. ".DBF" $ cFile .AND. ValidStruct(aIn[1],aIn[2],cFile,aBase,@cLabel,@cError),;
                             aFile[n] := NIL,;
                             IF(!EMPTY(cError) .AND. __ERROR->(AddRec()),(aFile[n] := NIL,cError := ALLTRIM(cError),lError := .T.,__ERROR->LABEL := cLabel,__ERROR->FILE := cFile,__ERROR->ERROR := IF(RIGHT(cError,1) = ",",LEFT(cError,LEN(cError)-1),cError),__ERROR->(dbUnLock())),NIL);
                             );
                })
   AEVAL(aFile,{|cFile| IF(cFile != NIL .AND. ".DBF" $ cFile .AND. __ERROR->(AddRec()),(EVAL(bRun,cFile),__ERROR->LABEL := IF(LEN(aFile_1) > LEN(aFile_2),"1","2"),__ERROR->ERROR := "Избыточный файл",__ERROR->FILE := cFile,__ERROR->(dbUnLock())),NIL) })

   Busy(.F.)

   IF lError
     Busy(.T.,"Формирование отчета")

     SELECT __ERROR
     GO TOP

     aHeader := {;
       "                РАЗЛИЧИЯ В СТРУКТУРАХ БАЗ ДАННЫХ",;
       "",;
       "       Первое предприятие:"+aIn[1],;
       "       Второе предприятие:"+aIn[2],;
       "";
                }

     aFieldsHead := {;
                "┌─────────────┬─────────────────────────────────┬──────────────────────────────────────────┐",;
                "│ Предприятие │            Имя файла            │                Информация                │",;
                "├─────────────┼─────────────────────────────────┼──────────────────────────────────────────┤";
                    }

     cFormat := "│XXXXXXXXXXXXX│XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX│XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX│"

     aCols := {;
              'PADC(LABEL,13)',;
              'FILE',;
              'ERROR';
              }

     cReport := TEMPFILE( _TMP_DIR, "TXT")
     nLin := TotRep(aHeader, aCols, aFieldsHead, cFormat,,,, ;
                 cReport, , .T.,.F.,  )
     Busy(.F.)
     View(cReport,nLin)
   ELSE
     SayError("Различий в структурах не обнаружено !")
   ENDIF

END SEQUENCE

   IF(SELECT("__ERROR") != 0,__ERROR->(dbCloseArea(),FERASE(cNameCdx),FERASE(cNameDbf),FERASE(LEFT(cNameDbf,AT(".",cNameDbf))+"FPT")),NIL)
   IF(SELECT("LABEL") != 0,LABEL->(dbCloseArea(),FERASE(cNCdx)),NIL)
   RestSet(aSet)
   RestSetKey(aSetKeys)

RETURN NIL
//----------------------------------------------------------------------------//
  FUNCTION ValidStruct(cPath_1,cPath_2,cFile,aBase,cLabel,cError)
//----------------------------------------------------------------------------//
// Проверка соотв. структур
// cLabel и cError - возвращаются по ссылкам
LOCAL lOpen_1,lOpen_2, cNamePol, cType , nLen, nDec,lLike := .F.
LOCAL LastHandler := ERRORBLOCK({|| BREAK("") })
LOCAL aStruct1,aStruct2,aDelPol := {},cList
BEGIN SEQUENCE
  cError := ""
  cLabel := ""
  IF !(lOpen_1 := NetUse("TM1",cPath_1+cFile)) .OR. !(lOpen_2 := NetUse("TM2",cPath_2+cFile))
     BREAK
  ENDIF
  IF LEN((aStruct1 := TM1->(dbStruct()))) != LEN((aStruct2 := TM2->(dbStruct())))
    cLabel := IF(LEN(aStruct1) > LEN(aStruct2),"1","2")
    cList := ""
    AEVAL(IF(cLabel = "1",aStruct1,aStruct2),{|aSt,n| cNamePol := aSt[1],IF(ASCAN(IF(cLabel = "2",aStruct1,aStruct2),{|x| cNamePol == x[1] }) = 0,(AADD(aDelPol,n),cList += aSt[1]+CHR(255)+aSt[2]+CHR(255)+ALLTRIM(STR(aSt[3],3,0))+CHR(255)+ALLTRIM(STR(aSt[4],2,0))+","),NIL) })
    ASORT(aDelPol,,,{|x,y| x > y})
    AEVAL(aDelPol,{|n| ADEL(IF(cLabel = "1",aStruct1,aStruct2),n) })
    ASIZE(IF(cLabel = "1",aStruct1,aStruct2),LEN(IF(cLabel = "1",aStruct1,aStruct2))-LEN(aDelPol))
    IF !EMPTY(cList)
      cError := PADR("Добавлены поля :",40,CHR(255))+"  "+LEFT(cList,LEN(cList)-1)
    ENDIF
  ENDIF

  cList := ""
  AEVAL(aStruct1,{|aSt,n| cNamePol := aSt[1],cType := aSt[2],nLen := aSt[3],nDec := aSt[4],IF(ASCAN(aStruct2,{|x| cNamePol == x[1] .AND. cType == x[2] .AND. nLen == x[3] .AND. nDec == x[4] }) = 0,cList += aSt[1]+",",NIL) })
  IF !EMPTY(cList)
    cError += PADR("  Отличие описания полей:",40,CHR(255))+"  "+LEFT(cList,LEN(cList)-1)
  ENDIF

  AEVAL(aBase,{|x| lLike := lLike .OR. LIKE(UPPER(x),cFile) })
  IF lLike .AND. TM1->(LastRec()) != TM2->(Lastrec())
     cError += " Добавлено записей:"+CHR(255)+ALLTRIM(STR(ABS(TM1->(LastRec()) - TM2->(Lastrec())),10,0))
     cLabel += IF(TM1->(LastRec()) > TM2->(Lastrec()),"1","2")
  ENDIF

  TM1->(dbCloseArea())
  TM2->(dbCloseArea())
RECOVER
  IF lOpen_1 = NIL .OR. lOpen_2 = NIL
     cError :=  "Испорченный файл или индекс !"
     cLabel := IF(lOpen_1 = NIL,"1","2")
  ELSE
     cError :=  "Невозможно окрыть файл !"
     cLabel := IF(lOpen_1,"1","2")
  ENDIF
END SEQUENCE
ERRORBLOCK(LastHandler)
RETURN EMPTY(cError)
//----------------------------------------------------------------------------//
FUNCTION MakeTypeA(cNameRef, nType, cMess, aDest, aVar, bFilter,nPoz,lGet)
//----------------------------------------------------------------------------//
// Справочник типов контрагентов
LOCAL bakFilter
nType:=If(nType==NIL,1,nType)
aDest:=If(aDest==NIL,{"NNOPER"},aDest)
aVar:=If(aVar==NIL,{"aIn["+IF(VALTYPE(lGet)=="L".AND.lGet,"nGet",NTOC(nPoz))+"]"},aVar)
MakeRefer( cNameRef ," Справочник типов партнеров ",nType,{' Наименование типа '},{4,19,10},COL_REFER,;
aDest,aVar,aVar[1],;
{{|| PADR(FIELD->NAME,30) }},;
{{' - по наименованию',' Введите наименование:',"NAME",'UPPER(aIn[1])','@KS20',,,1}},,,,,,;
{|| IF(ValType(bFilter) = "B",(bakFilter := dbFilter(),EVAL(bFilter)),NIL) },;
{|| IF(!EMPTY(bakFilter),dbSetFilter(&("{|| "+bakFilter+"}"),bakFilter),NIL) },,,,cMess )
RETURN NIL
//----------------------------------------------------------------------------//
FUNCTION MakeTypeB(cNameRef, nType, cMess, aDest, aVar, bFilter,nPoz,lGet)
//----------------------------------------------------------------------------//
// Справочник типов контрагентов
LOCAL bakFilter, nCount
LOCAL aIHeads:={{'Код статуса.........:','CODE'},;
                {'Наименование статуса:','NAME'}}
LOCAL aPict := {'@K','@KS50'}
//LOCAL aWhen :={{|| altd(),.t.}}
LOCAL aValid//:={{|| altd(),ToRight(1),if(nApp==2,CheckNumber(aIn[1]),.t.)}}
//LOCAL aPreGet := {|| altd(),QHelp('...',,1,,"CODE",,,{|| FIELD->NNOPER := IncStep("OperA")},"OPER_CODE" ) }
LOCAL aPost:={|| altd(), nCount:=TYPE_P->(RecCount())+1,FIELD->NNOPER := IncStep("OperB",, nCount)}

nType:=If(nType==NIL,1,nType)
aDest:=If(aDest==NIL,{"NNOPER"},aDest)
aVar:=If(aVar==NIL,{"aIn["+IF(VALTYPE(lGet)=="L".AND.lGet,"nGet",NTOC(nPoz))+"]"},aVar)
MakeRefer( cNameRef ," Справочник статусов партнеров ",nType,{' Код',' Наименование статуса '},{4,19,10},COL_REFER,;
aDest,aVar,aVar[1],;
{{|| FIELD->CODE },{|| PADR(FIELD->NAME,46) }},;
{{' - по коду',' Введите код:',"CODE",'UPPER(aIn[1])','@KS2',,,"TAG_CODE"},;
 {' - по наименованию',' Введите наименование:',"NAME",'UPPER(aIn[1])','@KS30',,,"TAG_NAME"}},aIHeads,aPict,,aValid,aPost,;
{|| IF(ValType(bFilter) = "B",(bakFilter := dbFilter(),EVAL(bFilter)),NIL) },;
{|| IF(!EMPTY(bakFilter),dbSetFilter(&("{|| "+bakFilter+"}"),bakFilter),NIL) },,,,cMess)//,,,,,,,,,,,,,,aPreGet )
RETURN NIL
// Только для MakeTypeB() у всех и TypeStatus() в АРМЕ гл.
FUNCTION CheckNumber(cCode)
LOCAL lRez:=.t.,nRec:=TYPE_P->(Recno())
LOCAL cOrder:=OrdSetFocus()
TYPE_P->(OrdSetFocus("TAG_CODE"))
 if TYPE_P->(dbSeek(cCode))
  SayError({"Такой код уже используется"})
  lRez:=.f.
 endif
TYPE_P->(OrdSetFocus(cOrder))
TYPE_P->(dbGoTo(nRec))
RETURN lRez
//--------------------------------------------------------------------------//
                   FUNCTION AnalPict(x)
//--------------------------------------------------------------------------//
// Возвращает формат ввода аналитических счетов
STATIC cPict := "XXXXXX"
IF x != NIL
 cPict := x
ENDIF
RETURN cPict

/* Преобразование USER CODE в SYSTEM KEY */
FUNCTION CodeToKey( cType, cCode, cField, cOrder )
  LOCAL nOrd := OrdSetFocus( IF( cOrder==NIL, 'CODE', cOrder ) )
  dbSEEK( cType+UPPER(cCode)  )
  OrdSetFocus( nOrd )
RETURN(  FIELDGET( FIELDNUM( cField ) ) )

/* Преобразование SYSTEM KEY  в USER CODE   */
FUNCTION KeyToCode( cKey, cField, cOrder )
  LOCAL nOrd:= OrdSetFocus( IF( cOrder==NIL, 'KEY', cOrder ) )
  dbSEEK( cKey )
  OrdSetFocus( nOrd )
RETURN( FIELDGET( FIELDNUM( cField ) ) )


FUNCTION UnDelMain( nOper, cNDoc, lFor, aDelRec )
  LOCAL lRez := .T., cOrd, nSel := SELECT(), ;
        lOpen := (SELECT('DEL_MAIN')<> 0)
  LOCAL cAlias

  FIELD NNOPER, NNDOC IN DEL_MAIN

  cAlias := IF(ALLTRIM(UPPER(dbInfo(10))) == UPPER(LoadPath()+"MAIN.DBF"),ALIAS(),"MAIN")

  IF lOpen .OR. OpenLogMain(@cAlias)
    IF ValType( nOper ) == 'N' .OR. ValType( nOper ) == 'C'
       cNDoc := UPPER( IF( ValType( cNDoc ) <> 'C', '', cNDoc ) )
       IF ValType( nOper ) == 'N' ;  nOper := STR( nOper, 17,0 ) ;  ENDIF
       IF ValType( lFor )  <> 'L' ;  lFor  := .T.             ;  ENDIF
       IF lFor ;   DEL_MAIN->( dbSEEK(  nOper+cNDoc ) )           ;  ENDIF
       DEL_MAIN-> ( DBEVAL( {|| IF( RecLock() ,( dbDelete(), dbUnlock() ), ) },,;
                            {|| STR(NNOPER,17,0)+UPPER(NNDOC) == nOper+cNDoc } ) )
    ELSEIF ValType(aDelRec) = "A"
      AEVAL(aDelRec,{|nRec| DEL_MAIN->( dbGoTo(nRec),IF( RecLock() ,( dbDelete(), dbUnlock() ),) )})
    ELSE
      DEL_MAIN->( IF( RecLock() ,( dbDelete(), dbUnlock() ),) )
    ENDIF
  ENDIF

  IF !lOpen
    M_Close_Base( { 'DEL_MAIN' } )
  ENDIF
  SELECT(nSel)

RETURN( .T.)

FUNCTION DelMain( lDel, nOper, cNDoc, lFor, cDel_Name , aRecDel)
  LOCAL lRez := .T., cOrd, nSel := SELECT(), lOpen := (SELECT('DEL_MAIN')<> 0),;
        nIndik, nWin1
  LOCAL cAlias

  cAlias := IF(ALLTRIM(UPPER(dbInfo(10))) == UPPER(LoadPath()+"MAIN.DBF"),ALIAS(),"MAIN")

IF lOpen .OR. OpenLogMain(@cAlias)

  IF ValType( cDel_Name ) <> 'C' ; cDel_Name := '' ; ENDIF

  IF lDel // Удаление
    IF ValType( nOper ) == 'N' .OR. ValType( nOper ) == 'C'
      cNDoc := UPPER( IF( ValType( cNDoc ) <> 'C', '', cNDoc ) )
      IF ValType( nOper ) == 'N' ;  nOper := STR( nOper, 17, 0) ;  ENDIF
      IF ValType( lFor )  <> 'L' ;  lFor  := .T.             ;  ENDIF
      cOrd := (cAlias)->( OrdSetFocus( 'NOPER_NDOC' ) )
      IF lFor ;   (cAlias)->( dbSEEK(  nOper+cNDoc ) )           ;  ENDIF
      nWin1:=NoOrYes( {'','Удаление     [ ]',''},,,10,35,COL_REFER )
      nIndik := INDIK_NEW(13,53)
      (cAlias)-> ( DBEVAL( {|| MainLog( .T., @cDel_Name, @aRecDel, @cAlias ) },,;
                       {|| INDIK_UPDATE( nIndik ),;
                           STR((cAlias)->NNOPER,17,0)+UPPER((cAlias)->NNDOC) = nOper+cNDoc } ) )
      (cAlias)->( OrdSetFocus( cOrd ) )
      INDIK_END( nIndik )
      WSELECT(nWin1)
      WCLOSE()
    ELSE
      MainLog( .T., @cDel_Name, @aRecDel, @cAlias )
    ENDIF
  ELSE
    MainLog( .F., @cDel_Name, @aRecDel, @cAlias )
  ENDIF
ENDIF
  IF !lOpen
    M_Close_Base( { 'DEL_MAIN' } )
  ENDIF
  SELECT(nSel)
RETURN( lRez )

FUNCTION ControlDataMain( nOper, cNDoc, lFor)
  LOCAL lRez := .T., cOrd, nSel := SELECT(), nIndik, nWin1
  LOCAL cAlias

  cAlias := IF(ALLTRIM(UPPER(dbInfo(10))) == UPPER(LoadPath()+"MAIN.DBF"),ALIAS(),"MAIN")

  IF ValType( nOper ) == 'N' .OR. ValType( nOper ) == 'C'
    cNDoc := UPPER( IF( ValType( cNDoc ) <> 'C', '', cNDoc ) )
    IF ValType( nOper ) == 'N' ;  nOper := STR( nOper, 17,0 ) ;  ENDIF
    IF ValType( lFor )  <> 'L' ;  lFor  := .T.             ;  ENDIF
    cOrd := (cAlias)->( OrdSetFocus( 'NOPER_NDOC' ) )
    IF lFor ;   (cAlias)->( dbSEEK(  nOper+cNDoc ) )           ;  ENDIF
    (cAlias)-> ( DBEVAL( {|| lRez:=A3MaxDate((cAlias)->DATAOPER) },,;
                     {|| STR((cAlias)->NNOPER,17,0)+UPPER((cAlias)->NNDOC)=nOper+cNDoc .and. lRez} ) )
    (cAlias)->( OrdSetFocus( cOrd ) )
  ELSE
   lRez:=.f.
  ENDIF
  SELECT(nSel)
RETURN( lRez )

FUNCTION ControlGenProv(nNoperRelProv,nAinDataDoc,nAinDataOper,lLastIn)
LOCAL lRez:=.f.
RETURN lRez:=if(Empty(nNoperRelProv),.t.,ControlDataMain(nNoperRelProv)) ;
       .and. if(Empty(aIn[nAinDataDoc]),.t.,A3MaxDate(aIn[nAinDataDoc])) ;
       .and. if(!lLastIn .or. Empty(aLastIn[nAinDataDoc]),.t.,A3MaxDate(aLastIn[nAinDataDoc])) ;
       .and. if(Empty(aIn[nAinDataOper]),.t.,A3MaxDate(aIn[nAinDataOper])) ;
       .and. if(!lLastIn .or. Empty(aLastIn[nAinDataOper]),.t.,A3MaxDate(aLastIn[nAinDataOper]))

STATIC PROCEDURE MainLog( lDel, cDel_Name, aRecDel, cAlias )
  LOCAL aRec := (cAlias)->( Scatter() ),;
        aDopRec := { STR((cAlias)->(RecNo()),7),;
                     _USER_CODE,;
                     GlobalTask,;
                     DATE(),;
                     TIME(),;
                     cDel_Name,;
                     ProcName( 2 ),;
                     ProcName( 3 ),;
                     ProcName( 4 );
                   }
  IF lDel
    (cAlias)->( IF( RecLock() ,( dbDelete(), dbUnlock() ), ) )
  ENDIF
  AEVAL( aDopRec, {|x| AADD( aRec, x ) } )
  DEL_MAIN->( PutNetAdd( aRec ), IF(ValType(aRecDel) = "A",AADD(aRecDel,RECNO()),NIL) )
RETURN

Procedure CreateLogMain(cPath,cAlias)
LOCAL nPos,nLen
  LOCAL aStruct, aDopStru :=;
                             {;
                              { 'NREC',     'C', 7, 0 },;
                              { 'DEL_USER', 'C', 6, 0 },;
                              { 'DEL_TASK', 'C', 2, 0 },;
                              { 'DEL_DATE', 'D', 8, 0 },;
                              { 'DEL_TIME', 'C', 8, 0 },;
                              { 'DEL_NAME', 'C',25, 0 },;
                              { 'DEL_PROC1','C',10, 0 },;
                              { 'DEL_PROC2','C',10, 0 },;
                              { 'DEL_PROC3','C',10, 0 } ;
                             }
    IF EMPTY(cAlias)
       cAlias:="MAIN_MAIN"
       USE (cPath+'MAIN.DBF') ALIAS MAIN_MAIN NEW SHARED
    ENDIF
	aStruct := (cAlias)->( dbSTRUCT() )
    nLen:= LEN(aStruct)
    aStruct:= ASIZE(aStruct,nLen+LEN(aDopStru))
    nPos:= ASCAN(aStruct,{|x|x[1]=="CRYPT_CODE".OR.x[1]== "CRC"})
    IF nPos==0
      nPos:=nLen+1
    ENDIF

    FOR nLen := LEN(aDopStru) to 1 STEP -1
       #ifDEF __HARBOUR__
       AINS( aStruct,nPos,aDopStru[nLen]  )
       #else
         AINS( aStruct,nPos  )
         aStruct[nPos]:=ACLONE(aDopStru[nLen])
       #endif
    Next

    SELECT(0)
    dbCREATE( cPath+'DEL_MAIN.DBF', aStruct )
    dbCLOSEAREA()
    USE (cPath+'DEL_MAIN.DBF') ALIAS DEL_MAIN NEW SHARED
    INDEX ON STR(NNOPER,17,0)+UPPER(FIELD->NNDOC) TAG TAG_NNOPER TO (cPath+'DEL_MAIN.CDX')
    dbCLOSEAREA()
    IF SELECT("MAIN_MAIN") >0
      MAIN_MAIN->(dbCloseArea())
    ENDIF
Return

STATIC FUNCTION OpenLogMain(cAlias)
   IF !FILE( LoadPath()+'DEL_MAIN.DBF' )
     CreateLogMain(LoadPath(),cAlias)
   ENDIF
RETURN( M_Open_Base( { 'DEL_MAIN' } ) )


PROCEDURE NewSvobDoc()
  IF NetUse( 'Svob_Doc', 'SVOB_DOC' )
    OrdSetFocus( 0 )
      SET RELATION TO UPPER(SVOB_DOC->D_VALUTA) INTO VALUTA,;
                      UPPER(SVOB_DOC->D_VALUTA)+DTOS(SVOB_DOC->D_DOC_DAT) INTO VCURS
      dbEVAL( {||SVOB_DOC->D_VCURS := VCURS->VCURS,;
                 SVOB_DOC->D_SUMMA:= EVAL( Global_bVSumma,;
                                VCURS->VCURS,;
                                VALUTA->MYLTIPLY,;
                                SVOB_DOC->D_VSUMMA,;
                                1 ),;
                  dbUnlock() },;
              {|| UPPER(SVOB_DOC->D_VALUTA)<> UPPER(GlobalValuta) .AND. ;
                       SVOB_DOC->D_VCURS <> VCURS->VCURS .AND. RecLock() } )
      SETSCOPE()
      SVOB_DOC->( dbCloseArea() )
  ENDIF
RETURN
//
function ContsX()
   MemVar cPosBit
   do case
      case cPosBit ==  1 ; Return( 'Дата')
      case cPosBit ==  2 ; Return( 'Номер док-та')
      case cPosBit ==  3 ; Return( 'Дебетовый счет')
      case cPosBit ==  4 ; Return( 'Дебетовый код')
      case cPosBit ==  5 ; Return( 'Кредитовый счет')
      case cPosBit ==  6 ; Return( 'Кредитовый код')
      case cPosBit ==  7 ; Return( 'Сумма')
      case cPosBit ==  8 ; Return( 'Содержание')
   endcase
Return('')


 Function IncStep(cInc, nLenC)
//----------------------------------------------------------------------------//
// возвращает следущий номер операции
// cInc - уникальное (для треб. счетчика) имя
// nLenC - Длина строки если счетчик-строка
LOCAL nNoper := IF(EMPTY(nLenC), Glob_StepPlus( cInc, "INI\INI_CASH"), STR(Glob_StepPlus( cInc, "INI\INI_CASH"),nLenC,0) )
IF EMPTY(nNoper)
  IF EMPTY(nNoper := IF(EMPTY(nLenC), Glob_StepPlus( cInc, "INI\INI_CASH"), STR(Glob_StepPlus( cInc, "INI\INI_CASH"),nLenC,0)) )
    SayError( {'Ошибка формирования уникального номера !'})
    nNOper:=0
  ENDIF
ENDIF
RETURN nNoper