**************
*
*  Справочник партнёров
*
**************

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



#include "box.ch"
#include "inkey.ch"
#include "head_box.ch"
//#include "sc_all.ch"
#include "s_public.ch"
#include "s_refer.ch"
#include "ctscan_h.ch"


#define BOX_E Space(8)
#define BOX_D "╔═╗║╝═╚║"
#define BOX_S "┌─┐│┘─└│"
#define BOX_P "▄▄▄██▄██"


#DEFINE COL_BROWS1  IF(INST_COLOR,'w/b,n/w,,,w/b','w/n,n/w,,,w/n')



// Операции с aIn
#define SeekPos(xVal)  ASCAN(aString, PADR(xVal,10))
#define N_HELP_9   "14.1"     // справочник партнеров
#define COL_SHEADR   If(INST_COLOR,'gr+/b*,w+/n,,,w+/b*','n/w,w+/n,,,n/w')
#define COL_ACHOICE  If(M->INST_COLOR,'GR+/B*,W+/N,,,BG+/B*','N/W,W+/N,,, N+/W')
#translate HOT_CTRL(<x>,<nKey>,<bKey>,<nSort>)  =>  AADD(aHotKey\[1\],{<x>,<nKey>,<bKey>,<nSort>})
#translate _PARAM_STEP() => StepPlus( LOADPATH()+'INI\PARAM.INC', 0 )
// Значения флаг pедактиpования в InitList - nApp
#define    S_LIB_EDIT   1   // pедактиpование
#define    S_LIB_ADD    2   // дополнение
#define    S_LIB_FILTER 0   // ввод знач. для фильтpации
#define    S_LIB_PROSM -1   // пpосмотp

STATIC PrevOrder // служебная (предыдущий ORDSETFOCUS())
STATIC aNameFile:={}



//{|oGet| oGet := GetActive(),If(ValType(oGet) = "O" .AND. oGet:hasFocus ,(If( ReadInsert(),oGet:insert(CHR(255)),oGet:overStrike(CHR(255))),oGet:assign()),NIL) }
STATIC FUNCTION bInsKey_1(oGet)
 oGet := GetActive()
 If ValType(oGet) = "O" .AND. oGet:hasFocus
   If ReadInsert()
     oGet:insert(CHR(255))
   ELSE
     oGet:overStrike(CHR(255))
   ENDIF
   oGet:assign()
 ENDIF
Return(NIL)

//----------------------------------------------------------------------------//
// Справочник партнёров (используется в меню)
FUNCTION Spr_Partner()
//----------------------------------------------------------------------------//
FIELD CODE
LOCAL aSet := SaveSet(), aKey:=SaveSetKey()
LOCAL cHead
LOCAL nLeftBrd := 6
LOCAL cColHead
LOCAL aBlockCols
LOCAL nTop:=4
LOCAL nBottom:=21
LOCAL cCurProc:=NIL
LOCAL aHeadsF, aPictF, aRefF, aGetBlockF
LOCAL nAdr
LOCAL bInsKey := {|oGet|bInsKey_1(oGet)}
LOCAL nUniMode:=2
LOCAL bDelInit:={|| DelPart()}
LOCAL aPrint, aPrintKPP, aPrintFis
LOCAL aBase := {"PARTNER",{"PLAN","PLAN_SCH"},"TYPE_A","TYPE_P"}
LOCAL aHotKey := {{},{},{}}
LOCAL cColor:=COL_INPUT
PUBLIC aString:={}
PRIVATE cAdress1,cAdress2,cAdress3,cAdress4
PRIVATE pStatus,nGet,pCode, cStatusPg
PRIVATE cFAdres1,cFAdres2,cFAdres3,cFAdres4
MEMVAR->cAdress1 := MEMVAR->cAdress2 := MEMVAR->cAdress3 := MEMVAR->cAdress4 := SPACE(60)
MEMVAR->cFAdres1 := MEMVAR->cFAdres2 := MEMVAR->cFAdres3 := MEMVAR->cFAdres4 := SPACE(60)
MEMVAR->cStatusPg:=0
help_code := N_HELP_9

BEGIN SEQUENCE

dbOpenBases(aBase)
CreateMetka("PARTNER","G_METKA")

SELECT TYPE_A
OrdSetFocus("TAG_OPER")
SELECT TYPE_P
OrdSetFocus("TAG_OPER")
SELECT PARTNER
cHead:=' СПРАВОЧНИК ПАРТНЕРОВ '
cColHead:= '  Код         Hаименование                 Расчетный счет            '
aBlockCols:= {{{|| If(EMPTY(G_METKA->CREC)," ",CHR(251))}, 00},;
              {FIELDBLOCK('CODE'), 01},;
              {{|| LEFT(FIELD->SHORTNAME,25)}, 08},;
              {{|| LEFT(FIELD->RSCHET,30)}, 34};
             }
//DescrFilt(@aHeadsF, @aPictF, @aRefF, @aGetBlockF, .F., 0)

aPrint:={cHead,;
        {'Код'          ,'CODE'},;                              // 2
        {'Наименование' ,'SHORTNAME',REPLICATE("X",15)},;       // 3
        {'Наименование (полное)' ,'ORGNAME',REPLICATE("X",30)},;// 4
        {'Банк и его местоположение','BANK',REPLICATE("X",30)},;// 5
        {'Филиал банка','RECVIZIT',REPLICATE("X",30)},;         // 6
        {"БИК",'BNKKOD+" "+BNKKOD1',"XXXXXXXXXXXXXXX"},;        // 7
        {"Код участника",'CODE_UH','XXXXXXXXXXXXX'},;           // 8
        {"Код ИНН",'GetInn(CODE_PR)','XXXXXXXXXXXXXXX'},;       // 9
        {"Номер расчетного счета",'LEFT(RSCHET,30)',REPLICATE("X",30) },;
        {"Номер корр. счета",'LEFT(CORRSCHET,30)',REPLICATE("X",30) },;
        {"Адрес предприятия",'ADRESS',REPLICATE("X",40) },;
        {"Фактический адрес",'ADRES_FACT',REPLICATE("X",40) },;
        {"Доп.информация",'ADRESS2',REPLICATE("X",20) },;
        {"Код по ОКВЭД",'CODE_OKOHX','XXXXXXXXXXXX'},;
        {"Код по ОКПО",'CODE_OKPO','XXXXXXXXXXX'},;
        {"Код по ОКАТО",'OKATO','XXXXXXXXXXXXXXX'},;
        {"Вид деятельности",'VID_S'},;
        {"Телефон (юридич.адрес)",'If(!EMPTY(TELEFON1),TRANSFORM(TELEFON1,"@R (999999)-999-99-99"),"")','XXXXXXXXXXXXXXXXXXXXXXX'},;
        {"Телефон (фактич.адрес)",'If(!EMPTY(TELEFON2),TRANSFORM(TELEFON2,"@R (999999)-999-99-99"),"")','XXXXXXXXXXXXXXXXXXXXXXX'};
        }
If PLAN->(FieldPos("TYPE_A")) != 0
  ArIns(aPrint,16,{"Тип предприятия",'if(TYPE_A->(DBSEEK(PARTNER->TYPE_A)), PADR(TYPE_A->NAME,30),space(30))','REPLICATE("X",30)'})
EndIf
  ArIns(aPrint,16,{"Статус предприятия",'if(TYPE_P->(DBSEEK(PARTNER->STATUS_NP)), TYPE_P->CODE,"   ")','XXX'})
aPrintKPP:=ACLONE(aPrint)
ArIns(aPrintKPP, 10, {"Код КПП",'GetKPP(CODE_PR)','XXXXXXXXXXXX'})

aPrintFis:=ACLONE(aPrintKPP)
ArIns(aPrintFis, 5, {"Номер свидет. о регистр.",'NOM_S'})
ArIns(aPrintFis, 6, {"Дата регистр.",'DATE_S'})
ArIns(aPrintFis, 7, {"Начало срока действия",'BPERIOD'})
ArIns(aPrintFis, 8, {"Окончание срока действия",'EPERIOD'})
ArIns(aPrintFis, 9, {"Серия и номер паспорта",'PASSER+" "+PASNUM'})
ArIns(aPrintFis,10, {"Дата выдачи",'PASDATE'})
ArIns(aPrintFis,11, {"Кем выдан",'PASWERE'})

