Главная
Новый форум
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Функции БЭСТа
Goto page 1, 2  Next
 
Post new topic   This topic is locked: you cannot edit posts or make replies.   printer-friendly view     Forum Index -> Программирование в БЭСТ-4
View previous topic :: View next topic  
Author Message
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 23 Apr 2007 19:40    Post subject: Функции БЭСТа Reply with quote

Перечень
-------------------------------------------------------------------------------------
Наименование функции |Номер| Краткий комментарий
-------------------------------------------------------------------------------------
_SC()...........................| 11 | Функция зарплаты _SC()
AddShFact()..................| 7 | ФОрмирование счетов-фактур
Amload()......................| 12 | Функция чтения табл. документов
ChangeOper()...............| 9 |Ф-ия пересчета в реестре док.товаров
Comment()...................| 13 |работа с мемо-полем
DbOpenBases().............| 16 | Открытие несколько БД
Dbpush()......................| 17 |Сохранение параметров алиаса
GenPro()......................| 8 | Формирование проводок
Jrn_Reestr()..................| 6 | Определ. док. для реестра изменений
Jrn_write()....................| 5 | Запись в журнал реестра изменений
NControlMem()..............| 3 | Отмена генерации NWDOC()
NetUse().......................| 15 |Открытие БД
NewNumDoc()...............| 4 | Генерация уник.номера документа
NVDOC().......................| 2 | к NWDOC()
NWDOC()......................| 1 | Генерация след. номера док-та
PRICEPERE()................. | 20 | Пересчет цен в заказах
QPRINT().......................| 21 | Печать реестра
QPRINT() БЭСТ-5...........| 22 |Тоже но для БЭСТ-5
QPRINT1() БЭСТ-5.........| 23 |
Saldo()..........................| 14 |Функция языка внешней отчетности
SaveSet()..................... | 18 | Сохранение тек.настроек
SaveSetKey()................ | 19 | Сохранение горячих клавиш
WinReport()...................| 10 | Создание печатных форм


Last edited by nordk on 06 Nov 2007 17:34; edited 21 times in total
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 23 Apr 2007 19:40    Post subject: Reply with quote

1
Code:
 FUNCTION NWDoc(cField,xKey,cPre,cTag,cAlias,lClearScope)
//----------------------------------------------------------------------------//
// Генерирует следущий номер документа
// Работает только с символьными полями
// cField - имя поля
// xKey - текущее значение ключа для идентификации раздела !!!
// [cPre] - префикс для идентификации данного типа генерации в пределах текущего
//        сеанса выполнения АРМ'а
// [cTag] - имя тега
// [cAlias] - алиас для доступа к счетчикам. По умолчанию MEMDAT.
// [lClearScope] - очистка Scope
// ВНИМАНИЕ !! Требует открытой базы с алиасом cAlias с полями :
//             IDENT C 50, VALUE C 50, LEN N 2 0, TYPE C 1
//             проиндексированной по UPPER(IDENT)
// Смотри: NVDOC(), NControlMem()

#DEFINE pLastNum      NumSaveLoad(cIdent)[2]
#DEFINE pNextNum      NumSaveLoad(cIdent)[3]
#DEFINE cRetNumValue  NumSaveLoad(cIdent)[4]

LOCAL xNext
LOCAL cFile
LOCAL cIdent := UPPER(cPre+IF(xKey=NIL,"",xKey))
LOCAL cLast:= pLastNum,cNext:= pNextNum

dbPush()
IF(ValType(cTag) = "C",ORDSETFOCUS(cTag),NIL)
IF(lClearScope != NIL .AND. lClearScope ,SetScope(),NIL)
cPre:=IF(cPre=NIL,"",cPre)
IF(ValType(cAlias) = "C",,cAlias := "MEMDAT")

IF ((cAlias)->(dbSeek(PADR(cIdent,LEN((cAlias)->IDENT)))).AND. (cAlias)->(RecLock())) .OR. (cAlias)->(AddRec())
   (cAlias)->IDENT := cIdent
ENDIF

IF !EMPTY((cAlias)->VALUE)
   IF (cAlias)->TYPE = "C"
     pNextNum := LEFT((cAlias)->VALUE,(cAlias)->LEN)
   ELSEIF (cAlias)->TYPE = "D"
     pNextNum := CTOD((cAlias)->VALUE)
   ENDIF
ELSEIF xKey==NIL .OR. LEN(xKey)==0   //.OR.EMPTY(pNextNum)
   GO BOTTOM
   dbSkip(0)
   pNextNum:=EVAL(FIELDBLOCK(cField))
ELSE
   xNext:=SUBSTR(xKey,1,LEN(xKey)-1)+CHR(ASC(SUBSTR(xKey,-1))+1)
   DBSEEK(xNext,.T.)
   SKIP -1
   IF (!(xKey=LEFT(&(INDEXKEY()),LEN(xKey))))
      pNextNum:=BLANK(EVAL(FIELDBLOCK(cField)),.T.)
   ELSE
      pNextNum:=EVAL(FIELDBLOCK(cField))
   ENDIF
ENDIF
IF pNextNum = NIL //Пpи сбоях в файле
   GO BOTTOM
   dbSkip(0)
   pNextNum:=EVAL(FIELDBLOCK(cField))
ENDIF
pLastNum:=pNextNum
pNextNum:=Next(pNextNum)
IF (cAlias)->(RecLock())
   (cAlias)->TYPE := ValType(pNextNum)
   (cAlias)->VALUE := XTOC(pNextNum)
   (cAlias)->LEN := LEN(XTOC(pNextNum))
   (cAlias)->(dbUnLock())
ENDIF
cRetNumValue:=pNextNum
dbPop()
RETURN ObrabotkaNom(cRetNumValue)
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 23 Apr 2007 19:46    Post subject: Reply with quote

2.
Code:
//----------------------------------------------------------------------------//
FUNCTION NVDoc(nAdd,nGet,cField,xKey,cPre,cTag,lRight,cAlias,bVar,lNoSoob,lClearScope,lValidEdit)
//----------------------------------------------------------------------------//
// nAdd - режим nApp
// nGet - номер в GetList
// xKey - текущее значение ключа для идентификации раздела !!!
// [cPre] - префикс для идентификации данного типа генерации в пределах текущего
//        сеанса выполнения АРМ'а
// [cTag] - имя тега
// [lRight] - если .T. то сдвиг вправо
// [cAlias] - алиас для доступа к счетчикам. По умолчанию MEMDAT.
// [bVar] - блок кода доступа к переменной.  По умолчанию {|x| IF(x != NIL,aIn[SeekPos(cField)] := x,aIn[SeekPos(cField)]) }
//          или из GET-буфера
// [lNoSoob] - выдавать ли сообщение о дублировании
//             может быть блоком кода,
//             если EVAL(lNoSoob) вернет .T., то сообщение не выдается
// ВНИМАНИЕ !! Требует открытой базы с алиасом cAlias с полями :
//             IDENT C 50, VALUE C 50, LEN N 2 0
//             проиндексированной по UPPER(IDENT)
// [lClearScope] - очистка Scope
// [lValidEdit] - проверка всегда как редактирование
// Смотри : NWDOC(), NControlMem()

LOCAL lRet:=.T.
LOCAL nRec := RECNO()
LOCAL lSeek := .F.,x, cKey
LOCAL cIdent := UPPER(cPre+IF(xKey=NIL,"",xKey))
LOCAL cLast:=pLastNum,cNext:=pNextNum,cNext0
LOCAL bEnd := {||;
                DBSEEK(SUBSTR(xKey,1,LEN(xKey)-1)+CHR(ASC(SUBSTR(xKey,-1))+1),.T.),;
                dbSkip(-1),;
                IF((!(xKey=LEFT(&(INDEXKEY()),LEN(xKey)))),;
                    BLANK(EVAL(FIELDBLOCK(cField)),.T.),;
                    EVAL(FIELDBLOCK(cField));
                   );
                }
IF(ValType(cAlias) = "C",,cAlias := "MEMDAT")
IF(ValType(lValidEdit) = "L",,lValidEdit := .F.)
dbPush()
IF(lClearScope != NIL .AND. lClearScope ,SetScope(),NIL)
IF(ValType(bVar) = "B",,bVar := {|x| IF(x != NIL,aIn[IF(VarSeekPos(cField,SetSeekPos()) = 0,nGet,VarSeekPos(cField,SetSeekPos()))] := x,aIn[IF(VarSeekPos(cField,SetSeekPos()) = 0,nGet,VarSeekPos(cField,SetSeekPos()))]) })
IF(ValType(cTag) = "C",ORDSETFOCUS(cTag),NIL)
cPre:=IF(cPre=NIL,"",cPre)

IF !EMPTY(lRight) //Случай для документов (не для аналитики)
 IF nGet != NIL
   ToRight(nGet,.T.)
 ELSE
   EVAL(bVar,ObrabotkaNom(EVAL(bVar)))
 ENDIF
ENDIF

IF nGet != NIL
  m->GetList[nGet]:display()
