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) |
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) |
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) |
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 |
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. |
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 |
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 |
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 |
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) |
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" |
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]) |
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) |
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) |
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) |
output generated using printer-friendly topic mod. All times are GMT + 4 Hours