ScrMain()
ScrTitul(1,cHead)
ScrTitul(24,"┘:Правка F3:Сорт F4:Доб F5:Коп F6,ALT-F6:Фильтр F7,ALT-F7:Поиск F8:Удал F9:Печ.")

If GlobalTask<>"MG" //Serg
  ShadowBox('',03,03,22,77,COL_BROWSE)
Else
  Frame(, 03, 03, 22, 77, COL_BROWSE, 1, 1)
EndIf

ORDSETFOCUS("FULLCODE")  // по коду партнёра, все лица
//SetScope("STATUS",MEMVAR->pStatus)
dbGoTop()
SETKEY(K_F5, {|| CopyPartner()})
SETKEY(K_F6,{||1})
HOT_CTRL("F5:Специальные функции", K_CTRL_F5, {|| F_Eval(GlobalTask+"Spr_Part",'G_METKA')}, 1)
//SETKEY( K_CTRL_F5, {|| F_Eval(GlobalTask+"Spr_Part",'G_METKA') } )
SETKEY(K_INS, {|| SetIns(!EMPTY(G_METKA->CREC),"G_METKA"),__KEYBOARD(CHR(K_DOWN)),3 })
SETKEY(43, {|| SetInsAll(.F.,"G_METKA")})
SETKEY(45, {|| SetInsAll(.T.,"G_METKA")})
SETKEY(K_F4, {|| Edit_Partn(.F., .F.,,cColor)})
SETKEY(K_ENTER, {|| Edit_Partn(.T., .F., If(FIELD->STATUS==" ",aPrintKPP,aPrintFis),cColor)})
//////////
SETKEY(K_PGDN, {|| if( MEMVAR->cStatusPg<>0,;
 (MEMVAR->cStatusPg:=0,PARTNER->(if(!eof(),dbskip(),NIL)),;
 Edit_Partn(.T., .F., If(FIELD->STATUS==" ",aPrintKPP,aPrintFis),cColor)),;
 (PARTNER->(if(!eof(),dbskip(17),NIL),2))) })
//////////
SETKEY(K_PGUP, {|| if( MEMVAR->cStatusPg<>0,;
 (MEMVAR->cStatusPg:=0,PARTNER->(if(!bof(),dbskip(-1),NIL)),;
 Edit_Partn(.T., .F., If(FIELD->STATUS==" ",aPrintKPP,aPrintFis),cColor)),;
 (PARTNER->(if(!eof(),dbskip(-17),NIL),2))               )})
//////////
SETKEY(K_F9, {|| QPrint(If( YesOrNo('Выводить код КПП?'),;
                            aPrintKPP, aPrint))}) //MEMVAR->cStatusPg:=0
//         1      2        3          4          5
InitList(nTop, nBottom, cColHead, aBlockCols, cCurProc,;
;//        6        7      8         11        12
         aHeadsF, aRefF, aPictF,,,nUniMode, bDelInit,,;
;//          14              15          18           21
         fSortSeek(.F.), /*aPrint*/,,,aGetBlockF,,,nLeftBrd,,;
;//                          23                               28         30
         'cFind$UPPER(FIELD->SHORTNAME+FIELD->ADRESS)',,,,,"FULLCODE",,aHotKey)

DeleteMetka()
END SEQUENCE
dbCloseBases(aBase)
RestSet(aSet)
RestSetKey(aKey)
RETURN NIL

//----------------------------------------------------------------------------//
STATIC FUNCTION CopyPartner()
//----------------------------------------------------------------------------//
LOCAL aField[FCOUNT()]
If YesOrNo( "Копировать организацию ?" )
  Scatter(aField)
  QHelp(,,,,"CODE",,,,"FULLCODE",,.T.)
  // QHelp( ,,,,"CODE",,,{|| FIELD->STATUS := MEMVAR->pStatus },"FULLCODE",,.T.)
  //QHelp(,,,MEMVAR->pStatus,"CODE",,,{|| FIELD->STATUS:=MEMVAR->pStatus },"S_CODE",.T.,.T.)
  aField[1]:=FIELD->CODE
  PutNetRepl(aField)
  KEYBOARD CHR(K_ENTER)
EndIf
RETURN (2)

//----------------------------------------------------------------------------//
STATIC FUNCTION PrintPartner(aPrint)
//----------------------------------------------------------------------------//
LOCAL cFile:=TEMPFILE(GlobalTmpPath,"TXT"),i
LOCAL nHandle:=FCREATE(cFile), cVar
BEGIN SEQUENCE
If nHandle>0
  Str2File(PADC(aPrint[1],60),nHandle)
  Str2File("",nHandle)
  FOR i:=2 TO LEN(aPrint)
    cVar:=aPrint[i,2]
    Str2File(PADR(aPrint[i,1]+" ",30,".")+": "+TRANSFORM(&cVar,""),nHandle)
  NEXT
  FClose(nHandle)
  View(cFile)
EndIf
END SEQUENCE
RETURN (NIL)

//----------------------------------------------------------------------------//
STATIC FUNCTION DelPart()
//----------------------------------------------------------------------------//
LOCAL lRet:=.T.
LOCAL aBase := {{"PROVER","PROVER"}}
LOCAL aProver := {}, nPoz, cSeek, cKomment
dbOpenBases(aBase)
If PARTNER->STATUS = " "
  BEGIN SEQUENCE

  DBEVAL({|| If((nPoz := ASCAN(aProver,{|x| x[1] = UPPER(ALLTRIM(PROVER->PATH_DBF)+ALLTRIM(PROVER->NAME_DBF)) })) = 0,(AADD(aProver,{UPPER(ALLTRIM(PROVER->PATH_DBF)+ALLTRIM(PROVER->NAME_DBF)),{},PROVER->KOMMEN}),nPoz := LEN(aProver)),NIL),AADD(aProver[nPoz,2],PROVER->POL) })
  AEVAL(aProver,;
  {|x|;
    If(;
       NetUse("NEW",LoadPath()+x[1]),;
       (;
         ORDSETFOCUS(0),;
         cSeek := "",;
         AEVAL(x[2],{|cName| cSeek += ".OR.NEW->"+cName+"='"+PARTNER->CODE+"'" }),;
         If(TYPE(RIGHT(cSeek,LEN(cSeek)-4)) = "L",;
            (;
             __dbLocate(&("{||"+RIGHT(cSeek,LEN(cSeek)-4)+"}")),;
             If(FOUND(),(NEW->(dbCloseArea()),cKomment := x[3],BREAK(1)),NIL);
             ),;
            NIL;
           ),;
         NEW->(dbCloseArea());
        ),;
       NIL;
        );
     })
  RECOVER
    lRet:=SayError({"Данный код используется в "+ALLTRIM(cKomment)})
  END SEQUENCE
EndIf
dbCloseBases(aBase)
RETURN lRet

*****************************
STATIC FUNCTION DispPartner(cForma, lRefer)
// разрисовка произвольного расположения полей
LOCAL aHeadGet:={}
LOCAL cColor
LOCAL sHead:=If(MEMVAR->nApp==S_LIB_ADD," Новая запись "," Корректировка ")
cColor:=If(lRefer, COL_REF1, COL_INPUT)
Frame(sHead, 02, 01, 23, 78, cColor, 2, 1)
If cForma=='1'
// Юридическое лицо
  aHeadGet:={"Код .....................:",;
             "Hаименование ............:",;
             "Hаименование (полное)....:",;
             "Банк и его местоположение:",;
             "Филиал банка.............:",;
             "Код банка /БИК/..........:",;
             "Код участника ...........:           Код бюджетoполучателя:",;
             "Номер расчетного счета...:",;
             "Номер корр. счета........:",;
             "Код ИНН/КПП..............:",;
             "Адрес предприятия юридич.:",;
             "",;
             "",;
             "",;
             "Дополнительн. информация.:",;
             "Коды по ОКВЭД ...........:        по ОКПО:          по ОКАТО:",;
             "Телефон (юридич.адрес)...:                   (факт.адрес):",;
             "Вид деятельности ........:"}