ENDIF
cKey := IF(xKey==NIL,'',xKey)+UPPER(IF(nGet = NIL .OR. m->GetList[nGet]:buffer=NIL,EVAL(bVar),m->GetList[nGet]:buffer))
DBSEEK(cKey)
DBEVAL({|| lSeek := .T. },{|| (nAdd = 2 .AND. !lValidEdit) .OR. nRec != RECNO() },{|| &(ORDKEY()) = cKey.AND.!lSeek  })
IF (LASTKEY()!=K_UP)
   IF  (nAdd==1 .OR. lValidEdit) .AND. lSeek .OR. (nAdd=2 .AND. !lValidEdit .AND. lSeek)
      IF IF(ValType(lNoSoob) = "B",!EVAL(lNoSoob),EMPTY(lNoSoob))
        SayError('Такой номер уже имеется')
      ENDIF
      lRet:=.F.
   ELSEIF nAdd=2
      cNext0:=pNextNum:=EVAL(bVar) //Случай для дополнения аналитики
      IF (cAlias)->(dbSeek(PADR(cIdent,LEN((cAlias)->IDENT))))
        IF (cAlias)->TYPE = "C"
          pNextNum := LEFT((cAlias)->VALUE,(cAlias)->LEN)
        ELSEIF (cAlias)->TYPE = "D"
          pNextNum := CTOD((cAlias)->VALUE)
        ENDIF
      ENDIF

      IF (cNext0 > pNextNum).OR.(cRetNumValue!=NIL.AND.cRetNumValue!=cNext0) //.AND.cNext0 > EVAL(bEnd) )
         pNextNum:=cNext0
         IF (cAlias)->(EOF() .AND. AddRec()) .OR. (cAlias)->(RecLock())
           (cAlias)->VALUE := XTOC(pNextNum)
           (cAlias)->LEN := LEN(XTOC(pNextNum))
           (cAlias)->IDENT := cIdent
           (cAlias)->TYPE := ValType(pNextNum)
           (cAlias)->(dbUnLock())
         ENDIF
      ENDIF
   ENDIF
ENDIF
dbPop()
RETURN(lRet)
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 23 Apr 2007 19:48    Post subject: Reply with quote

3.
Code:
//----------------------------------------------------------------------------//
FUNCTION NControlMem(xKey,cPre,cAlias,lDel)
//----------------------------------------------------------------------------//
// Отмена сгенерированного значения NWDOC()
// xKey - значение ключа для идентификации раздела  !!!
// [cPre] - префикс для идентификации данного типа генерации в пределах текущего
//        сеанса выполнения АРМ'а
// [cAlias] - алиас для доступа к счетчикам. По умолчанию MEMDAT.
// [lDel] - очистка счетчика
// ВНИМАНИЕ !! Требует открытой базы с алиасом cAlias с полями :
//             IDENT C 50, VALUE C 50, LEN N 2 0
//             проиндексированной по UPPER(IDENT)
// Смотри: NWDOC(), NVDOC()
LOCAL cIdent := UPPER(cPre+IF(xKey=NIL,"",xKey))
LOCAL cNum0:=pNextNum,cFile, lBottom, nRec := RECNO()
xKey:=IF(xKey==NIL,'',xKey)
cPre:=IF(cPre=NIL,"",cPre)
IF(ValType(cAlias) = "C",,cAlias := "MEMDAT")
IF (cAlias)->(dbSeek(PADR(cIdent,LEN((cAlias)->IDENT))))
   IF (cAlias)->TYPE = "C"
     pNextNum := LEFT((cAlias)->VALUE,(cAlias)->LEN)
   ELSEIF (cAlias)->TYPE = "D"
     pNextNum := CTOD((cAlias)->VALUE)
   ENDIF
ENDIF
IF pNextNum=cNum0
   pNextNum:= pLastNum
   IF (cAlias)->(EOF() .AND. AddRec()) .OR. (cAlias)->(RecLock())
     IF EMPTY(lDel) .AND. ValType(XTOC(pNextNum)) = "C"
       (cAlias)->VALUE := XTOC(pNextNum)
       (cAlias)->LEN := LEN(XTOC(pNextNum))
       (cAlias)->IDENT := cIdent
       (cAlias)->TYPE := ValType(pNextNum)
       (cAlias)->(dbUnLock())
     ELSEIF !EMPTY(lDel).OR.(dbPush(),dbGoBottom(),lBottom := (nRec = Recno()),dbPop(),lBottom)
       (cAlias)->VALUE := BLANK((cAlias)->VALUE,.T.)
     ENDIF
   ENDIF
ENDIF
RETURN(NIL)
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 28 Apr 2007 01:20    Post subject: Reply with quote

4
Code:
//----------------------------------------------------------------------------//
  FUNCTION NewNumDoc(cSclad,cVid,cType,cCodeDoc)
//----------------------------------------------------------------------------//
// Генерация уникального номера документа
LOCAL cNumDoc
   MDOC->(dbPush(),SetScope())
   cNumDoc := MDOC->(NWDOC("NUMDOC",UPPER(cSclad+cVid+cType+cCodeDoc),"NOM_DOC","MDOC"))
   // Проверка на уникальность
   IF  !MDOC->(NVDOC(S_LIB_ADD,,"NUMDOC",UPPER(cSclad+cVid+cType+cCodeDoc),"NOM_DOC","MDOC",.T.,,{|x| IF(x != NIL,cNumDoc := x,cNumDoc) },.T.))
     // Сброс счетчика
     NControlMem(UPPER(cSclad+cVid+cType+pCodeDoc1),"NOM_DOC",,.T.)
     // Теперь уж точно уникальный номер
     cNumDoc := MDOC->(NWDOC("NUMDOC",UPPER(cSclad+cVid+cType+cCodeDoc),"NOM_DOC","MDOC"))
   ENDIF
   MDOC->(dbPop())
RETURN cNumDoc
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 14 May 2007 19:11    Post subject: Reply with quote

5.

Code:
FUNCTION Jrn_Write(nAdd)
STATIC sPre:="!"
LOCAL nArea:=SELECT(),cReestr:=Jrn_Reestr(),aRee
LOCAL cUserName:=PADR(IF(EMPTY(_USER_NAME),SUBSTR(IDENT_USER,COUNTLEFT(IDENT_USER,"0")+1),_USER_NAME),25)
LOCAL cPre

IF EMPTY(cReestr).OR.;
   UPPER(sPre)==(cPre:=UPPER(DTOS(Date())+LEFT(Time(),5)+cReestr+cUserName+;
   STR(EVAL(aKeys[cReestr,P_NNOPER]),17,0)+STR(nAdd,1,0)))
   RETURN .T.
ENDIF

NetUse("Jrn_Sys",LoadPath()+"Jrn")
AddRec()
REPLACE Date WITH Date(),Time WITH LEFT(Time(),5),Reestr WITH cReestr,;
UserName WITH cUserName,;
NNOper WITH (nArea)->(EVAL(aKeys[cReestr,P_NNOPER])),Oper WITH STR(nAdd,1,0)
sPre:=DTOS(Date)+TIME+Reestr+UserName+STR(NNOPER,17,0)+Oper
REPLACE UserName WITH Crypt(UserName,PAROL)
//IF nAdd==3//пишем всегда, иначе при уалении теряются концы в предыдущих записях
   aRee:=aKeys[cReestr]
   REPLACE Comment WITH ;
   (nArea)->(;
   EVAL1(aRee[P_JRN])+";"+EVAL1(aRee[P_DOC])+;
   ";"+DTOC(EVAL(aRee[P_DATE]))+";"+;
   EVAL1(aRee[P_AGENTNAME])+";"+;
   STR(EVAL(aRee[P_SUMMA]),14,2);
   )
//ENDIF

UNLOCK
CLOSE
SELECT(nArea)
RETURN .T.
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 14 May 2007 19:14    Post subject: Reply with quote

6.

Code:
FUNCTION Jrn_Reestr()
LOCAL cRet:="",i,cPath:=SUBSTR(UPPER(LoadPath()),3),c
SetKeys()
altd()
IF _JRN_YES
   c:=UPPER(dbinfo(10))
   i:=AT(cPath,c)+LEN(cPath)
   TRY
     cRet:=aReestr[SUBSTR(c,i)]
   CATCH
     cRet:=""
   END
ENDIF
RETURN cRet
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 13 Jul 2007 14:42    Post subject: Reply with quote

7.
Code:
           FUNCTION AddShFact(lRefor,aDataDoc,lJoin,lPokup)