Else
// физическое лицо
  aHeadGet:={"Код ....................:",;
             "Hаименование ...........:",;
             "Hаименование (полное) ..:",;
             "Номер свидет. о регистр.:             Дата регистр.:",;
             "Срок действия         с :                        по:",;
             "Вид деятельности .......:",;
             "Паспортные данные: серия:                     номер:",;
             "Выдан (дата) ...........:                       кем:",;
             "Банк и его местоположен.:",;
             "Филиал банка ...........:",;
             "БИК ....................:             Код банка .......:",;
             "Код участника ..........:             Код ИНН/КПП .....:",;
             "Расч.счет:                             Корр.счет:",;
             "Адрес предприятия юридич:",;
             " ",;
             " ",;
             "Дополнительн. информация:",;
             "Код по ОКВЭД ...........:             Код по ОКПО .......:",;
             "Телефон (юридич.адрес) .:                  (фактич.адрес):"}
EndIf
If PLAN->(FieldPos("TYPE_A")) != 0
  AADD(aHeadGet,"Тип предприятия...........:")
EndIf
if cForma=='1'
  AADD(aHeadGet,"Статус предприятия........:")
endif
AEVAL(aHeadGet,{|cStr, n| SetPos(n+2, 2), DispOut(cStr, cColor)})
RETURN NIL

***************************************
STATIC FUNCTION SelForm()
LOCAL nTop0, nLeft0, nRight0:=30
LOCAL cForma
LOCAL aSetKeys := SaveSetKey()  // сохранить и почистить все назначения клавиш, чтоб не мешались
nTop0 := ( MAXROW()- 3 )/2
nLeft0 := ( MAXCOL()-36 )/2
SETCOLOR(COL_REFER)
If _PARTFIS
// разрешить ввод новых физических лиц
  ShadowBox('',nTop0,nLeft0,nTop0+3,nLeft0+nRight0)
  cForma:=ACHOICE(nTop0+1,nLeft0+3,nTop0+2,nLeft0+nRight0-3, {"Юридическое лицо","Физическое лицо"})
  If !EMPTY(cForma)
    cForma:=NTOC(cForma)
  EndIf
Else
// не разрешать !
  cForma:='1' // юридическое лицо
EndIf
RestSetKey( aSetKeys )
RETURN cForma

*******************************
* Функция для блока
*
STATIC FUNCTION fPreGet(x3, bInsKey, cForma, lRefer, aPrint)
MEMVAR aString
InitListHelp(If(VALTYPE(aPrint)=="A","Ctrl-P:Факт.адрес F9:Печать ",NIL)) //,,,"NoPg")
If lRefer
  AEVAL(GetList,{|oGet| oGet:ColorSpec:="w+/n,n/w,,,w+/n"})
EndIf
SETKEY(309, bInsKey)  // + - (пометить всё или снять пометки)
SETKEY(270, bInsKey)
IF nApp==1
   SETKEY(K_PGDN, {||MEMVAR->cStatusPg:=1,hb_Keyput(K_F10),hb_Keyput(K_PGDN)})
   SETKEY(K_PGUP, {||MEMVAR->cStatusPg:=1,hb_Keyput(K_F10),hb_Keyput(K_PGUP)})
ENDIF
SETKEY(K_CTRL_P, {|| aIn[SeekPos("lSaveFact")]:=EditFactAdress()})
If VALTYPE(aPrint)=="A"
  SETKEY(K_F9, {|| PrintPartner(aPrint)})
EndIf
If MEMVAR->nApp == S_LIB_ADD .AND. !x3
  AEVAL(aIn, {|xVar,i| aIn[i] := BLANK(xVar,.T.)})
  AEVAL(GetList, {|oGet| oGet:display()})
  MEMVAR->cFAdres1 := MEMVAR->cFAdres2 := MEMVAR->cFAdres3 := MEMVAR->cFAdres4 := SPACE(60)
Else
  MEMVAR->cFAdres1:= SUBSTR(FIELD->ADRES_FACT,1,60)
  MEMVAR->cFAdres2:= SUBSTR(FIELD->ADRES_FACT,61,60)
  MEMVAR->cFAdres3:= SUBSTR(FIELD->ADRES_FACT,121,60)
  MEMVAR->cFAdres4:= SUBSTR(FIELD->ADRES_FACT,181,60)
  If MEMVAR->nApp = S_LIB_EDIT
    If cForma=='1'
    // Юридическое лицо
      aIn[SeekPos("cAdress1")] := SUBSTR(FIELD->ADRESS,1,60)
      aIn[SeekPos("cAdress2")] := SUBSTR(FIELD->ADRESS,61,60)
      aIn[SeekPos("cAdress3")] := SUBSTR(FIELD->ADRESS,121,60)
      aIn[SeekPos("cAdress4")] := SUBSTR(FIELD->ADRESS,181,60)
    Else
    // физическое лицо
      aIn[SeekPos("cAdress1")] := SUBSTR(FIELD->ADRESS,1,60)
      aIn[SeekPos("cAdress2")] := SUBSTR(FIELD->ADRESS,61,80)
      aIn[SeekPos("cAdress3")] := SUBSTR(FIELD->ADRESS,141,100)
    EndIf
  EndIf
EndIf
QHelp(,,SeekPos("CODE"),,"CODE",,,{|| FIELD->STATUS := MEMVAR->pStatus},"FULLCODE")
aLastIn := ACLONE(aIn)
RETURN NIL

Static Function bInsKey1(oGet)
 oGet := GetActive()
 If VALTYPE(oGet)=="O" .AND. oGet:hasFocus


   If ReadInsert()
    oGet:insert(CHR(255))
   else
    oGet:overStrike(CHR(255))
   endif
   oGet:assign()
 endif
Return(NIL)

*******************************
* Редактирование записи справочника партнеров
*
FUNCTION Edit_Partn(lNoAppend, lRefer, aPrint, cColor)
LOCAL cForma // тип партнера ('1'- юр.лицо, '2'- физ.лицо)
LOCAL bScrInit := {|| DispPartner(cForma, lRefer)}
LOCAL bPost := {|| FIELD->NNOPER:= _PARAM_STEP(), FIELD->STATUS := MEMVAR->pStatus,;
                   FIELD->ADRESS := MEMVAR->cAdress1+MEMVAR->cAdress2+MEMVAR->cAdress3+MEMVAR->cAdress4,;
                   FIELD->ADRES_FACT:=MEMVAR->cFAdres1+MEMVAR->cFAdres2+MEMVAR->cFAdres3+MEMVAR->cFAdres4}
LOCAL bPreGet
LOCAL bPostRead := {|lUpdate,nLastKey| ValidInn(lUpdate,nLastKey)}
LOCAL aHeads
LOCAL aRef := {}
LOCAL aGetBlock := {}
LOCAL aPict :={}
LOCAL aWhen := {}
LOCAL aValid:={}
LOCAL nPoz, nPoz2
LOCAL bInsKey := {|oGet|bInsKey1(oGet)}
LOCAL bakSeekPos:=SetSeekPos()
LOCAL nSelect:=SELECT()
PRIVATE aString, lSaveFact
lSaveFact:=.f.
If lNoAppend
// редактирование
  cForma:=If(FIELD->STATUS==" ",'1','2')
Else
// добавление
  cForma:=SelForm()
EndIf
If !EMPTY(cForma)
// был выбор
  ASIZE(aRef,1)
  ASIZE(aGetBlock,1)
  bPreGet:={|x1,x2,x3| ;
            fPreGet(x3, bInsKey, cForma, lRefer, aPrint)}
  If cForma=='1'
  // Юридическое лицо
    aHeads:={{{ 3,28},'CODE',"1","2","0"},;
             {{ 4,28},'SHORTNAME'    },;
             {{ 5,28},'ORGNAME'      },;
             {{ 6,28},'BANK'         },;
             {{ 7,28},'RECVIZIT'     },;
             {{ 8,28},'BNKKOD' ,"1","2","0"},;
             {{ 8,41},'BNKKOD1',"1","2","0"},;
             {{ 9,28},'CODE_UH',"1","2","0"},;
             {{ 9,61},'COD_BUD_P',"1","2","0"},;
             {{10,28},'RSCHET' ,"1","2","0"},;
             {{11,28},'CORRSCHET' ,"1","2","0"},;
             {{12,28},'CODE_PR',"1","2","0"},;
             {{13,28},'cAdress1',"1","0","0"},;
             {{14,28},'cAdress2',"1","0","0"},;
             {{15,28},'cAdress3',"1","0","0"},;
             {{16,28},'cAdress4',"1","0","0"},;
             {{17,28},'ADRESS2' ,"1","0","0"},;
             {{18,28},'CODE_OKOHX',"1","2","0"},;
             {{18,44},'CODE_OKPO',"1","2","0"},;
             {{18,63},'OKATO',"1","2","0"},;
             {{19,28},'TELEFON1',"1","2","0"},;
             {{19,60},'TELEFON2',"1","2","0"},;
             {{20,28},'VID_S'},;
             {{0,0}, 'lSaveFact'};
            }
    aPict := {"@KS30","@KS30","@KS49","@KS49","@KS49","@KS30","@KS30","@KS30","@KS30",;
              "@KS30","@KS30","@KS30","@KS50","@KS50","@KS50","@KS50",;
              "@KS30","@K XXXXXXXX","@K 9999999999","@K 999999999999999",;
              "@KR (999999)-999-99-99","@KR (999999)-999-99-99","@KS40"}
    MEMVAR->pStatus := " " // признак юр.лица
    MEMVAR->cAdress1 := MEMVAR->cAdress2 := MEMVAR->cAdress3 := MEMVAR->cAdress4 := SPACE(60)
  Else
  // физическое лицо
    aHeads:={{{ 3,27},'CODE'      ,"1","2","0"},;
             {{ 4,27},'SHORTNAME'  },;
             {{ 5,27},'ORGNAME'    },;
             {{ 6,27},'NOM_S'      },;
             {{ 6,54},'DATE_S'     },;
             {{ 7,27},'BPERIOD'    },;
             {{ 7,54},'EPERIOD'    },;
             {{ 8,27},'VID_S'      },;
             {{ 9,27},'PASSER'     },;
             {{ 9,54},'PASNUM'     },;
             {{10,27},'PASDATE'    },;
             {{10,54},'PASWERE'    },;
             {{11,27},'BANK'       },;
             {{12,27},'RECVIZIT'   },;
             {{13,27},'BNKKOD'    ,"1","0","0"},;
             {{13,58},'BNKKOD1'   ,"1","0","0"},;
             {{14,27},'CODE_UH'   ,"1","0","0"},;
             {{14,58},'CODE_PR'   ,"1","2","0"},;
             {{15,12},'RSCHET'    ,"1","2","0"},;
             {{15,51},'CORRSCHET' ,"1","2","0"},;
             {{16,27},'cAdress1'  ,"1","0","0"},;
             {{17,2},'cAdress2'  ,"1","0","0"},;
             {{18,2},'cAdress3'  ,"1","0","0"},;
             {{19,27},'ADRESS2'   ,"1","0","0"},;
             {{20,27},'CODE_OKOHX',"1","2","0"},;
             {{20,60},'CODE_OKPO' ,"1","2","0"},;
             {{21,27},'TELEFON1'  ,"1","2","0"},;
             {{21,60},'TELEFON2'  ,"1","2","0"},;
             {{0,0}, 'lSaveFact'};
            }
//                 1          2        3             4               8        9       10
    aPict := {"@K XXXXXX", "@KS25", "@KS51", "@K XXXXXXXXXXXX",,,,"@KS40", "@KS17", "@KS17",,;
              "@KS24", "@KS51", "@KS51", "@K XXXXXXXXXXXX", "@K XXXXXXXXXXXX", "@K XXXXXXXXX",;
              "@KS20", "@KS28", "@KS27", "@KS51", "@KS76", "@KS76", "@KS51", "@K XXXXXXXX",;
              "@K 9999999999", "@KR (999999)-999-99-99", "@KR (999999)-999-99-99"}
    MEMVAR->pStatus := "1"   //  признак физ.лица
    MEMVAR->cAdress1 := MEMVAR->cAdress2 := SPACE(80)
    MEMVAR->cAdress3 := SPACE(80)
    MEMVAR->cAdress4 := ""
  EndIf
  aString := SetSeekPos(A_Col(aHeads, 2))
  ASIZE(aWhen,LEN(aHeads))
  aValid := {{|| If(MEMVAR->nApp==S_LIB_FILTER, .T., !EMPTY(aIn[SeekPos("CODE")]))},;
             {|| If(EMPTY(aIn[SeekPos("ORGNAME")]), aIn[SeekPos("ORGNAME")]:=PADR(aIn[SeekPos("SHORTNAME")],LEN(aIn[SeekPos("ORGNAME")])),), !Empty(aIn[SeekPos("SHORTNAME")])};
            }
  ASIZE(aValid,LEN(aHeads))

  If PLAN->(FIELDPOS("TYPE_A")) != 0
    AADD(aHeads, {if(cForma=='1',{21,28},{22,27}),'TYPE_A'})
    SELECT TYPE_A
    ORDSETFOCUS("TAG_OPER")
    nPoz := LEN(aHeads)
    TYPE_A->(MakeTypeA('TYPE_A',If(TYPE_A->(dbGoTop(), !BOF()),1,2),,,,,nPoz,.T.))
    TYPE_A->(MakeTypeA('SEEK_TYPE_A',3,,{"NAME"},{"aIn[1]"}))
    ASIZE(aRef,nPoz)
    ASIZE(aGetBlock,nPoz)
    ASIZE(aPict,nPoz)
    ASIZE(aValid,nPoz)
    aRef[nPoz] := 'TYPE_A'
    aValid[nPoz] := {|| .T.}
    If cForma=='1'
      aPict[nPoz] := "@S30"
    Else
      aPict[nPoz] := "@S51"
    EndIf
    aGetBlock[nPoz] := {|x, oGet|GetNoError(x,oGet,1), PADR(TYPE_A->NAME,30)  }
  EndIf
  If cForma=='1' //.and. PLAN->(FIELDPOS("STATUS_NP")) != 0
    AADD(aHeads, {{22,28},'STATUS_NP'})
    SELECT TYPE_P
    ORDSETFOCUS("TAG_OPER")
    nPoz2 := LEN(aHeads)
    TYPE_P->(MakeTypeB('TYPE_P',2,,,,,nPoz2,.T.))
    //TYPE_P->(MakeTypeB('TYPE_P',If(TYPE_P->(dbGoTop(), !BOF()),1,2),,,,,nPoz2,.T.))
    TYPE_P->(MakeTypeB('SEEK_TYPE_P',3,,{"NAME"},{"aIn[1]"}))
    ASIZE(aRef,nPoz2)
    ASIZE(aGetBlock,nPoz2)
    ASIZE(aPict,nPoz2)
    ASIZE(aValid,nPoz2)
    aRef[nPoz2] := 'TYPE_P'
    aValid[nPoz2] := {|| DispOutAt(22,32,LEFT(TYPE_P->NAME,46),cColor),.T.}
    aPict[nPoz2] := "@S2"
    aGetBlock[nPoz2] := {|x, oGet|GetNoError(x,oGet,2), TYPE_P->CODE   }
   if select('SPRAW')<>0  .AND. SPRAW->(FIELDPOS('STATUS_NP'))>0
    bPreGet:={|x1,x2,x3| fPreGet(x3, bInsKey, cForma, lRefer, aPrint), DispOutAt(22,32,if(TYPE_P->(dbSeek(SPRAW->STATUS_NP)),LEFT(TYPE_P->NAME,46),space(46)),cColor) }
   else
    bPreGet:={|x1,x2,x3| fPreGet(x3, bInsKey, cForma, lRefer, aPrint), DispOutAt(22,32,if(TYPE_P->(dbSeek(PARTNER->STATUS_NP)),LEFT(TYPE_P->NAME,46),space(46)),cColor) }
   endif