//----------------------------------------------------------------------------//
// Формирование или переформирование счета-факутры
// lRefor != NIL, то запрос на переформирование
// aDataDoc - массив структуры {{уникальный номер строки счета-фактуры,номер записи в MDOCM}...}
//            используется при переформировании после редактирования
//            (сохраняет предыдущее состояние)
// lJoin != NIL, то добавление строк накладной к существующему счету-фактуре
// lPokup = .T., то формирование счета-фактуры по закупкам
//               по умолчанию .F.
// см. EditBookData()
PLOCAL lAdd
PLOCAL lEdit := .F., nOper, nRec
PLOCAL bakPrefix := GetPrefix()
PLOCAL nWin := WSELECT()
PLOCAL nLastKey := LastKey(), nVib := 2
PLOCAL cKey := UPPER(MDOC->Sclad+MDOC->Vid+MDOC->Type+MDOC->CodeDoc+MDOC->NumDoc)
PLOCAL lStatus := MDOC->STATUS_F = "1"
PLOCAL aError
PLOCAL nPro
PLOCAL bakReal := IsRealFact(IF(ValType(lPokup) = "L",!lPokup,.T.))
PLOCAL lReal := IsRealFact()
PLOCAL nOperFact, nRecDoc := MDOC->(RECNO()), nOperDoc := -1
PLOCAL bSetDoc := {|nOperDoc,cStatus| MDOC->(dbGoTo(nRecDoc)),IF(!lReal.AND.MDOC->(RecLock()),IF((MDOC->OPER_FACT # nOperDoc.or.MDOC->STATUS_F # cStatus),(MDOC->STATUS_F := cStatus,MDOC->(dbUnLock()),InputToMDoc('MDOC','MDOCM'),NIL),NIL),NIL) }
PLOCAL aData
PLOCAL aMess := IF(lReal,{" Просмотр "," Переформировать "},{"Просмотр","Переформ. без НП","Переформ. с НП"}), aBak, lNoGenDoc := .F.
PLOCAL bGetStavka := {|| IF(!lReal,(MDOC->(dbGoTo(nRecDoc)),GetStavka(),IF(MDOC->(RecLock()),(iMDOC->L_NDS := ilNdsFact,iMDOC->L_ACZ := ilAczFact,iMDOC->L_CSH := ilCshFact,MDOC->(dbUnLock())),NIL)),NIL) }
PRIVATE nVibSF, nUdS:=0
PRIVATE pDate := MDoc->Date  // victor история НДС
PRIVATE lJoinDoc :=.F.
nOperFact := GetMDocFact(cKey,"MDOC",sSH_OP,"MDOCM",aDataDoc)
nPro := RetSavePro("MDOC")
IF lJoin != NIL .AND. nOperFact > 0
  RETURN 2
ENDIF

IF !lReal
 aStOperFact := {}
ENDIF

If (UPPER(ProcName(3))=="DOC").OR.(UPPER(ProcName(2))=="INPUTDOC")
  PRIVATE lFuckingFactuta:=If(lReal,"REAL","TOVAR")
endif

SetLastKey(0)
WSELECT(0)
SetPrefix("")
dbPush(sSH_FACT,"TAG_OPER","","","")
dbSeek(nOperFact)
lAdd := EOF() .OR. nOperFact <= 0
IF lRefor = NIL .AND. lAdd
  IF lJoin != NIL
    nOperFact := InGetOperFact()
    IF LastKey() != K_ESC .AND. nOperFact > 0
      lJoinDoc :=.T.
      lAdd := .F.
      lEdit := .T.
      dbSeek(nOperFact)
      IF FIELD->Cash = '1'
         m->nVibSF := 2
      ELSE
         m->nVibSF := '1'
      ENDIF
      nRec := RECNO()
      EVAL(bGetStavka)
    ENDIF
//  ELSEIF YesOrNo("Сформировать счет-фактуру?") .AND. LastKey() != K_ESC
  ELSEIF ((!lReal.AND.((m->nVibSF:=NoOrYes("Сформировать счет-фактуру?",,{' без НП ',' с НП ',' Oтказ '}))=1 .OR.m->nVibSF=2)).OR. ;
          (lReal.AND.YesOrNo("Сформировать счет-фактуру?")));
         .AND. LastKey() != K_ESC
    EVAL(bGetStavka)
    lEdit := LastKey() != K_ESC
  ENDIF
ELSEIF !lAdd .AND. LastKey() != K_ESC .OR. (!lAdd .AND. lRefor != NIL)
  nRec := RECNO()
  nUdS :=0
  IF lStatus .OR. lReal
    IF !lReal
      SetGetData(lReal,@aData,cKey,nOperFact,"MDOC","MDOCM",sSH_FACT,sSH_OP,sBOOK)
    ENDIF
    AADD(aMess,IF(!EMPTY(aData),"Изм. дату оприх.","Удалить"))
    IF !lReal .AND. LEN(InDocFact(sSH_FACT->NNOPER,sSH_FACT->TYPE_SV,sSH_FACT->OPER_KRED,.T.,,,.T.))>1
      IF sSH_FACT->Cash = '1'
         ADEL(aMess,2)
          nUdS :=2
      ELSE
         ADEL(aMess,3)
          nUdS :=3
      ENDIF
      ASIZE(aMess,LEN(aMess)-1)
    ENDIF
    nVib := NoOrYes(;
        IF(lRefor = NIL,{;
       "Счет-фактура N "+sSH_FACT->TEK_NOMER+" от "+DTOC(sSH_FACT->TEK_DATA),;
       " уже сформирован ";
        },;
        {;
       "По документу сформирован",;
       "счет-фактура N "+sSH_FACT->TEK_NOMER+" от "+DTOC(sSH_FACT->TEK_DATA);
        });
        ,1,aMess,,,,,)
   ELSE
     nVib := 1
   ENDIF
   IF (nUdS = 3 .AND. nVib >2) .OR.(nUdS=2.AND. nVib>1)
      nVib++
   ENDIF
   IF nVib = 2 .OR. (!lReal .AND. nVib = 3)
     IF nVib = 3
      m->nVibSF := 2
     ELSE
      m->nVibSF := 1
     ENDIF
     MDOC->(dbGoTo(nRecDoc))
     aBak := MDOC->(Scatter())
     GetStavka(,MDOC->L_NDS,MDOC->L_ACZ,.T.,MDOC->L_CSH)
     EVAL(bGetStavka)
     ReforShFact(@lEdit,sSH_FACT,sSH_OP,"MDOCM",sBOOK,cKey,aDataDoc,,,{|| IF(MDOC->(RecLock()),MDOC->(Gather(aBak),dbUnLock()),NIL) })
     nVib := NIL
   ELSEIF nVib = 1
     lEdit := .T.
   ELSEIF nVib = 3+IF(lReal,0,1) .AND. !EMPTY(aData)
     SetGetData(lReal,aData,cKey,nOperFact,"MDOC","MDOCM",sSH_FACT,sSH_OP,sBOOK)
   ELSEIF EMPTY(aData) .AND. nVib = 3+IF(lReal,0,1) .AND. (IsDelSHDatCL(@aError,sSH_FACT,sSH_OP ,.T.)).AND. (IsBookFact(cKey,"MDOCM",sSH_FACT,sSH_OP,sBOOK,@aError,,,nOperFact) .OR. (!EMPTY(aError) .AND. SayError(aError)))
     DelShFact(sSH_FACT->NNOPER,sBOOK,"MDOCM",sSH_FACT,sSH_OP,cKey,"MDOC")
     if MDOC->(RecLock())
       MDOC->OPER_FACT := 0
       MDOC->(dbunlock())
       InputToMDoc('MDOC','MDOCM')
     endif
   ENDIF
ENDIF
dbPop()

IF lEdit
 PRIVATE aPay := {}
 PRIVATE pStatus := DEF_OPEN
 PRIVATE pType := "1"
 OpenShFactBase()
 GlobCurs(InputVCurs(GlobalValuta,CURR_DATA,.F.),GlobalValuta)
 SELECT SH_FACT
 IF !lAdd
   dbGoTo(nRec)
 ENDIF
 Edit_FactSchet(IF(lAdd,S_LIB_ADD,S_LIB_EDIT),.F.,IF(lAdd,"1",SH_FACT->TYPE_ST),IF(nVib = 1.OR.nVib = NIL,NIL,nPro),IF(nVib = 1.OR.nVib = NIL,NIL,IF(GetPrefix() == "S" .OR. GlobalTask $ "03SRTZ"," ","1")),.T.,@nOperDoc)
 CloseShFactBase()
 IF !EMPTY(aStOperFact)
   EVAL(bSetDoc,nOperDoc,"1")
   MDOCM->(AEVAL(aStOperFact,{|x| SH_OP->(dbGoTo(x[1])),dbGoTo(x[2]),IF(SH_OP->NNOPER = MDOCM->OPER_FACT.AND.RecLock(),(MDOCM->KOLNED := SH_OP->KOL-MDOCM->KOLBR-MDOCM->KOL,dbUnLock()),NIL) }))
 ENDIF
ENDIF


SetPrefix(bakPrefix)
IF lRefor != NIL
  SetLastKey(nLastKey)
ELSE
  SetLastKey(K_DOWN)
ENDIF
WSELECT(nWin)
IsRealFact(bakReal)
aStOperFact := NIL
RETURN 2
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 13 Jul 2007 14:46    Post subject: Reply with quote

8.

Code:
FUNCTION GenPro( dDat1, dDat2, nMode, nMode1, lPriS0, lPereMbp, aDoc, lOnly, lAct)
#DEFINE VIDTYPE IF(m->plAct, Status+"$", Vid+Type)
    //nMode=2 - все проводки, 1 - отложенные
    //nMode1=1 - запись в главную книгу, 2 - в буфер MProBuf
    //lPris0   - если присутствует, то обрабатываются только проводки c S0
    //lSpisMbp - перерасчитывать ведомости списания МБП
    //aDoc - массив документов {UPPER(Sclad+Vid+Type+CodeDoc+NumDoc)}
    //lOnly - только новые проводки
    //lAct - Проводки по актам переоценки (только для "розницы", обязательно aDoc)
    LOCAL cSDoc:= IF(EMPTY(lAct), "MDoc", "MPere")
    LOCAL nArea := SELECT()
    LOCAL nSumma, aMat, aPro, aPrePro, i, nSum, nDoc := 1
    LOCAL nWin      := WSELECT()
    LOCAL nWin1     := NoOrYes( {'','Генерация проводок   [ ]',''},,,15,35,COL_REFER )
    LOCAL lYes      := INDIK_NEW(18,61)
    LOCAL aBase     := {'MAIN','VALUTA','SPR_PART','S45','S45M','KALK','KALK_S',;
                        {"SSH_FACT",LoadPath()+"REAL\SH_FACT.DBF"},{"SSH_OP",LoadPath()+"REAL\SH_OP.DBF"},{"SH_FACT",LoadPath()+"TOVAR\SH_FACT.DBF"},{"SH_OP",LoadPath()+"TOVAR\SH_OP.DBF"},"SPR_NDS";
                        }

    LOCAL cVid:=m->pVid,cType:=m->pType,cSclad:=m->pSclad


    LOCAL nRec1:=MCodOp->(RECNO())


    PRIVATE pSclad:=cSclad,pType:=cType,pVid:=cVid,pCodeDoc,pNumDoc
    PRIVATE pAgentCode,pDate,DEF_TSUM,TZR1,TZR2,TZR3,pCodeVal,pCenaVal,pPrim,CURS,FLAG := .T.
    PRIVATE SP,SPV,SPP,SPPV,S,SV,S0,Q0,NI,NDS,CSH,SFN,PA,TP,TN,EU,TZR1M,TZR2M,TZR3M,TZR1MN,TZR2MN,TZR3MN,DOP1,DOP2,DOP3,PP1,PP2,R,MEM_MODEL,DEF_PCENA0,SNal
    PRIVATE SPV0,S_NEW,S_OLD,C_NEW,C_OLD, OCN1,OCN2,OCN3,OCN4,OCV1,OCV2,OCV3,OCV4,CenSpCon
    PRIVATE _SUM_OUT_DOC
    PRIVATE pVidType  := IF( GlobalTask == '03', '23', '26' )
    PRIVATE pVidType1 := IF( GlobalTask == '03', '52', '53' )
    PRIVATE plAct
    PRIVATE pOrder   // заказы закупок victor
   PRIVATE nIzn_All, nIzn_AllN, pA_Grup, dPereoc_D, cSchetZM, cSchetZMN, cZCodeM, cZCodeMN,lLinMet:=.F.,lLinMetN:=.F.    // victor спецодежда

    plAct:= IF(lAct==NIL, lAct:= .F., lAct)

   IF VALTYPE(aDoc)=="C"
       aDoc:={aDoc}
   ENDIF
   IF VALTYPE(aDoc)=="A"
      FOR i:=1 TO LEN(aDoc)
      aDoc[i]:=UPPER(aDoc[i])
      NEXT
   ENDIF


    BEGIN SEQUENCE

       (cSDoc)->(DbPush())
       MDocM->(DbPush())
       (cSDoc)->( ORDSETFOCUS( IF( aDoc == NIL, 'MDoc_Dat', IF(EMPTY(lAct),'MDoc', 'TAG_NOM') ) ) )
       MDocM->( ORDSETFOCUS( 'MDocM') )

       dbOpenBases(aBase,,,,.T.)

       KALK->(ORDSETFOCUS("TAG_OPER"))
       KALK_S->(ORDSETFOCUS("TAG_NNOPER"))
       SH_OP->(ORDSETFOCUS("TAG_OPER"))
       SPR_PART->( ORDSETFOCUS("TAG_NUM") )
       MAIN->( ORDSETFOCUS('Tag_NNOper') )
       VALUTA->( ORDSETFOCUS('CODE') )

       SH_OP->(ORDSETFOCUS("TAG_OPER"))
       SPR_NDS->(ORDSETFOCUS("TAG_OPER"))
       SH_FACT->(ORDSETFOCUS("TAG_OPER"))
       SSH_OP->(ORDSETFOCUS("TAG_OPER"))
       SSH_FACT->(ORDSETFOCUS("TAG_OPER"))

       SELECT MDocM
       SET RELATION TO;
                      UPPER(Grup+NNum) INTO MLabel,;
                      UPPER(Grup) INTO MGrup,;
                      UPPER(CodeVal) INTO Valuta,;
                      UPPER(Schet) INTO MSchet,;
                      UPPER(Sclad+Grup) INTO MStru,;
                      UPPER(Grup+NNum+Partia) INTO SPR_PART
       SELECT (cSDoc)
       IF nMode1 = 1
          SET RELATION TO UPPER( VIDTYPE + CodeOper ) INTO MCodOp,;
                          Pro                         INTO Main,;
                          UPPER( VIDTYPE )            INTO Moves
       ELSE
          SET RELATION TO UPPER( VIDTYPE + CodeOper ) INTO MCodOp,;
                          UPPER( VIDTYPE )            INTO Moves
       ENDIF
       IF aDoc == NIL
          DbSeek( DTos( dDat1 ), .T. )
       ENDIF

       // Суммы для накопления в заголовке документа
       IF IS_MODEL
         InitSumModel(@aSumModel)
       ENDIF

       WHILE ( aDoc == NIL .AND. Date <= dDat2 .AND. !EOF() ).OR.;
             ( aDoc != NIL .AND. nDoc <= LEN( aDoc ) )

          IF aDoc!=NIL
             DbSeek( IF(lAct, SUBSTR(aDoc[ nDoc++ ],-6,6), aDoc[ nDoc++ ]) )
             IF lAct.AND.(cSDoc)->PRO<1
                (cSDoc)->(RecLock())
                (cSDoc)->PRO:= Main->(StepPlus())
                (cSDoc)->(DbUnLock())
             ENDIF
          ENDIF
          INDIK_UPDATE(lYes)
          IF !( !lAct .AND. Type == '9' .AND. EMPTY( Date1 ) ) .AND. (;
             ( nMode = 2 .OR. ( nMode = 1 .AND. MCodOp->Status = 1 ) .OR.;
             ( lPriS0 != NIL .AND. ( (IF(lAct,(cSDoc)->Status,Vid ) = '2') .OR.;
              !Moves->YesSeb .OR. (Vid+Type)=="1#" ) ) ) )

             pDate      := Date
             pVid       := IF(lAct, (cSDoc)->Status, Vid)
             pSclad     := IF(lAct, SUBSTR(aDoc[nDoc-1],1,6), Sclad)
             pType      := IF(lAct, "$", Type)
             pModel     := IF(lAct,pModel,Model)
             pCodeDoc   := IF(lAct, SPACE(3), CodeDoc)
             pNumDoc    := IF(lAct, SUBSTR(aDoc[nDoc-1],-6,6), NumDoc)
             pAgentCode := IF(lAct, SPACE(6), AgentCode)
             pAgentCod1 := IF(lAct, SPACE(6), AgentCod1)
             pCodeVal   := IF(lAct, GLOBALVALUTA, CodeVal)
             pCenaVal   := IF(lAct, 1, CenaVal)
             pPrim      := IF(lAct, PADR(FIELD->Name,37), PRIM)
             pOrder      := IF(lAct, SPACE(6), Field->Order)   // заказы закупок victor
             aPrePro    := MakePrePro()
             SELECT MDocM
             DBSEEK(MDoc->( Upper( pSclad + pVid + pType + pCodeDoc + pNumDoc ) ) )
             DOC_FLAG
             DOC_TSUM
             aMat := {{}}
             nSum := nSumma := 0
             WHILE ( Upper( IF(lAct,"",Sclad) + Vid + Type + CodeDoc + NumDoc ) ==;
                     Upper( IF(lAct,"",pSclad) + pVid + pType + pCodeDoc + pNumDoc ) .AND. !EOF())
                INDIK_UPDATE(lYes)
                IF MSchet->Uchet=='1'
                    m->S0:=__CENA*MDocM->Kol
                ELSE
                    m->S0:=MDocM->SUM
                ENDIF
                m->ST:=MLabel->Koef
                m->ST1:=MLabel->Koef1
               m->OCN1 := __RLABEL->OCENA1
               m->OCN2 := __RLABEL->OCENA2
               m->OCN3 := __RLABEL->OCENA3
               m->OCN4 := __RLABEL->OCENA4
               m->OCV1 := __RLABEL->VCENA1
               m->OCV2 := __RLABEL->VCENA2
               m->OCV3 := __RLABEL->VCENA3
               m->OCV4 := __RLABEL->VCENA4
               m->CenSpCon := GetCenSpCon()
                m->CURS:= pCENAVAL
                m->Q0:= IF(MDocM->Type=="$",MDocM->Kol0,MDocM->Kol)
                m->Q_BR:= MDocM->KOLBR
                m->Q_NED:= MDocM->KOLNED
                m->SP:=MDocM->SUMOUTR
                m->SNal:=MDocM->SUMN
                m->SPV:=MDocM->SUMOUT
                m->SPP:=SPR_PART->CENA_P
                m->SPPV:=SPR_PART->CENA_P_V
                m->SPV0:=SPR_PART->CENA_F_V
                IF MDocM->Type=="$"
                   m->S_NEW:= MDocM->Cena0+IF(MDocM->Vid=='1',1,-1)*(MDocM->Sum/Q0)*Q0
                   m->S_OLD:= MDocM->Cena0*Q0
                   m->C_NEW:= MDocM->Cena0+IF(MDocM->Vid=='1',1,-1)*(MDocM->Sum/Q0)
                   m->C_OLD:= MDocM->Cena0
                ENDIF
                m->S:=MDocM->SUMFACT
                m->SV:=MDocM->SUMOUT
                m->NI:=MDocM->IZNOS
                m->NDS:=MDocM->NDS
                m->CSH:=MDocM->CSH
                m->SFN:=MDocM->SFN
                DOC_MODEL
                DEF_DOC_CENA0
                m->PA:=MDocM->PA
                m->TP:=MDocM->TP
                m->TN:=MDocM->TN
                m->EU:=MDocM->EU
                m->DOP1:=MDocM->DOP1
                m->DOP2:=MDocM->DOP2
                m->DOP3:=MDocM->DOP3
                m->TZR1M:=m->TZR1:=MDocM->TZR1M
                m->TZR2M:=m->TZR2:=MDocM->TZR2M
                m->TZR3M:=m->TZR3:=MDocM->TZR3M
                m->TZR1MN:=MDocM->TZR1MN
                m->TZR2MN:=MDocM->TZR2MN
                m->TZR3MN:=MDocM->TZR3MN
                m->PP1:=MDocM->PP1
                m->PP2:=MDocM->PP2
               m->pA_Grup:=MDocM->A_Grup    // victor спецодежда  10
               m->nIzn_All:=MDocM->Izn_All
               m->nIzn_AllN:=MDocM->Izn_AllN
               m->dPereoc_D:=MDocM->Pereoc_D
               IF GlobalTask $ '09ZR'
                  m->cSchetZM:=MDocM->SchetZM
                  m->cSchetZMN:=MDocM->SchetZMN
                  m->cZCodeM:=MDocM->ZCodeM
                  m->cZCodeMN:=MDocM->ZCodeMN
                  m->lLinMet:=LinMetod(MDocM->PERIOD,,,MDocm->Date)
                  m->lLinMetN:=LinMetod(MDocM->PERIOD,'nal',MDocM->Cena0N,MDocm->Date)
               ENDIF
                m->R:=MDocM->R
                IF(LEN(aMat[LEN(aMat)])>999,AADD(aMat,{}),) // (aMat{{}})
                AADD(aMat[LEN(aMat)],;
                     MakeMat(IF(MDocM->Type=="$",Kol0,KolOut),Ed1,IF(MDocM->Type=="$",Kol0,Kol),CenaOut,Ed2,;
                             SumOut,SumOutR,SumFact,Sum,Iznos,;
                             Period,MLabel->Ed,Schet,Kol1,CodeDoc1,;
                             NumDoc1,Sclad1,Kol2,KolBr,KolNed,;
                             Oper_Fact,0,,,Date1,;
                             ,MDocM->SumN))
                nSumma+=SumFact
                nSum+=IF(Vid='2'.OR.!Moves->YesSeb,Sum,SumOutR)
                SKIP
                DO WHILE lAct.AND.;
                   (EOF().OR.Upper(Vid+Type+CodeDoc+NumDoc)!=Upper(pVid+pType+pCodeDoc+pNumDoc)).AND.;
                   nDoc<=LEN(aDoc).AND.SUBSTR(aDoc[nDoc],-6,6)==pNumDoc.AND.;
                   (pSclad:= SUBSTR(aDoc[nDoc],1,6), nDoc++, !DbSeek(aDoc[nDoc-1]))
                   // Неоходимо для нагонки в aMat[{}] строк по акту переоценки
                   // по всем складам.
                ENDDO
             ENDDO
             aPro := AddPro({},aMat,lPriS0,aPrePro)
             IF !lAct.AND.lPriS0!=NIL.AND.MDOC->(RecLock())
                IF TYPE("pModel")=="U"
                   PRIVATE pModel
                ENDIF
                pModel:= MDOC->Model  // !!!!!!!!!!!! Не убирать
                SaveSumFact()
                MDOC->(dbUnlock())
             ENDIF
             WritePro1(nMode,nMode1,aPro,(cSDoc)->Pro,lPriS0,,lOnly,lAct)
          ENDIF
          SELECT (cSDoc)
          IF aDoc==NIL
             SKIP
          ENDIF
       ENDDO
       //Списание товаров отгруженных
       MDocM->( ORDSETFOCUS('MDocM_W') )
       SELECT S45M
       SET RELATION TO UPPER(Sclad+pVidType+CodeDoc1+NumDoc1+Grup+NNum+Partia+Schet_A+AgentCode+if(GlobalTask=="09",STR(Field->NumMbp,17,0)+DTOS(Date),"")) INTO MDocM
       SELECT S45 // Здесь возможен и "54"
       IF nMode1 = 1
          SET RELATION TO Pro                           INTO Main,;
                          Upper( if(GlobalTask=="09".AND.!Empty(Vid),"54",pVidType1) + CodeOper ) INTO MCodOp
       ELSE
          SET RELATION TO Upper( if(GlobalTask=="09".AND.!Empty(Vid),"54",pVidType1) + CodeOper ) INTO MCodOp
       ENDIF
     //  IF lPris0 # NIL .AND. GlobalTask == "09"
      //    OrdSetFocus(0)
      //    DbGoTop()
     //  ELSE
          DbSeek( Dtos( dDat1 ), .T. )
     //  ENDIF
       /*IF lPris0 == NIL
          DbSeek( Dtos( dDat1 ), .T. )
       ELSE
          if( GlobalTask == "09", OrdSetFocus(0), NIL )
          DbGoTop()
       ENDIF */

    //   WHILE ( lPris0 != NIL .OR. ( lPris0 == NIL .AND. Date <= dDat2 ) ) .AND. !EOF()
       WHILE ( /*(lPris0 != NIL.AND. GlobalTask == "09") .OR.*/ ( Date <= dDat2 ) ) .AND. !EOF()
          INDIK_UPDATE(lYes)
          pDate    := Date
          pVid     := LEFT( pVidType1, 1 )
          pType    := RIGHT( pVidType1, 1 )
          pSclad   := SPACE(6)
          pCodeDoc := SPACE(3)
          pNumDoc  := NumDoc
          m->SNal  := 0
          SELECT S45M
          pCodeVal := CodeVal
          pCenaVal := CenaVal
          if GlobalTask == "09"
             SetScope( 'UPPER(Vid+NumDoc)', UPPER( S45->(Vid+NumDoc) ) )
          else
             SetScope( 'UPPER(NumDoc)', UPPER( S45->NumDoc ) )
          endif
          aPro     := AddInsM( 'Только проводки', lPriS0, lPereMbp, IF( lPris0 != NIL, 2, nMode ) )
          SELECT S45
          IF nMode = 2 .OR. ( nMode = 1 .AND. MCodOp->Status = 1 )
             WritePro1( nMode, nMode1, aPro, S45->Pro, lPriS0, 'l45', lOnly, lAct)
          ENDIF
          DbSkip()

       ENDDO
       IF GlobalTask $ '09ZR'
          ORDSETFOCUS('S45_D_M')
          DbSeek( Dtos( dDat1 ), .T. )
       WHILE ( /*(lPris0 != NIL.AND. GlobalTask == "09") .OR.*/ ( Date <= dDat2 ) ) .AND. !EOF()
          INDIK_UPDATE(lYes)
          pDate    := Date
          pVid     := LEFT( pVidType1, 1 )
          pType    := RIGHT( pVidType1, 1 )
          pSclad   := SPACE(6)
          pCodeDoc := SPACE(3)
          pNumDoc  := NumDoc
          m->SNal  := 0
          SELECT S45M
          pCodeVal := CodeVal
          pCenaVal := CenaVal
          if GlobalTask == "09"
             SetScope( 'UPPER(Vid+NumDoc)', UPPER( S45->(Vid+NumDoc) ) )
          else
             SetScope( 'UPPER(NumDoc)', UPPER( S45->NumDoc ) )
          endif
          aPro     := AddInsM( 'Только проводки', lPriS0, lPereMbp, IF( lPris0 != NIL, 2, nMode ) )
          SELECT S45
          IF nMode = 2 .OR. ( nMode = 1 .AND. MCodOp->Status = 1 )
             WritePro1( nMode, nMode1, aPro, S45->Pro, lPriS0, 'l45', lOnly, lAct)
          ENDIF
          DbSkip()

       ENDDO
       ENDIF

    END SEQUENCE
    MDocM->(DbPop())
    (cSDoc)->(DbPop())

    dbCloseBases(aBase)

    INDIK_END(lYes)
    WSELECT(nWin1)
    WCLOSE()
    WSELECT(nWin)
    SELECT(nArea)
    COMMIT
    IF lPereMbp != NIL
       GenSumFact( dDat1, dDat2, 'OnlySpisMbp' )
    ENDIF

    MCodOp->(DbGoto(nRec1))



RETURN NIL
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 18 Jul 2007 13:17    Post subject: Reply with quote

9.
Code:
//--------------------------------------------------------------------------//
                   FUNCTION ChangeOper(aOper,aWork)
//--------------------------------------------------------------------------//
LOCAL cLastColor:=SETCOLOR(COL_SHEADR)
LOCAL nRec:=RECNO(),nOper1,nOper2,cText,nMode,nMode1:=1
LOCAL nTop:=12,nLeft:=27,nBottom:=15,nRight:=59
LOCAL aSetKey:=SaveSetKey(),aSet,cCode1,cCode2
LOCAL sScreen:=SaveScreen(),nWin := WSELECT(),nWin1,lYes,i,lErr:=.F.
LOCAL aItem1:={;
'  - увеличить/уменьшить    ',;
'  - взять из прайс-листа   '}
LOCAL aItem:={' - операции движения ТМЦ         '}
LOCAL aBase := {'MDoc','MDocM','MKart','MLabel','MSclad','MCodOpA','MCodOp','MSchet','MStru','DateSebe','People','SPR_PART',"MOVES",'KALK','KALK_S',"SH_OP","MAIN","VALUTA",'MPar','MCalc','MCalc1',{"SSH_FACT",LoadPath()+"REAL\SH_FACT.DBF"},{"SSH_OP",LoadPath()+"REAL\SH_OP.DBF"},{"SH_FACT",LoadPath()+"TOVAR\SH_FACT.DBF"},{"SH_OP",LoadPath()+"TOVAR\SH_OP.DBF"},"SPR_NDS"}
LOCAL lFirstEnt:=.T., lOneDoc:=.F.
LOCAL bFor := ;
{||;
     lSREdit(1).AND.;
        (;
         !(;
           (nMode = 2 .OR. nMode = 3) .AND.;
           (IS_PSHFACT.OR.IS_SHFACT);
           ) .OR.;
          IF(;
             IS_PSHFACT,;
             EMPTY(SH_FACT->(dbSeek(MDOC->OPER_FACT),SH_FACT->TEK_NOMER)).OR.;
             MDOC->STATUS_F = "1",;
             GetMDocFact(MDOC->(UPPER(Sclad+Vid+Type+CodeDoc+NumDoc)),"MDOC","SSH_OP","MDOCM") <= 0;
             );
          ) .AND.;
        !IsSeek45(MDOC->Vid,MDOC->Type,MDOC->Sclad,MDOC->CodeDoc,MDOC->NumDoc) .AND.;
        !IsSeekRet(MDOC->Vid,MDOC->Type,MDOC->Sclad,MDOC->CodeDoc,MDOC->NumDoc,MDOC->Date) .AND.;
        !((!EMPTY(aWork).AND.;
           !lOneDoc .AND.;
           !EMPTY(MDOC->ID_Reg).AND.;
           YesRegistr(MDOC->ID_Reg)).OR.;
          !MayDelReg(mDoc->Id_Reg) ).AND. ;
        !ChangeO(cCode1,cCode2,lYes,nMode,nMode1);
 }

PRIVATE pUpdated:=.T.
BEGIN SEQUENCE
IF EOF()
  BREAK
ENDIF
IF (GlobalTask$"TV".OR.!IsView(MDoc->Date)) .AND. MDoc->Type # '#' .AND. !Moves->YesUchet
   IF pVid='1'
      AADD(aItem,' - цены поставщиков              ')
   ELSE
      AADD(aItem,' - отпускные цены                ')
   ENDIF
   AADD(aItem,   ' - значения параметров (налогов) ')
ENDIF
IF (nMode:=BoxMenu(' Заменить в документах: ',5,10,aItem,,,,COL_SHEADR,COL_SHEADR,'NoClear',,'Wide'))=0
  BREAK
ENDIF
SAYSCREEN('√',5+nMode,12)
DO CASE
   CASE nMode=1
   cText:='Замена операций......[ ]'
   RestScreen(,,,,sScreen)
   IF LEN(aOper)<=1
      SayError({'Для этого режима требуется более одной операции',;
                'в справочнике типовых операций!'})
      BREAK
   ENDIF
   IF LEN(aWork)==0
      IF !YesOrNo({'Режим заменяет коды операций с пересчетом',;
                 'моделей калькуляции и проводок.',;
                 'Для расчета будут использоваться значения параметров,',;
                 'запомненные на момент ввода соответствующих документов.',;
                 'Обработка производится только для текущего документа !'},,' Продолжать? ',' Возврат ')
         BREAK
      ENDIF
      AADD(aWork,{RECNO(),IF(MDOC->Vid=='1',SumOutR,Summa)})
      lOneDoc=.T.
   ELSE
      IF !YesOrNo({'Режим заменяет коды операций с пересчетом',;
                 'моделей калькуляции и проводок по отмеченным документам.',;
                 'Для расчета будут использоваться значения параметров,',;
                 'запомненные на момент ввода соответствующих документов.',;
                 'Документы, зарегистрированные в расчетах, пересчитаны не будут';
                   };
                 ,,' Продолжать? ',' Возврат ')
         BREAK
      ENDIF
   ENDIF
   RestScreen(,,,,sScreen)
   IF (nOper1:=BoxMenu(' Заменяемая операция ',5,10,aOper,,,,COL_SHEADR,COL_SHEADR,'NoClear'))==0
      BREAK
   ENDIF
   cCode1:=SUBSTR(aOper[nOper1],2,4)
   IF (nOper2:=BoxMenu(' Операцию '+cCode1+' заменить на: ',7,13,aOper,,,,COL_SHEADR,COL_SHEADR))==0
      BREAK
   ENDIF
   cCode2:=SUBSTR(aOper[nOper2],2,4)
/*   IF UPPER(cCode1)==UPPER(cCode2)
      SayError('Заменяемая операция должна отличаться!')
      BREAK
   ENDIF   */
   IF pVid+pType = '26'.AND. MCodOp->(DBSEEK(UPPER(pVid+pType+cCode2)),Schet_A) # MCodOp->(DBSEEK(UPPER(pVid+pType+cCode1)),Schet_A)
      SayError('При замене операции счет не должен изменяться!')
      BREAK
   ENDIF

   CASE nMode=2
   cText:='Изменение цен........[ ]'
   IF pVid='2'.AND.YesDop.AND.YesReal.AND.!_ROZNICA
      IF (nMode1:=BoxMenu(' Режим изменения цен: ',9,20,aItem1,,,,COL_SHEADR,COL_SHEADR,'NoClear',,'Wide'))=0
        BREAK
      ENDIF
      SAYSCREEN('√',10,22)
   ENDIF
   IF nMode1=1
      IF IF(IS_PSHFACT.OR.IS_SHFACT.OR._CN_PRESENT ,;
            !YesOrNo( IF (pVid ='1',  {'Цены в документах, созданных на основании',;
                                       'счетов-фактур, изменены не будут !'},;
                                      {'Режим осуществляет изменение цен в документах',;
                                       'не связанных со счетами-фактурами !' }   ),,' Продолжать? ',' Возврат '),.F.)
        BREAK
      ENDIF
      PRIVATE GetList:={},pProcent:=0,pRound:=0,pNakidka:=0,pSkidka:=0
      PRIVATE aKol:={;
      {-3,'до тысяч   '},;
      {-2,'до сотен   '},;
      {-1,'до десятков'},;
      { 0,'до целых   '},;
      { 1,'до десятых '},;
      { 2,'до сотых   '},;
      { 3,'до тысячных'}}
      ShadowBox("",nTop,nLeft,nBottom,nRight,COL_SHEADR,,'Wide')
      @ nTop+1,nLeft+2 SAY 'Изменить цены на:' GET m->pProcent PICT '9999.999 %'
      @ nTop+2,nLeft+2 SAY 'Округлить       :' GET m->pRound PICT 'XXXXXXXXXXX'
      GetList[2]:block:={|x|RotateBlock(x,m->aKol,'pRound')}
      GetList[2]:reader:={|x|RotateAndReader(x,m->aKol)}
      GetList[2]:display()
      SETCURSOR(1)
      READ
      SETCURSOR(0)
      RestScreen(,,,,sScreen)
      IF LastKey() = K_ESC
        BREAK
      ENDIF
   ENDIF
   IF LEN(aWork)==0
      IF !YesOrNo({'Режим изменяет '+IF(pVid='1','цены поставщиков ','отпускные цены ')+'с пересчетом ',;
                 'моделей калькуляции и проводок по всем документам '+IF(!(IS_PSHFACT.OR.IS_SHFACT),' !',','),;
                 IF((IS_PSHFACT.OR.IS_SHFACT), IF (pVid='1', 'кроме документов, созданных на основании счетов-фактур !', 'не связанным со счетами-фактурами ! ' ),'──────────────────────'),;
                 'Обработка производится только для текущего документа !'},,' Продолжать? ',' Возврат ')
        BREAK
      ENDIF
      AADD(aWork,{RECNO(),IF(MDOC->Vid=='1',SumOutR,Summa)})
      lOneDoc=.T.
   ELSE
      IF !YesOrNo({'Режим изменяет '+IF(pVid='1','цены поставщиков ','отпускные цены ')+'с пересчетом ',;
                 'моделей калькуляции и проводок по отмеченным документам,',;
                 IF((IS_PSHFACT.OR.IS_SHFACT),;
                    IF (pVid = '1' ,;
                        'кроме документов, созданных на основании счетов-фактур !' ,;
                        'не связянных со счетами-фактурами ! ' ) ,;
                    '──────────────────────'),;
                   'Документы, зарегистрированные в расчетах, пересчитаны не будут';
                 },,;
                 ' Продолжать? ',' Возврат ')
        BREAK
      ENDIF
   ENDIF

   CASE nMode=3
   cText:='Изменение параметров [ ]'
   RestScreen(,,,,sScreen)
   IF LEN(aWork)==0
      IF !YesOrNo({'Режим осуществляет подстановку значений параметров',;
                   'из справочника групп, используемых в калькуляциях и проводках,',;
                   'если значения параметров были изменены после ввода документа.' ,;
                   'Также производится пересчет калькуляций и проводок.'  ,;
                   IF((IS_PSHFACT.OR.IS_SHFACT),   'Подстановка не осуществляется для документов,','──────────────────────'),;
                   IF((IS_PSHFACT.OR.IS_SHFACT),  IF (pVid = '1' , 'созданных на основании счетов-фактур ! ', 'связанных со счетами-фактурами') ,''),;
                   'Обработка производится только для текущего документа !'},,' Продолжать? ',' Возврат ')
        BREAK
      ENDIF
      AADD(aWork,{RECNO(),IF(MDOC->Vid=='1',SumOutR,Summa)})
      lOneDoc=.T.
   ELSE

      IF !YesOrNo({'Режим осуществляет подстановку значений параметров',;
                   'из справочника групп, используемых в калькуляциях и проводках,',;
                   'если значения параметров были изменены после ввода документа.' ,;
                   'Также производится пересчет калькуляций и проводок.'  ,;
                   IF((IS_PSHFACT.OR.IS_SHFACT),   'Подстановка не осуществляется для документов,','──────────────────────'),;
                   IF((IS_PSHFACT.OR.IS_SHFACT),  IF (pVid = '1' , 'созданных на основании счетов-фактур ! ', 'связанных со счетами-фактурами') ,''),;
                   'Документы, зарегистрированные в расчетах, пересчитаны не будут',;
                   'Обработка производится только для отмеченных документов !'},,' Продолжать? ',' Возврат ')

        BREAK
      ENDIF
   ENDIF
ENDCASE
RestScreen(,,,,sScreen)
nWin1:=NoOrYes({'',cText,''},,,15,35,COL_SHEADR)
lYes := INDIK_NEW(18,61)
dbOpenBases(aBase,,,,.T.,.T.)
SH_OP->(ORDSETFOCUS("TAG_OPER"))
SH_FACT->(ORDSETFOCUS("TAG_OPER"))
SSH_OP->(ORDSETFOCUS("TAG_NNOPER"))
SSH_FACT->(ORDSETFOCUS("TAG_KREDIT"))
SELECT MCalc1
SET RELATION TO UPPER(Vid+Ident) INTO MPar
Main->(ORDSETFOCUS('Tag_NNOper'))
SELECT MDoc
IF LEN(aWork) > 0
  FOR i:=1 TO LEN(aWork)
   INDIK_UPDATE(lYes)
   GO aWork[i,1]
   IF !IsDateOut(MDoc->DATE,.T.).AND.EVAL(bFor)
     lErr:=.T.
   ENDIF
   IF  lFirstEnt.AND.!A3MaxDate(DateProv(MDoc->Pro))
       lFirstEnt:=.F.
       lErr:=.T.
   ENDIF
  NEXT
ELSE
  GO TOP
  WHILE !EOF()
     INDIK_UPDATE(lYes)
     IF !IsDateOut(MDoc->DATE,.T.).AND.EVAL(bFor)
        lErr:=.T.
     ENDIF
     IF  lFirstEnt.AND.!A3MaxDate(DateProv(MDoc->Pro))
         lFirstEnt:=.F.
         lErr:=.T.
     ENDIF
     SKIP
  ENDDO
ENDIF
INDIK_END(lYes)
WSELECT(nWin1)
WCLOSE()

dbCloseBases(aBase)
aWork:={}
IF nMode=1.AND.lErr
   SayError({'После перерасчета операций',;
             'в документах,помеченных знаком "?"',;
             'имеются ошибки!'})
ENDIF

END SEQUENCE

WSELECT(nWin)
RestScreen(,,,,sScreen)
RestSetKey(aSetKey)
SELECT MDoc
COMMIT
GO nRec
RETURN(2)
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 20 Jul 2007 15:35    Post subject: Reply with quote

10.

Code:
FUNCTION WinReport(cReport,cFile,cFile1,lDesigner)
/**********
cFile - имя файла описания шапки с полями:VarName,VarC,VarN,VarD,VarL,FieldName
или массив {cVarName,xVar, cField/nElement} - наименование, значение, имя поля в cFile1 или в номер значения в строке-массиве
сFile1 - имя файла строк или массив значений
В более сложных случаях может в cFile1 могут быть перечислены несколько файлов
через запятую,например "File1,File2,File3",тогда в первом файле сField указывается
в виде "File.Pield", где File - не обязательно полное имя файла таблицы,
может быть часть, лишь бы бы входила бы как часть имени и отличалась от других
Вместо файлов могут передаваться алиасы открытых областей (тогда, если их
несколько, в cField указывается точное название алиаса и имя поля через точку).
*********************************/


LOCAL nArea:=SELECT()
LOCAL aVar:={},aVar1:={},nField,xVal
LOCAL lTable1:=VALTYPE(cFile1)="C".AND.NetUses(cFile1,aVar1)
LOCAL lArray1:=VALTYPE(cFile1)=="A",aLen:={}
LOCAL lTable:=VALTYPE(cFile)="C".AND.(SELECT(cFile)>0.OR.NetUse("RpTable",cFile,,,,.T.))
LOCAL cVarFile:=TEMPFILE(m->GlobalTmpPath,"xml"),nVarFile
LOCAL cHead:="",cVar:='<Row i_d="1" ',j:=1,i,cSpisok,nSpisok
LOCAL aVar1N

IF !(VALTYPE(cReport)=="C".AND.!EMPTY(cReport))
   SayError("Ошибка в указании 1-го параметра (имени шаблона) WinReport!")
   RETURN "WINREPORT"
ELSEIF EMPTY(cFile)
   SayError("Ошибка в указании 2-го параметра WinReport!")
   RETURN "WINREPORT"
ENDIF

altd()

busy(.T.,"Подготовка данных")

IF lArray1
   //находим макс.длины полей, если задан массив строк
   ASIZE(aLen,LEN(cFile1[1]))
   AFILL(aLen,0)
   FOR i:=1 TO LEN(cFile1)
   FOR j=1 TO LEN(cFile1[i])
   IF VALTYPE(cFile1[i,j])=="C"
      aLen[j]:=MAX(aLen[j],LEN(cFile1[i,j]))
   ENDIF
   NEXT
   NEXT
   aVar1:={{"","",{}}}
ENDIF



IF lTable
   IF SELECT(cFile)>0
      DbSelectArea(cFile)
   ELSE
      SELECT RpTable
   ENDIF
   cAlias:=ALIAS()
   DbGoTop()
   WHILE !EOF()
      IF !(DELETED().OR.EMPTY(FIELD->VarName))


         IF EMPTY(FIELD->FieldName)
            xVal:=GetMyVar()
            AADD(aVar,{MyName(FIELD->VarName),VALTYPE(xVal),LenVar(xVal),xVal})
         ELSEIF lTable1

            AddVar1(aVar1,cFile1,MyName((cAlias)->VarName),(cAlias)->FieldName)
         ENDIF
      ENDIF
      SKIP
   ENDDO
ELSEIF VALTYPE(cFile)=="A"
   FOR i:=1 TO LEN(cFile)
   IF LEN(cFile[i])<3.OR.EMPTY(cFile[i,3])
      xVal:=cFile[i,2]
      AADD(aVar,{MyName(cFile[i,1]),VALTYPE(xVal),LenVar(xVal),xVal})
   ELSEIF lTable1
      AddVar1(aVar1,cFile1,MyName(cFile[i,1]),cFile[i,3])
   ELSEIF lArray1.AND.VALTYPE(cFile[i,3])=="N".AND.(nField:=cFile[i,3])>0
      AADD(aVar1[1,3],{MyName(cFile[i,1]),VALTYPE(cFile1[1,nField]),aLen[nField],nField})
   ENDIF
   NEXT
ENDIF



IF ( nVarFile := FCREATE(cVarFile) ) == -1
   SayError( "Ошибка создания временного файла "+cVarFile)
ELSE
   FWRITE(nVarFile,'<?xml version="1.0" encoding="windows-1251"?>'+CRLF)
   FWRITE(nVarFile,"<DataBase>"+CRLF)

   FWRITE(nVarFile,"<SMakers>"+CRLF)

   FWRITE(nVarFile,'<SMaker name="bda.s_maker">'+CRLF)
   //Шапка
   FWRITE(nVarFile,'<Part PartName="'+DosToXML("Шапка")+'" PartType="1">'+CRLF)
   FOR i:=1 TO LEN(aVar)
   cHead+=FieldToXml(i,aVar[i,1],aVar[i,2],aVar[i,3])
   cVar+=Fi(i)+'="'+ DosToXML(GetVal(aVar[i,4]))+'" '
   NEXT
   FWRITE(nVarFile,"<FieldDefs>"+CRLF)
   FWRITE(nVarFile,cHead)
   FWRITE(nVarFile,"</FieldDefs>"+CRLF)
   FWRITE(nVarFile,"<Rows>"+CRLF)
   cVar+="/>"+CRLF
   FWRITE(nVarFile,cVar)
   FWRITE(nVarFile,"</Rows>"+CRLF)
   FWRITE(nVarFile,'</Part>'+CRLF)

   IF lTable1.OR.lArray1
      FOR nSpisok:=1 TO LEN(aVar1)
      //Список
      cHead:=""
      cSpisok:="Список"
      IF LEN(aVar1)>1
         cSpisok+="_"+aVar1[nSpisok,4]
      ENDIF
      FWRITE(nVarFile,'<Part PartName="'+DosToXML(cSpisok)+'" PartType="1">'+CRLF)
      aVar1N:=aVar1[nSpisok,3]

      FOR i:=1 TO LEN(aVar1N)
      cHead+=FieldToXml(aVar1N[i,4],aVar1N[i,1],aVar1N[i,2],aVar1N[i,3])
      NEXT
      FWRITE(nVarFile,"<FieldDefs>"+CRLF)
      FWRITE(nVarFile,cHead)
      FWRITE(nVarFile,"</FieldDefs>"+CRLF)
      FWRITE(nVarFile,"<Rows>"+CRLF)
      j:=1
      IF lTable1
         DbSelectArea(aVar1[nSpisok,2])
         dbGoTop()
         WHILE !EOF()
            cVar:='<Row i_d="' + LTRIM(STR(j++,10,0))+'" '
            FOR i:=1 TO LEN(aVar1N)
            IF (nField:=aVar1N[i,4])>0
               cVar+=FI(nField)+'="'+ DosToXML(GetVal(FIELDGET(nField)))+'" '
            ENDIF
            NEXT
            cVar+="/>"+CRLF
            FWRITE(nVarFile,cVar)
            SKIP
         ENDDO
      ELSE
         FOR j:=1 TO LEN(cFile1)
         cVar:='<Row i_d="' + LTRIM(STR(j,10,0))+'" '
         FOR i:=1 TO LEN(aVar1N)
            IF (nField:=aVar1N[i,4])>0
               cVar+=FI(nField)+'="'+ DosToXML(GetVal(cFile1[j,nField]))+'" '
            ENDIF
            NEXT
            cVar+="/>"+CRLF
            FWRITE(nVarFile,cVar)
         NEXT
      ENDIF
      FWRITE(nVarFile,"</Rows>"+CRLF)
      FWRITE(nVarFile,'</Part>'+CRLF)
      NEXT //nSpisok
   ENDIF

   FWRITE(nVarFile,"</SMaker>"+CRLF)
   FCLOSE(nVarFile)
   AppendDopFile(cVarFile)

ENDIF


busy(.F.)
IF lTable.AND.SELECT("RpTable")>0
   RpTable->(DbCloseArea())
ENDIF
IF lTable1
   NetCloses(aVar1)
ENDIF

FRCall("ShowReport",LoadPath()+cReport,cVarFile,IF(lDesigner!=NIL.AND.lDesigner,1,0),1)
WHILE .T.
   INKEY(.1)
   IF !FILE(cVarFile)
      Exit
   ENDIF
ENDDO
SELECT(nArea)

RETURN "WINREPORT"
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 25 Jul 2007 14:32    Post subject: Reply with quote

11.

Code:
 Function _SC(nCo)

   MemVar aLines

   If Y_Type(MemVarBlock("NFLAG"), "B")

    Return(If(nCo > 0 .And. nCo < Val(FiGet(NCOL)),;
            1,;
            (;
               SayError({"Выражение в формуле: _SC(" + LTrim(Str(nCo)) +;
                         ")  - должно ссылаться на номер",;
                         "колонки, которая расcчитыва" +;
                         "ется раньше текущей колонки!"}, 15),;
               NIL;
            )))

   EndIf

 Return (aLines[nCo, 1])
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 30 Jul 2007 14:35    Post subject: Reply with quote

12.

Code:
 Function AMLoad(cMemoField)

   MemVar nQCol, aEmpty

   Local cStr := FsGet(cMemoField)
   Local nLen := Len(cStr) / 16
   Local aRet

   If(nLen == nQCol,;
    (;
       aRet := Array(nLen, 2),;
       AEval(aRet,;
             {;
                |x, i, p|;
                p := (i - 1) * 16 + 1,;
                aRet[i, 1] := Val(SubStr(cStr, p, 15)),;
                aRet[i, 2] := Val(SubStr(cStr, p + 15, 1));
             });
    ),;
    aRet := AClone(aEmpty))

 Return (aRet)
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 13 Aug 2007 11:05    Post subject: Reply with quote

13.
Code:
FUNCTION Comment(lWrite,lView)
LOCAL nWin:=WSELECT()
LOCAL aSetKey:=SaveSetKey(),cLastColor
LOCAL nTop:=8,nLeft:=13,nBottom:=15,nRight:=70
LOCAL sRest,sRest24,cSclads:=pSclads, oldCursor
WSELECT(0)
sRest:=SAVESCREEN(nTop,nLeft,nBottom,nRight)
sRest24:=SAVESCREEN(23,0,24,79)
cLastColor:=SETCOLOR(COL_SHEADR)
@ nTop,nLeft TO nBottom,nRight DOUBLE COLOR COL_SHEADR
@ nTop,nLeft+20 SAY ' Комментарий '
IF !_REC_YES
   lView:=.T.
ENDIF
IF lView==NIL
   ScrTitul(24,"Ctrl┘:Конец ввода ┘:Новая строка Ctrl-Y:Удалить строку Ins:Режим вставки")
   ScrTitul(23,"")
   SETKEY(K_CTRL_RET,{||Keyb(K_CTRL_W)})
ENDIF
oldCursor=IF(lView==NIL,SETCURSOR(1),SETCURSOR(0))
pSclads:=MEMOEDIT(pSclads,nTop+1,nLeft+1,nBottom-1,nRight-1,(lView==NIL),'FunBook',100)
IF lView==NIL.AND.!pSclads==cSclads
   pUpDated:=.T.
   IF lWrite!=NIL
      RecLock()
      REPLACE Sclads WITH pSclads
      UNLOCK
      COMMIT
   ENDIF
ENDIF
SETCURSOR(oldCursor)
RestSetKey(aSetKey)
SETCOLOR(cLastColor)
RESTSCREEN(nTop,nLeft,nBottom,nRight,sRest)
RESTSCREEN(23,0,24,79,sRest24)
WSELECT(nWin)
RETURN(NIL)
Back to top
View user's profile Send private message Send e-mail
nordk



Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб

PostPosted: 13 Aug 2007 15:54    Post subject: Reply with quote

14

Code:
FUNCTION Saldo( cVO, aPar )  // сальдо счета
  LOCAL nRez := 0, cSchet, i, cCode, cNS, cKey := '', cAlias,;
        aOst:= {0,0}
  FIELD DTOB_n,KTOB_n,DTOST,KTOST

  cNS := UPPER(aPar[1])
  IF ( i:=AT(".", cNS) ) == 0
    cAlias := 'TMP'
    IF ( i := AT("*", cNS) ) == 0                  //Сюда
       cSchet := PADR( ALLTRIM( cNS ) , 10 )
       i := 10
    ELSEIF i == 3
       i := 2
       cSchet := LEFT( cNs, i )
       cAlias := "TMPSCHET"
    ELSE
      i--
      cSchet := LEFT( cNs, i )
    ENDIF
    cKey := aVariables[1][2]+cSchet
    //(cAlias)->( SetScope( '', cKey,, {OrdSetFocus()} ),;
    (cAlias)->( SetScope( OrdKey(), cKey ),;
                /*BROWSE(),*/;
                dbEval( {||IF(RIGHT(cVo,1) == "0" , aOst[1] += DTOB_n, ),;
                           IF(RIGHT(cVo,1)==  "1" , aOst[1] += DTOST,  ),;
                           IF(RIGHT(cVo,1) == "0" , aOst[2] += KTOB_n, ),;
                           IF(RIGHT(cVo,1) == "1" , aOst[2] += KTOST,  ) ;
                         } ),;
                SETSCOPE();
              )
     nRez := OstSchet(aOst, cSchet, '', aVariables[1][2], {        ;
               {0,.T.},;
               {0,.T.} ;
              })[IF(LEFT(cVo,1)=='0',1,2)][1]
  ELSE
    cSchet := PADR( ALLTRIM( LEFT(cNS, i-1)  ), 10 )
    cCode  := SUBSTR(cNS, i+1)
    IF ( i := AT("*", cSchet) ) <> 0
       cSchet := LEFT( cSchet, --i)
    ENDIF
    cKey := aVariables[1][2]+cSchet
    IF ( i := AT("*", cCode) ) == 0
      i := 6
      cCode  :=   Global_Analit( cCode )
    ELSE
      i--
      cCode := LEFT( cCode, i )
    ENDIF
    IF LEN(cSchet) == 10 ;   cKey += cCode ;    ENDIF

    TMPANAL->( SetScope( '', cKey,, { OrdSetFocus() } ),;
               dbEval( {||IF(cVo == "00" , nRez += TMPANAL->DTOB_n, ),;
                          IF(cVo == "01" , nRez += TMPANAL->DTOST,  ),;
                          IF(cVo == "10" , nRez += TMPANAL->KTOB_n, ),;
                          IF(cVo == "11" , nRez += TMPANAL->KTOST,  ) ;
                       },;
                       {|| TMPANAL->CODE = cCode };
                     ),;
               SetScope();
            )
  ENDIF

   IF nErrorTmp <> -1 // предупреждения нужны
    IF !VALUTA->(dbSEEK( aVariables[1][2]) )
      Str2File( " Код валюты: "+aVariables[1][2]+" отсутствует в справочнике валют", nErrorTmp )
    ENDIF
      IF !PLAN->(dbSEEK( cSchet ))
      Str2File( "Строка N"+STR(nLine,10)+" Счет: "+cSchet+" отсутствует в плане счетов", nErrorTmp )

      ELSEIF cCode <> NIL     .AND. ;
                !ANALIT->(dbSEEK( cSchet+cCode ))
         Str2File( "Строка N"+STR(nLine,10)+" Аналитический счет: "+cCode+;
                     " на счете: "+cSchet+"отсутствует", nErrorTmp )
      ENDIF
   ENDIf

RETURN (nRez)
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   This topic is locked: you cannot edit posts or make replies.   printer-friendly view     Forum Index -> Программирование в БЭСТ-4 All times are GMT + 4 Hours
Goto page 1, 2  Next
Page 1 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © phpBB Group

Rambler
Rambler's Top100 Рейтинг@Mail.ru