//    aGetBlock[nPoz2] := {|x, oGet| MEMVAR->nGet:=oGet:Name[3],;
//                                  If(x != NIL .AND. EMPTY(x), aIn[oGet:Name[3]] := 0, NIL),;
//                                  TYPE_P->(DBSEEK(aIn[oGet:Name[3]]), PADR(TYPE_P->NAME,50));
//                       }
  EndIf

    aWhen[SeekPos("lSaveFact")]:={|| .f.}
    aGetBlock[SeekPos("lSaveFact")]:={|| ""}

  SELECT(nSelect)  // справочник партнёров
  ASIZE(aGetBlock, LEN(aHeads))
  //     1 2 3  4     5                  6    7     8
  QInput(2,9,23,69, aHeads,If(lNoAppend,1,2),aRef,aPict,,;
  ;//      10         12       13        16         19
         aValid, 2, bScrInit, bPost,,,aGetBlock,,,bPreGet,;
  ;//                   20     Во избежание цикла при вводе             21         22
         If(lRefer, {|lSaveFlagArray,lUpdated,_nMore| _nMore:=-1},),"FULLCODE", lNoAppend,;
  ;//         23
           lRefer/*lNoRestScreen*/,,,,bPostRead)
EndIf

SetSeekPos(bakSeekPos)
RETURN NIL

// уход от ошибки сборки версии
Static Procedure GetNoError(x,oGet,n)
 MEMVAR->nGet:=oGet:Name[3]
 If x != NIL .AND. EMPTY(x)
  aIn[oGet:Name[3]] := 0
 Endif
 IF n == 1
   TYPE_A->(DBSEEK(aIn[oGet:Name[3]]))
 Else
  TYPE_P->(DBSEEK(aIn[oGet:Name[3]]))
 Endif
Return

//!!!!!!!!!!!!!!!!!!!!!!!!
Function ValidInn(lUpdate,nLastKey)
  Local lOk:=.T.
  If nLastKey#27.and.!Empty(aIn[12]).and.aIn[12]!=alastIn[12]
     DbPush(,"TAG_INN")
     If DbSeek(Upper(aIn[12]))
        If YesOrNo({"Указанный код ИНН уже существует",;
                    "в карточке партнера - "+FIELD->SHORTNAME,;
                    "Продолжить сохранение ?"})
           lOk:=.T.
        Else
           lOk:=.F.
        EndIf
     EndIf
     DbPop()
  EndIf
Return lOk

//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!//
*********
* Объявление справочника партнёров
*                       1    2       3      4      5       6       7      8        9
FUNCTION ReferPartSet(cRef, aVar, aField, nType, cMess, cKeyVal, lEdit, bSelect, nType_A, lSpec, bYesArray)
//   cRef      - имя refer'а
// [ aVar    ] - массив имен переменных (строки)(aIn'ы), в которые пишутся значения из полей справочника
// [ aField  ] - массив имен полей справочника (строки или блоки кода), из которых пишутся значения в переменные в aVar
// [ nType   ] - тип справочника
// [ cMess   ] - строка, которая высвечивается при активизации соответствующего Get-объекта, по умолчанию: "F2:Справочник" (см. параметр cHelp в функции MakeRefer())
// [ cKeyVal ] - выражение в виде символьной строки для вычисления ключа при поиске записи в справочнике (см.функцию MakeRefer()) (можно поставить aIn[] для начального поиска)
// [ lEdit   ] - возможность редактирования и добавления записей в справочнике (ПО УМОЛЧАНИЮ .T.)
// [ bSelect ] - блок кода, после выбора записи справочника по клавише ENTER, но до заполнения полей aVar
// [ nType_A ] - тип предприятия для дополнительной фильтрации отображаемых партнёров
// [ lSpec   ] - если указан, то вход без запоминания индексов
// bYesArray - понадобился выбор списка партнеров azat 22.08.2005
//----------------------------------------------------------------------------//
LOCAL aSortSeek
LOCAL cColor:= COL_REF1
LOCAL bPreDisp,bPostDisp

If nType==NIL
  nType:=1
EndIf
If cKeyVal==NIL
  cKeyVal:="UPPER(CODE)"
EndIf
If lEdit==NIL
  lEdit:=.T.
EndIf
If bSelect==NIL
  bSelect:={|| NIL}
EndIf
If nType_A==NIL
// тип предприятия не определён
  nType_A:=0 // тип предприятия любой
EndIf
aSortSeek:=fSortSeek(.T.)



IF lSpec==NIL
  bPreDisp:={|| PrevOrder:=OrdSetFocus(), SetLastKey(K_DOWN), {RestIndex("SPRPART")}}
  bPostDisp:={|lEndDisp, nOrder| If(nOrder == NIL,,ORDSETFOCUS(nOrder)), PartClrSc(nType_A), SaveIndex("SPRPART"),;
  If(LASTKEY() == K_ENTER, EVAL(bSelect),),;
  OrdSetFocus(PrevOrder)}
ELSE
  bPostDisp:={||If(LASTKEY() == K_ENTER, EVAL(bSelect),)}
ENDIF

        //  1             2                 3
MakeRefer(cRef, " СПРАВОЧHИК ПАРТHЕРОВ ", nType,;
         ;//                  4                               5
          {"Код","Кpаткое наименование","Расчетный счет"}, {8,11,9},;
         ;//  6        7      8      9
          COL_REFER, aField, aVar, cKeyVal,;
         ;//                     10
          {{|| FIELD->CODE},{|| PADR(FIELD->SHORTNAME, 25)},;
           {|| LEFT(FIELD->RSCHET, 25)}},;
          aSortSeek,; // 11
;//    12             13         14         15          16
/* aInputHeads*/, /*aPict*/, /*aWhen*/, /*aValid*/, /*bPost*/,;
;//                   17   bPreDisp
bPreDisp,; // восстановить порядок сортировки
;//              18    bPostDisp
bPostDisp,;
;//                        21
/*19*/,/*20*/,{,,,,,,,,,,,,,,,,,,,"TYPE_A"},;
;// 22        23
  cMess,{|| CoProc(lEdit,nType_A,cColor)},,,,;
;//           27                       28              31
'cFind $ UPPER(FIELD->SHORTNAME)',"FULLCODE",,,{|| PartSetSc(nType_A)}/*bDispSpr*/,;
;// 32                    45        47            50
bYesArray,,,,,,,,,,,,,/*.T.*/,,"FULLNAME",,,"F6:Фильт")
RETURN NIL

*******************************
* Установка Scope в bDispSpr
*
STATIC FUNCTION PartSetSc(nType_A)
// nType_A - тип предприятия (0 - любой)
LOCAL aOrder, cOrd, cVid, lAlt, cType_A
STATIC cOldPath:=""
If !(cOldPath==LoadPath())
// снятие фильтра по партнёру при любой смене предприятия
  fBlockSeek(, If(nType_A>0,3,1))
  VidPartner("*")
  cOldPath:=LoadPath()
EndIf
/* снятие фильтра при смене предприятия в зависимости от настройки
If !_PARTFIS
// не разрешен ввод физических лиц
  dbPush()
  ORDSETFOCUS("S_CODE")  // статус партнёра + код
  If !DBSEEK("1")
  // нет физических лиц
    fBlockSeek(, If(nType_A>0,3,1))
    VidPartner("*")
  EndIf
  dbPop()
EndIf
*/
cVid:=VidPartner()
cOrd:=ORDNAME()          // текущий ордер (из набора базовый(№1) либо №2)
aOrder:=AltOrder(.T.,2)  // выдать набор ордеров №2 (с полем STATUS)
lAlt:=(ASCAN(aOrder, {|x| x==cOrd})>0) // признак принадлежности набору №2
cType_A:=STR(nType_A,17,0)
fReferSeek(.F., nType_A)
Do Case
  Case   cVid=="*"  .AND. nType_A==0
  // партнёр не фиксирован, тип предприятия тоже
    If lAlt .OR. ASCAN(AltOrder(.T.,1), {|x| x==cOrd})==0
    // если ордер из набора #2 или неправильный (не из 2 и не из 1-го набора)
      ORDSETFOCUS(AltOrder(cOrd,2,1))
    EndIf
  Case   cVid=="*"  .AND. nType_A>0
  // партнёр не фиксирован, тип предприятия фиксирован
    ORDSETFOCUS(AltOrder(cOrd,If(lAlt,2,1),3))
    SetScope("STR(FIELD->TYPE_A,17,0)",cType_A,,AltOrder(.T.,3)) // поставить фильтр по типу предприятия
  Case !(cVid=="*") .AND. nType_A==0
  // партнёр фиксирован, тип предприятия нет
    If !lAlt
      ORDSETFOCUS(AltOrder(cOrd,1,2))
    EndIf
    SetScope("FIELD->STATUS",cVid,,aOrder) // поставить фильтр по виду партнёра
  Case !(cVid=="*") .AND. nType_A>0
  // партнёр фиксирован, тип предприятия тоже
    ORDSETFOCUS(AltOrder(cOrd,If(lAlt,2,1),4))
    SetScope("FIELD->STATUS+STR(FIELD->TYPE_A,17,0)",cVid+cType_A,,AltOrder(.T.,4)) // поставить фильтр по виду партнёра+типу предприятия
EndCase
If (!(cVid=="*") .AND. !(FIELD->STATUS==cVid)) .OR. (nType_A>0 .AND. !(FIELD->TYPE_A==nType_A))
// текущая запись не в Scope
  GO TOP
EndIf
RETURN NIL

*******************************
* Снятие Scope в bpostDisp
*
STATIC FUNCTION PartClrSc(nType_A)
// nType_A - тип предприятия (0 - любой)
LOCAL cOrd
If nType_A>0
  cOrd:=ORDNAME()    // текущий ордер (из набора №3 либо №4)
  If VidPartner()=='*'
  // партнёр не фиксирован
    ORDSETFOCUS(AltOrder(cOrd,3,1))
  Else
  // партнёр фиксирован
    ORDSETFOCUS(AltOrder(cOrd,4,2))
  EndIf
EndIf
SetScope()
RETURN NIL

*******************************
*  Сопроцедура для выбора из справочника партнёров.
*
STATIC FUNCTION CoProc(lEdit, nType_A,cColor)
LOCAL aHeadsF, aPictF, aRefF, aGetBlockF
LOCAL aSet, nLastKey, cString, nSelect
//STATIC cVidPart
nLastKey:=LASTKEY()
If lEdit
  @21,51 SAY 'F4:Ввод Ctrl'+CHR(17)+'┘:Прав' COLOR COL_REFER
  If nLastKey==K_F4 .OR. nLastKey==K_CTRL_ENTER
    PRIVATE pStatus,nGet
    PRIVATE cAdress1,cAdress2,cAdress3,cAdress4
    PRIVATE cFAdres1,cFAdres2,cFAdres3,cFAdres4
    aSet := SaveSet()
    nSelect:=SELECT()
    If (SELECT("TYPE_A")>0.OR.NetUse("TYPE_A","TYPE_A")).AND.(SELECT("PLAN")>0.OR.NetUse("PLAN","PLAN_SCH")) .AND. (SELECT("TYPE_P")>0.OR.NetUse("TYPE_P","TYPE_P"))
      TYPE_P->(OrdSetFocus("TAG_OPER"))
      SELECT(nSelect)
      Edit_Partn(nLastKey==K_CTRL_ENTER, .T.,,cColor)
    EndIf
    RestSet(aSet)
    QIni(,2,.F.) // обновить экран справочника
  EndIf
EndIf


/******************

If nLastKey==K_F6


  //PRIVATE cTmpVid:=cVidPart
  aSet := SaveSet()
  DescrFilt(@aHeadsF, @aPictF, @aRefF, @aGetBlockF, .T., nType_A)
  QInitPush()  //     5     6  7      8        9          10
  QInput(1,10,23,70,aHeadsF,0,aRefF,aPictF,,,;
  ;//           16             22
         ,,,,,aGetBlockF,,,,,,,.T.,,,,,,,)
  QInitPop()
  RestSet(aSet)
  GO TOP    // могли стоять на отфильтрованной записи (возможно, для того, чтобы не улетать, надо поставить SETKEY() в bPreDisp)
  QIni(,2,.F.) // обновить экран справочника
Else
  If LASTKEY()==K_CTRL_F6  //!(cVidPart=="").AND.!(ORDNAME()=="MY_FILTER")
                           // возможен сброс фильтра и при установке фильтра, если нет данных, удовлетворяющих условию
                           // и при поиске и при CTRL-F6 и, возможно, другие
  // Это другой фильтр, оставили сброс только по CTRL-F6
    //cVidPart:=""   // этот сброс также происходит при повторном входе в справочник
    //@8,37 SAY "═══════════════════" COLOR COL_REFER
    If !(VidPartner()=="*")
    // задан вид партнёра
      SetScope()
      If nType_A>0
      // задан тип предприятия
        ORDSETFOCUS(AltOrder(ORDNAME(),4,3))
        SetScope("STR(FIELD->TYPE_A,17,0)",STR(nType_A,17,0),,AltOrder(.T.,3)) // поставить фильтр по типу предприятия
        fBlockSeek(, 3)
      Else
      // не задан
        ORDSETFOCUS(AltOrder(ORDNAME(),2,1))
        fBlockSeek(, 1)
      EndIf
      VidPartner("*")
      QIni(,2,.F.) // обновить экран справочника
    EndIf
  EndIf
EndIf
********************************/

Do Case
  Case VidPartner()==" "
    cString:="СПРАВОЧHИК ПАРТHЕРОВ - юридические лица "
    @8,15 SAY cString COLOR "GR+/W"
  Case VidPartner()=="1"
    cString:="СПРАВОЧHИК ПАРТHЕРОВ - физические лица "
    @8,15 SAY cString COLOR "GR+/W"
  OtherWise
    cString:="СПРАВОЧHИК ПАРТHЕРОВ  ═══════════════════"
    @8,15 SAY cString COLOR COL_REFER
EndCase
//@8,37 SAY cString COLOR "GR+/W" //COL_REFER
RETURN NIL


*******************************
* Массив для сортировки
*
STATIC FUNCTION fSortSeek(lRefer)
//MEMVAR cTmpVid
LOCAL aSortSeek:={;//       1                                  2                       3                    4                 5           6   7          8               ордера для поиска по статусу партнёра
                  {'- по коду партнера             ' ,'Укажите код'            , 'UPPER(FIELD->CODE)', 'fReferSeek(.F.)'   , '@K'      ,'.T.','',{|| fBlockSeek("FULLCODE")}},;    // S_CODE
                  {'- по наименованию              ' ,'Введите  наименование'  , 'FIELD->SHORTNAME'  , 'fReferSeek(.T.)'   , '@KS25'   ,'.T.','',{|| fBlockSeek("FULLNAME")}},;    // S_NAME
                  {'- по расч.счету                ' ,'Введите расч.счет'      , 'FIELD->RSCHET'     , 'fReferSeek(.T.)'   , '@KS18'   ,'.T.','',{|| fBlockSeek("FULLRSCHET")}},;  // S_RSCHET
                  {'- по коду ИНН                  ' ,'Введите код ИНН'        , 'FIELD->CODE_PR'    , 'fReferSeek(.T.)'   , '@KS18'   ,'.T.','',{|| fBlockSeek("FULTAG_INN")}},;  // S_TAG_INN
                  {'- по виду+коду партнера        ' ,                         , 'FIELD->STATUS'     ,                ,           ,'.T.','',"S_CODE",,,,,,,.T.};   // S_CODE (не меняется)
                 } //                                                                                                                                      15
If !lRefer       //         1                                  2                       3                   4             5           6         7          8      9   10        11            12
  AADD(aSortSeek, {'- по типу предприятия          ' ,'Введите тип предприятия','FIELD->NAME'        , 'UPPER(aIn[1])','@KS18'    ,'.T.',"SEEK_TYPE_A","TAG_NAME",,"TYPE_A","_NAME","STR(TYPE_A->NNOPER,17,0)"})
EndIf //                    1                                  2                       3                   4                 5            6   7          8
AADD(aSortSeek,   {'- по номеру свид. о регистрации' ,'Введите номер'          ,'FIELD->NOM_S'       , 'fReferSeek(.T.)'   ,'@K'       ,'.T.','',{|| fBlockSeek("NOM_SVIDET")}})   // S_NSVIDET
AADD(aSortSeek,   {'- по серии паспорта'             ,'Введите серию паспорта' ,'FIELD->PASSER'      , 'fReferSeek(.T.)'   ,'@K'       ,'.T.','',{|| fBlockSeek("PASSP_SER" )}})   // S_SERPASSP
AADD(aSortSeek,   {'- по номеру паспорта'            ,'Введите номер паспорта' ,'FIELD->PASNUM'      , 'fReferSeek(.T.)'   ,'@K 999999','.T.','',{|| fBlockSeek("PASSP_NUM" )}})   // S_NUMPASSP
RETURN aSortSeek

*******************************
* Выражение поиска для aSortSeek
*
FUNCTION fReferSeek(lTrim, nType_A)
/*
   lTrim - признак обрезки значения
   nType_A - тип предприятия (0 - любой) (если задать, то в дальнейшем запоминается)
 */
STATIC cType_A:=""
LOCAL cPrefix
cPrefix:=VidPartner()
If cPrefix=="*"
  cPrefix:=""
EndIf
If VALTYPE(nType_A)=="N"
  If nType_A>0
    cType_A:=STR(nType_A,17,0)
  EndIf
  RETURN NIL  // Нельзя лезть в чужой aIn[1]
EndIf
RETURN cPrefix+cType_A+UPPER(If(lTrim,RTRIM(aIn[1]),aIn[1]))
*******************************
* Функция для блока кода для имени ордера для aSortSeek
*
STATIC FUNCTION fBlockSeek(cOrd, n)
/*
  cOrd   - основной ордер для aSortSeek
[ n    ] - если задано, переключает набор ордеров по указанному номеру для последующей выдачи нужного имени ордера
*/
STATIC nAltOrd:=1  // номер набора ордеров
LOCAL cRet
If VALTYPE(n)=='N'
  nAltOrd:=n
EndIf
If VALTYPE(cOrd)=='C'               // ДОДЕЛАТЬ ФУНКЦИЮ !!!!!
  cRet:=If(nAltOrd>1, AltOrder(cOrd,1,nAltOrd), cOrd)
EndIf
RETURN cRet

*******************************
*  Описание фильтра
*                             1       2       3        4          5      6
STATIC PROCEDURE DescrFilt(aHeadsF, aPictF, aRefF, aGetBlockF, lBlock, nType_A)
//MEMVAR cTmpVid
LOCAL lPartner:=.T.  // признак наличия поля с видом партнёра в фильтре
LOCAL aVidPart:={{' ','Юридическое лицо'},;
                 {'1','Физическое лицо '}}
LOCAL bakSeekPos:=SetSeekPos()

aHeadsF:={;
 { "Код ......................:",'CODE',,"2","0"},;
 { "Hаименование .............:",'SHORTNAME'    },;
 { "Hаименование (полное).....:",'ORGNAME'      },;
 { "Банк и его местоположение.:",'BANK'         },;
 { "Филиал банка..............:",'RECVIZIT'     },;
 { "Код банка /БИК/...........:",'BNKKOD' ,,"2","0"},;
 { "                           ",'BNKKOD1',,"2","0"},;
 { "Код участника ............:",'CODE_UH',,"2","0"},;
 { "Номер расчетного счета....:",'RSCHET' ,,"2","0"},;
 { "Номер корр. счета.........:",'CORRSCHET' ,,"2","0"},;
 { "Код ИНН/КПП...............:",'CODE_PR',,"2","0"},;
 { "Код по ОКВЭД..............:",'CODE_OKOHX',,"2","0"},;
 { "Код по ОКПО...............:",'CODE_OKPO',,"2","0"},;
 { "Телефон (юридич.адрес)....:",'TELEFON1',,"2","0"},;
 { "Телефон (фактич.адрес)....:",'TELEFON2',,"2","0"},;
 { "Номер свидет. о регистр...:",'NOM_S',,"2","0"},;
 { "Дата регистрации..........:",'DATE_S'},;
 { "Начало срока действия.....:",'BPERIOD'},;
 { "Окончание срока действия..:",'EPERIOD'},;
 { "Вид деятельности..........:",'VID_S',,"2","0"};
         }
If !_PARTFIS
// не разрешен ввод физических лиц
  lPartner:=.F.
  dbPush()
  ORDSETFOCUS("S_CODE")  // статус партнёра + код
  If DBSEEK("1")
  // есть физические лица
    lPartner:=.T.
  EndIf
  dbPop()
EndIf
If lPartner
  ArIns(aHeadsF,1,{ "Вид партнера..............:",'STATUS',"0","2","0",NIL})
  If lBlock
    aHeadsF[1,6]:={|| fNewFilt(nType_A), NIL}
  EndIf
EndIf


altd()

aString := SetSeekPos(A_Col(aHeadsF, 2))

aPictF := ARRAY(LEN(aHeadsF))
AFILL(aPictF, "@KS30")
aPictF[SeekPos("CODE_OKOHX")]:="@K 99999"
aPictF[SeekPos("CODE_OKPO")]:="@K 9999999999"
aPictF[SeekPos("TELEFON2")]:=aPictF[SeekPos("TELEFON1")]:="@KR (999999)-999-99-99"
aPictF[SeekPos("DATE_S")]:=""
aPictF[SeekPos("BPERIOD")]:=""
aPictF[SeekPos("EPERIOD")]:=""

aRefF := ARRAY(LEN(aHeadsF))
If lPartner
  aRefF[SeekPos("STATUS")]:={|oGet| RotateAndReader(oGet,aVidPart)}
EndIf

aGetBlockF := ARRAY(LEN(aHeadsF))
If lPartner
  aGetBlockF[SeekPos("STATUS")]:={|x| RotateBlock(x,aVidPart,'aIn['+NTOC(SeekPos("STATUS"))+']')}
EndIf
SetSeekPos(bakSeekPos)
RETURN

*******************************
*  Установка второго фильтра на вид партнёра
*
STATIC FUNCTION fNewFilt(nType_A)
/*
 Работа функции осуществляется в среде окна установки фильтра в справочнике партнёров
 */
LOCAL cOrd
If aIn[1]==" " .OR. aIn[1]=="1"
// ставится фильтр на юридическое или физическое лицо
  cOrd:=ORDNAME()
  If cOrd=="MY_FILTER"
    SayError({"Прежде, чем ставить фильтр на вид партнера,",;
              "снимите уже имеющийся фильтр.",;
              "CTRL-F6 - снятие фильтра."})
  Else
    If nType_A>0
      SetScope()
      ORDSETFOCUS(AltOrder(cOrd,3,4))
      SetScope("FIELD->STATUS+STR(FIELD->TYPE_A,17,0)",aIn[1]+STR(nType_A,17,0),,AltOrder(.T.,4))
      fBlockSeek(, 4)
    Else
      ORDSETFOCUS(AltOrder(cOrd,1,2))
      SetScope("FIELD->STATUS",aIn[1],,AltOrder(.T.,2))
      fBlockSeek(, 2)
    EndIf
    VidPartner(aIn[1])
  EndIf
EndIf
RETURN .T.

*******************************
* Возвратить или установить вид партнёра
*
STATIC FUNCTION VidPartner(cVid)
STATIC cSaveVid:="*"
If VALTYPE(cVid)=="C"
  If cVid==" " .OR. cVid=="1"
    cSaveVid:=cVid
  Else
    cSaveVid:="*"
  EndIf
EndIf
RETURN cSaveVid

*******************************
*  Выдача ордера для смены
*
STATIC FUNCTION AltOrder(cOrd, n1, n2)
/* cOrd - исходный ордер (если это логическое значение, то просто выдать массив ордеров под номером n1)
   n1   - номер набора ордеров для исходного ордера
   n2   - номер набора ордеров для целевого ордера
*/
LOCAL nOrder
/* Наборы ордеров: 1 - базовый
                   2 - S_<...>  (выражения начинаются со STATUS                 )
                   3 - _<...>   (выражения начинаются с  STR(TYPE_A,17,0)        )
                   4 - ST_<...> (выражения начинаются со STATUS+STR(TYPE_A,17,0) )
 */
//              базовый(№1)  альт. №2     альт. №3    альт. №4
LOCAL aOrder:={{"FULLCODE"  ,"S_CODE"    ,"_CODE"    ,"ST_CODE"   },;
               {"FULLNAME"  ,"S_NAME"    ,"_NAME"    ,"ST_NAME"   },;
               {"FULLRSCHET","S_RSCHET"  ,"_RSCHET"  ,"ST_RSCHET" },;
               {"FULTAG_INN","S_TAG_INN" ,"_TAG_INN" ,"ST_TAG_INN"},;
               {"S_CODE"    ,"S_CODE"    ,"_SCODE"   ,"ST_CODE"   },;
               {"NOM_SVIDET","S_NSVIDET" ,"_NSVIDET" ,"ST_NSVIDET"},;
               {"PASSP_SER" ,"S_SERPASSP","_SERPASSP","ST_SERPASP"},;
               {"PASSP_NUM" ,"S_NUMPASSP","_NUMPASSP","ST_NUMPASP"};
              }
If VALTYPE(cOrd)=='L'
  // выдать набор ордеров
  RETURN A_Col(aOrder,n1)
EndIf
cOrd:=UPPER(ALLTRIM(cOrd))
nOrder:=ASCAN(aOrder, {|x| x[n1]==cOrd})  // поиск исходного ордера
If nOrder==0
//  если стоял непредусмотренный ордер
  nOrder:=1
EndIf
RETURN aOrder[nOrder,n2]

********************************
STATIC FUNCTION EditFactAdress()
LOCAL aSet := SaveSet(), aKey:=SaveSetKey()
LOCAL cOldFAdr:=MEMVAR->cFAdres1+MEMVAR->cFAdres2+MEMVAR->cFAdres3+MEMVAR->cFAdres4
PRIVATE GetList:={}
  ShadowBox('Фактический адрес',7,9,14,72,COL_BROWSE)
  @  9,11 GET MEMVAR->cFAdres1 PICTURE '@SK60'
  @ 10,11 GET MEMVAR->cFAdres2 PICTURE '@SK60'
  @ 11,11 GET MEMVAR->cFAdres3 PICTURE '@SK60'
  @ 12,11 GET MEMVAR->cFAdres4 PICTURE '@SK60'
  READ
RestSet(aSet)
RestSetKey(aKey)
RETURN cOldFAdr<>MEMVAR->cFAdres1+MEMVAR->cFAdres2+MEMVAR->cFAdres3+MEMVAR->cFAdres4



FUNCTION CreateMetka(alias,alias_metka,aStruct,cKeyIdx,cKeyIdx1,cKeyIdx2,bRelation,cKeyIdx3)
//-----------------------------------------------------------------------------//
/*
  Создание временного файла, в том числе для вывода меток
и его монопольное открытие с алиасом alias_metka , по умолчан "METKA_".
  Возвращает имя с путем временного файла (без расширения).
Если указан alias, то устанавливается с ним связь.
 [ aStruct]  - описание структуры создаваемой базы (по умолчанию стандартная
              структура файла пометок)
 [ cKeyIdx]  - выражение 1-го индекса (по умолчанию - стандартное для метки,
              для отсутствия сделать пустую строку)
 [bRelation] - блок кода выполняемый после открытия базы
*/
LOCAL cNameDbf:= TempFile(m->GlobalTmpPath,"DBF")
LOCAL cNameCdx:= ATREPL(".DBF",cNameDbf,".CDX"), cBakSelect :=ALIAS()
alias_metka := IF(ValType(alias_metka) = "C",alias_metka,"METKA_")
SELECT 0
DbCreate(cNameDbf,IF( ValType(aStruct) = "A",aStruct,{{"CREC","C",17,0}}) )
NetUseExc(alias_metka, cNameDbf )
SELECT (alias_metka)
IF(ValType(cKeyIdx) = "C",,cKeyIdx := "CREC")
IF(ValType(bRelation) = "B",EVAL(bRelation),NIL)
IF !EMPTY(cKeyIdx)
  INDEX ON &(cKeyIdx) TAG TAG_METKA TO (cNameCdx)
  SET INDEX TO (cNameCdx)
ENDIF
IF !EMPTY(cKeyIdx1)
  INDEX ON &(cKeyIdx1) TAG TAG_SETKA TO (cNameCdx)
  SET INDEX TO (cNameCdx)
ENDIF
IF !EMPTY(cKeyIdx2)
  INDEX ON &(cKeyIdx2) TAG TAG_LETKA TO (cNameCdx)
  SET INDEX TO (cNameCdx)
ENDIF
IF !EMPTY(cKeyIdx3)
  INDEX ON &(cKeyIdx3) TAG TAG_RETKA TO (cNameCdx)
  SET INDEX TO (cNameCdx)
ENDIF
ORDSETFOCUS("TAG_METKA")
IF !EMPTY(alias)
 SELECT (alias)
 SET RELATION TO  STR(Recno(),17,0) INTO (alias_metka) ADDITIVE
ENDIF
AADD(aNameFile,{(cNameDbf := TOKEN(cNameDbf,".",1)),alias_metka})
IF EMPTY(cbakSelect)
  SELECT 0
ELSE
  SELECT (cBakSelect)
ENDIF
RETURN cNameDbf


//-----------------------------------------------------------------------------//
FUNCTION DeleteMetka(cAlias)
//-----------------------------------------------------------------------------//
// Удаление файлов меток [по cAlias]
LOCAL nDel
IF !EMPTY(aNameFile)
  IF cAlias = NIL
    nDel := LEN(aNameFile)
  ELSE
    nDel := ASCAN(aNameFile,{|aFile| UPPER(aFile[2]) == UPPER(cAlias) })
  ENDIF
  (aNameFile[nDel,2])->(dbCloseArea())
  FERASE(aNameFile[nDel,1]+".DBF")
  FERASE(aNameFile[nDel,1]+".CDX")
  ADEL(aNameFile, nDel)
  ASIZE(aNameFile,LEN(aNameFile)-1)
ENDIF
RETURN NIL







//---------------------------------------------------------------------------//
              FUNCTION SetIns(lClears,cALias,bSet)
//---------------------------------------------------------------------------//
// Отметка текущей записи
// bSet - блок кода выполняемый при отметке ему передается
// .T. - добавление метки
// .F. - удаление метки
LOCAL cTekAlias := ALIAS()
IF(lClears,(cAlias)->(IF(!EMPTY((cAlias)->CREC) .AND. RecLock(),(IF(bSet != NIL,EVAL(bSet,.F.),NIL),dbDelete(),dbUnlock()),NIL)),(cAlias)->(IF(EMPTY((cAlias)->CREC) .AND. AddRec(),(IF(bSet != NIL,EVAL(bSet,.T.),NIL),(cAlias)->CREC := STR((cTekAlias)->(Recno()),17,0),dbUnlock()),NIL)))
RETURN NIL


Function Frame(cHead,nTop,nLeft,nBottom,nRight,cCol,Frm,lShad,lCls,cSideHead)
//--------------------------------------------------------------------------//
//cSideHead == 'L'- left; 'R'- right; 'C'- center.
   Local cCls   := If(lCls == NIL, "", " ")
   Local cColor := If(cCol == NIL, COL_BROWSE, cCol)

   Local cBox   := If(Frm == NIL, BOX_E,;
                    If(ValType(Frm) == "C", Frm,;
                     If(Frm == 0, BOX_E,;
                      If(Frm == 1, BOX_S,;
                        If(Frm == 2, BOX_D, BOX_P)))))

   If(lShad == NIL,;
    DispBox(nTop, nLeft, nBottom, nRight, cBox + cCls, cColor),;
    ShadowBox("", nTop, nLeft, nBottom, nRight, cColor, cBox))
   If(cHead == NIL,,;
    AOut(cHead, nTop, IF(EMPTY(cSideHead),nLeft + 2, IF(cSideHead=='R',nRight-LEN(cHead)-2,IF(cSideHead=='C',nLeft+INT((nRight-nLeft-LEN(cHead))/2),nLeft+2))),;
         If(cColor == COL_BROWSE, COL_BROWS1, cColor)))

 Return (NIL)




//---------------------------------------------------------------------------//
              FUNCTION SetInsAll(lClears,cALias,bFor,bSet)
//---------------------------------------------------------------------------//
// Отметка всех записей
LOCAL aSet := SaveSet(), nWin1, lYes
LOCAL nWin := WSELECT()
dbPush()
dbGoTop()
ScrTitul(24,'Esc:Прервать' )
nWin1:=NoOrYes( {'','Отметка  '+CHR(251)+'   [ ]',''},,,10,35,COL_REFER )
lYes := INDIK_NEW(13,53)
DBEVAL({|| SetIns(lClears,cAlias,bSet) },bFor,{|| INDIK_UPDATE(lYes),inkey() != K_ESC })
INDIK_END(lYes)
WSELECT(nWin1)
WCLOSE()
dbPop()
WSELECT(nWin)
RestSet(aSet)
RETURN NIL
