Автоматизированное рабочее место

Файл Дополнения\Изменения – ADD_DEL.PRG

************************************************************************************* Дополнение\Изменение данных **

*********************************************************************

PROCEDURE ins && Процедура Дополнения\Изменения

PARAMETERS d_ins

ord_a=order()

CLEAR

RELEASE KW,GW,XW,KS,ELC,TL,RD,OT,OR1,LG_TA

HIDE POPUP serv

ON KEY LABEL F1 DO HELP WITH 8

ON KEY LABEL F7 DO N_YDOS_AND_KOD

sele a

STORE .F. TO _PAD_OTCH

DEFINE POPUP YL FROM 4,10

n=recno()

m=1

br=1

DIMENSION yl_za(100,1)

go top

i=1

yl_za(i,1)=yl

DO WHILE !EOF()

DEFINE BAR (br) OF YL PROMPT yl_za(i,1)

IF yl=yl_za(i,1)

skip

loop

ENDIF

m=m+1

i=i+1

yl_za(i,1)=yl

br=br+1

ENDDO

DIMENSION yl_za(m,1)

ON SELECTION POPUP YL DO YLIZ WITH PROMPT()

define window hp from 12,28 to 20,60 shadow color scheme 16

DO CASE

CASE d_ins=1

SCATTER MEMVAR BLANK

STORE 1 TO red

set skip to

CLOSE DATA

SELE i

USE HELP

SELE a

USE RABOT

SELE d

USE LGOT

CASE d_ins=2

IF RECCOUNT()=0

RETURN

ELSE

GO _REC

kw=kw_l

gw=g_w_l

xw=x_w_l

ks=k_ys_l

ot=otop_l

elc=el_c_l

tl=tel_l

rd=rad_l

lg_ta=lgot

or1=or_r

yl_ins=yl

dom_ins=dom

k_ins=kw_ra

SCATTER MEMVAR

STORE 2 TO red

ENDIF

ENDCASE

ACTIVATE WINDOW INS

=POS_CH2()

@ 1,10 GET m.fam

@ 2,10 GET m.tab picture '9999' VALID unic() ERROR 'Повтор Табеля'

@ 2,28 GET m.tel picture '99999999'

@ 3,10 GET m.yl WHEN yliz_s()

@ 3,30 GET m.dom PICTURE 'NNNN'

@ 3,40 GET m.kw_ra picture 'nnnn'

@ 4,10 GET m.kv_m picture '###.##' default ''

*@ 5,39 GET m.kol_vo DISABLE

*@ 3,2 GET yl_z FUNCTION '*I ' VALID YLIZ1() WHEN INS2() DEFA 1 SIZE 1,7

@ 5,35 GET m.elec picture '999999'

@ 6,35 GET m.elec1 picture '999999'

@ 5,43 GET or1 FUNCTION '*C Ордер' VALID O_R() DEFA 0 COLOR SCHEME 16

@ 6,43 GET lg_ta FUNC '*C Льгота' VALID vib_lg() DEFA .f.COLOR SCHEME 16

@ 8,1 to 8,70 double

@ 12,2 GET kw FUNCTION '*C Квартплата' DEFAULT .F. VALID KW_INS() COLOR SCHEME 16

@ 13,2 GET gw FUNCTION '*C Горячая вода' VALID GW_INS() defa .f. COLOR SCHEME 16

@ 14,2 GET xw FUNCTION '*C Холодная вода' VALID XW_INS() DEFA .F. COLOR SCHEME 16

@ 15,2 GET ks FUNC '*C Комунальные услуги' VALI KS_INS() DEFA .F. COLO SCHEME 16

@ 16,2 GET ot FUNCTION '*C Отопление' VALID OT_INS() DEFA .F. COLOR SCHEME 16

@ 17,2 GET elc FUNC '*C Электроэнергия' VALID ELC_INS() DEFA .F. COLOR SCHEME 16

@ 18,2 GET tl FUNCTION '*C Телефон' VALID TL() WHEN TL1() DEFA .F. COLOR SCHEME 16

@ 19,2 GET rd FUNCTION '*C Радио' VALID rd() WHEN rd1() DEFA .F. COLOR SCHEME 16

*@ 10,30 SAY 'Категория'

*@ 10,47 get d.info

@ 11,30 say 'Действительна с' COLOR SCHEME 17

@ 11,47 get m.dat_c COLOR SCHEME 17

@ 11,58 say 'по' COLOR SCHEME 17

@ 11,61 get m.dat_po VALID IIF(m.dat_c=0

DEFINE POPUP LGOT FROM 2,27 PROMPT FIELD LTRIM(STR(N_LG))+' | '+INFO

ON SELECTION POPUP LGOT DO LG_T WITH RECNO()

ACTIVATE POPUP LGOT

ENDIF

FUNCTION LG_T && Выбор кода льготы

PARA R

N=RECNO()

SELE D

GO R

m.n_lg=n_lg

sele a

show get m.n_lg

DEACTIVATE POPUP LGOT

FUNCTION vib_lg && Выбор льготы (дополнение льготы)

DO CASE

CASE lg_ta=.t.

m.lgot=.T.

activate window hp

@ 0,0 to 4,0 double

@ 0,26 to 5,26 double

@ 1,2 say 'Укажите группу'

@ 1,18 get m.n_lg picture '99' WHEN LG1() default 2

@ 3,2 say 'N удостоверения'

@ 3,18 get m.n_yd

read color scheme 7

deactivate window hp

IF m.n_lg=0

lg_ta=.f.

m.lgot=.f.

show get lg_ta

SHOW GETS

else

LOCATE FOR m.n_lg=d.n_lg

IF FOUND()=.F.

SELE d

APPEND BLANK

REPLACE N_LG WITH m.n_lg

SELE a

ENDIF

@ 8,30 say 'Ввод ставок по льготам'

@ 9,30 SAY 'КОД - ' GET m.n_lg disable

SHOW GETS

endif

CASE lg_ta=.f.

m.lgot=.F.

SHOW GETS

ENDCASE

RETURN

***********************************************************************************

** Выбор начислений на услуги **

***********************************************************************************

FUNCTION KW_INS

M.KWP_L=KW

FUNCTION GW_INS

M.G_W_L=GW

FUNCTION XW_INS

M.X_W_L=XW

FUNCTION KS_INS

M.K_YS_L=KS

FUNCTION ELC_INS

M.EL_C_L=ELC

FUNCTION OT_INS

M.OTOP_L=OT

***********************************************************************************

FUNCTION TL2 && Определение выбора телефона

IF or1=2

m.tel=0

else

m.tel_l=.t.

tl=.t.

endif

RETURN
FUNCTION O_R && Недопущение повтора плательщика

DO CASE

CASE or1=1

r=recno()

y_l=LTRIM(m.yl)

d=LTRIM(m.dom)

k=LTRIM(m.kw_ra)

locate for yl=y_l.and.dom=d.and.kw_ra=k.and.or_r=1

if found()

if tab#m.tab

activate window vib

@ 0,0 say 'Двое за 1 квартиру платить не могут' color scheme 12

@ 2,1 say 'За квартиру платит:'

@ 3,2 say fam+ 'Таб.'+STR(tab,4)

READ

deactivate window vib

if red=2

go r

ENDIF

m.or_r=0

or1=0

show get or1,1

RETURN .F.

ENDIF

endif

if red=2

go r

ENDIF

deactivate window vib

m.or_r=1

@ 8,5 SAY 'ВЫБЕРИТЕ УСЛУГИ'

SHOW GETS

case or1=0

m.or_r=0

@ 8,0 CLEAR TO 23,29

SHOW GETS

ENDCASE

RETURN
FUNCTION unic && Недопущение повтора табеля

do case

case red=1

SELE a

locate for tab=m.tab

if found()

activate window vib

@ 0,1 say 'Ошибка ввода табельного номера' color scheme 12

@ 2,1 say 'Такая запись в базе уже есть'

@ 3,2 say fam+STR(tab,4)

READ

deactivate window vib

RETURN .F.

ENDIF

ENDCASE

deactivate window vib

RETURN

PROCEDURE ad_in && Процедура Дополнения/Изменения

m.fam=LTRIM(m.fam)

m.yl=LTRIM(m.yl)

m.dom=LTRIM(m.dom)

m.kw_ra=LTRIM(m.kw_ra)

k_v=m.kv_m

IF m.or_r=0

m.tel=0

m.tel_l=.f.

k_v=0

ENDIF

IF m.or_r=1.and.!empty(m.tel)

m.tel_l=.t.

tl=.t.

ELSE

m.tel_l=.f.

ENDIF

DO CASE

CASE pod=1

DO CASE

CASE red=1

SELE a

GO top

APPEND BLANK

GATHER MEMVAR

t=tab

r=RECNO()

_REC=RECNO()

y_l=yl

d=dom

k=kw_ra

skip

LOCATE ALL FOR y_l=yl.and.d=dom.and.k=kw_ra

DO CASE

CASE FOUND()

IF recno()=r

REPLACE kol_vo WITH 1

ELSE

store kol_vo to k_l_vo

GO r

REPLACE kol_vo WITH k_l_vo

go 1

SCAN for y_l=yl.and.d=dom.and.k=kw_ra

REPLACE kol_vo WITH kol_vo + 1

IF or_r=1

k_v=kv_m

ENDIF

ENDSCAN

ENDIF

ENDCASE

GO r

REPLACE kv_m WITH k_v

SELE g

USE TABLE_R

LOCATE ALL FOR tab=t

IF FOUND()=.F.

go top

APPEND BLANK

REPLACE g.tab WITH a.tab

endif

R_G=RECNO()

SELE a

go r

LOCATE ALL FOR y_l=yl.and.d=dom.and.k=kw_ra.AND.or_r=1

IF FOUND()

SELE G

GO R_G

KP=KWP_L

G=GW_L

X=XW_L

KY=K_L_L

O=OT_L

R_D=RD_L

T_L=TL_L

E=EL_L

SELE a

GO r

SELE g

REPLACE g.kwp_l WITH KP,g.tl_l WITH T_L,g.rd_l WITH R_D,;

g.gw_l WITH G,g.xw_l WITH X,g.k_l_l WITH KY,g.ot_l WITH O,g.el_l WITH E

ENDIF

SELE a

SCATTER MEMVAR BLANK

kw=.F.

gw=.F.

xw=.F.

ks=.F.

ot=.F.

elc=.F.

tl=.F.

rd=.F.

lg_ta=.F.

or1=0

SHOW GETS

_CUROBJ=1

CASE red=2

GO _REC

GATHER MEMVAR

IF yl_ins=yl.AND.dom_ins=dom.AND.k_ins=kw_ra

RETURN

ELSE

y=yl

d=dom

k=kw_ra

SET FILTER TO y=yl.AND.d=dom.AND.k=kw_ra

COUNT TO kol

SCAN

REPLACE kol_vo WITH kol

ENDSCAN

GO TOP

SET FILTER TO yl_ins=yl.AND.dom_ins=dom.AND.k_ins=kw_ra

COUNT TO kol

SCAN

REPLACE kol_vo WITH kol

ENDSCAN

SET FILTER TO

GO _REC

ENDIF

ENDCASE

CASE pod=2

CLEAR READ

CASE pod=3

DO DEL

ENDCASE

RETURN

PROCEDURE del && Удаление записи в БАЗЕ RABOT

n=RECNO()

SET DELETE OFF

IF DELETE()

RETURN

ENDIF

GATHER MEMVAR

y_l=yl

d=dom

k=kw_ra

GO TOP

SET FILTER TO y_l=yl.and.d=dom.and.k=kw_ra

COUNT TO kol

GO TOP

kol=kol-1

SCAN

REPLACE kol_vo WITH kol

ENDSCAN

SET FILTER TO

GO n

DELETE

SET DELETE ON

SKIP

IF EOF()=.T.

GO TOP

ENDIF

IF WONTOP()='INS'

@ 10,27 CLEAR TO 20,50

=POS_CH1()

SHOW GETS

ENDIF

RETURN

***********************************************************************************

** Функции к дополнению по льготам (ADD_DEL.PRG) **

***********************************************************************************

FUNCTION LG_INS

DO CASE

CASE LG_INS=1

m.info=LTRIM(m.info)

LOCATE FOR m.n_lg=d.n_lg

IF FOUND()

GATHER MEMVAR

SCATTER MEMVAR BLANK

SHOW GETS

ELSE

APPEND BLANK

GATHER MEMVAR

SCATTER MEMVAR BLANK

SHOW GETS

ENDIF

CASE LG_INS=2

CLEAR READ

CASE LG_INS=3

GATHER MEMVAR

DELETE

PACK

SCATTER MEMVAR BLANK

SHOW GETS

ENDCASE

RETURN

FUNCTION UNIC_LG

m=m.n_lg

LOCATE FOR m.n_lg=d.n_lg

IF FOUND()

SCATTER MEMVAR

SHOW GETS

ELSE

SCATTER MEMVAR BLANK

m.n_lg=m

SHOW GETS

ENDIF

RETURN

***********************************************************************************

** Функции К Базам (Bazes.Prg) **

***********************************************************************************

FUNCTION ins2 && Выбор Дополнения, при пустой БАЗЕ

DO CASE

CASE ins1=1

DO INS WITH 1 IN ADD_DEL

CASE ins1=2

CLEAR READ

ENDCASE

RETURN
PROCEDURE NACH && Функция отображения начислений

@ 0,31 clear to 23,79

@ 3,31 to 23,78 double

set color of scheme 13 to N/W,GR/W, N/W, N/W,Gr/W,Gr/W,Gr/W,Gr/W,Gr/W,Gr/W

@ 4,32 fill to 22,77 color scheme 13

@ 3,45 say 'Произведенные начисления'

@ 4,34 say 'Фамилия' color scheme 13

@ 4,46 get fam disable color scheme 13

@ 5,34 say 'Табель' color scheme 13

@ 5,45 get tab disable color scheme 13

@ 6,45 get kv_m picture '###.##' disable color scheme 13

@ 6,34 say 'Площадь'color scheme 13

@ 7,34 say 'Категория' color scheme 13

@ 7,45 get d.info disable color scheme 13

@ 8,34 say 'Кол-во жильцов - '+ltrim(str(kol(0))) color scheme 13

@ 9,34 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12

@ 7,60 say 'удостов. N'color scheme 13

@ 7,68 get n_yd disable color scheme 13

@ 10,58 SAY 'Сумма' COLOR B/W,,,,,,,,,

@ 10,67 SAY 'На одного' COLOR B/W,,,,,,,,,

@ 11,35 say 'Сальдо'color scheme 13

@ 11,47 SAY ost_k color r/W,,,,,,,,,

@ 12,35 say 'Кв-плата'color scheme 13

@ 12,47 get c.kw_pl disable color scheme 13

@ 12,58 say LTRIM(STR(c.sum_kw,6,2)) color r/W,,,,,,,,,

@ 13,35 say 'Гор.вода'color scheme 13

@ 13,47 get c.g_w disable color scheme 13

@ 13,58 say ltrim(str(c.sum_gw,6,2)) color r/W,,,,,,,,,

@ 14,35 say 'Хол.вода'color scheme 13

@ 14,47 get c.x_w disable color scheme 13

@ 14,58 say ltrim(str(c.sum_xw,6,2)) color r/W,,,,,,,,,

@ 15,35 say 'Ком.услуги'color scheme 13

@ 15,47 get c.k_ysl disable color scheme 13

@ 15,58 say ltrim(str(c.sum_kysl,6,2)) color r/W,,,,,,,,,

@ 16,35 say 'Отопление'color scheme 13

@ 16,47 get c.otopl disable color scheme 13

@ 16,58 say ltrim(str(c.sum_ot,6,2)) color r/W,,,,,,,,,

@ 17,35 say 'Радио'color scheme 13

@ 17,47 get c.rad_r disable color scheme 13

@ 17,58 say ltrim(str(c.sum_rd,6,2)) color r/W,,,,,,,,,

@ 18,35 say 'Телефон'color scheme 13

@ 18,47 get c.tel_r disable color scheme 13

@ 18,58 say ltrim(str(c.sum_tl,6,2)) color r/W,,,,,,,,,

@ 19,35 say 'Э-энергия' color scheme 13

@ 19,47 get c.el_c disable color scheme 13

@ 20,35 say 'Начисл.'color scheme 13

@ 20,47 get c.itog_n disable color scheme 13

@ 20,58 say LTRIM(STR(C.SUM_IT,7,2)) color r/W,,,,,,,,,

@ 21,32 to 21,77 color scheme 13

@ 22,35 say 'К оплате' color scheme 13

@ 22,47 get c.itog disable color scheme 13

@ 12,68 say LTRIM(STR(c.kw_pll,6,2)) COLOR N/W,,,,,,,,,

@ 13,67 say ltrim(str(c.g_wl,6,2)) color N/W,,,,,,,,,

@ 14,67 say ltrim(str(c.x_wl,6,2)) color N/W,,,,,,,,,

@ 15,67 say ltrim(str(c.k_ysll,6,2)) color N/W,,,,,,,,,

@ 16,67 say ltrim(str(c.otopll,6,2)) color N/W,,,,,,,,,

@ 18,67 say ltrim(str(c.tel_rl,6,2)) color N/W,,,,,,,,,

@ 17,67 say ltrim(str(c.rad_rl,6,2)) color N/W,,,,,,,,,

@ 20,67 SAY LTRIM(STR(C.ITOG_L,7,2)) color n/w

READ

RETURN

FUNCTION EN && Функция для полей базы пункта-Работа с картотекой

ON KEY LABEL enter DO pop_vib

ON KEY LABEL rightmouse DO pop_vib && KEYBOARD '{enter}'

RETURN

FUNCTION NE

ON KEY LABEL enter

ON KEY LABEL rightmouse

RETURN
FUNCTION pop_vib && READ-меню

ON KEY LABEL enter

dimension pop(10,1)

store ' Постоянная часть ' to pop(1)

store ' Начисления ' to pop(2)

store ' Жильцы ' to pop(3)

store ' Плательщики ' to pop(4)

STORE ' Печать ' TO pop(5)

store ' Поиск ' to pop(6)

STORE ' Дополнение ' TO pop(7)

STORE ' Изменение ' TO pop(8)

STORE ' Ввод оплаты' TO pop(9)

STORE ' Выход из системы ' TO pop(10)

store 0 to mpop

set color to w/r,r/w, b/n,r*

@ 8,28 menu pop(10),10 TITLE 'Выбор за Вами'

read menu to mpop

set color to

DO CASE

CASE MPOP=1

DO pos_ch

CASE mpop=2

DO nach

CASE mpop=3

DO kv_sch

CASE mpop=4

DO KDR_R

CASE mpop=5

DO print1

CASE mpop=6

ACTIVATE POPUP POISK

CASE mpop=7

DO ins WITH 1 IN ADD_DEL

CASE mpop=8

DO ins WITH 2 IN ADD_DEL

CASE mpop=9

DO vvv IN bazes

CASE mpop=10

DO QUIT

ENDCASE

RETURN

FUNCTION sal && Функция отображения в (поле SAY) остатка

PARAMETERS s

SELE a

DO CASE

CASE EMPTY(opl_ta)

S=c.itog*(-1)

CASE !EMPTY(opl_ta)

op=opl_ta

it=c.itog

S=op-it

REPLACE OST_K WITH S

ENDCASE

RETURN S

FUNCTION SM && Функция сохранения предыдущего остатка

IF !EMPTY(opl_ta).AND.AVS=.F.

ACTIVATE WINDOW vib

@ 0,1 SAY 'Уплачено ' COLOR G+/B

@ 0,10 SAY ALLTRIM(DTOC(D_OPL))

@ 0,21 SAY ' Сумма - ' COLOR G+/B

@ 0,30 SAY LTRIM(STR(opl_ta,7,2))

@ 2,2 GET SV2 FUNCTION '*h Дописать;Переписать' VALID sv2() DEFAULT 1;

SIZE 1,10,2 color scheme 7

@ 4,3 GET AVS FUNCTION '*C Сохранять автоматически'

READ CYCLE OBJECT 1

DEACTIVATE WINDOWS VIB

ENDIF

RETURN

FUNCTION SV2 && Функция выбора кнопок _

DO CASE

CASE SV2=1

CLEAR READ

SHOW GETS

CASE SV2=2

REPLACE OPL_TA WITH 0

SHOW GETS

ENDCASE

RETURN

FUNCTION SV3 && Сохранение

os=(opl_ta+opl)-c.itog

REPLACE opl_ta WITH opl_ta+opl,d_opl WITH dat,ost_k WITH os

RETURN

FUNCTION SAV && Выбор кнопок

DO CASE

CASE SAV=1

DO SV3

RELEASE WINDOW M_ZAR

CASE SAV=2

CLEAR READ

RELEASE WINDOW M_ZAR

ENDCASE

RETURN

***********************************************************************************

** Статус-строка в: Картотеке льготников, База жильцов,Ввод оплаты,счетчика **

***********************************************************************************

FUNCTION INFO

@ 21,0 clear to 24,80

@ 21,1 TO 24,79 DOUBLE

SELE a

R=RECNO()

Y=YL

D=DOM

KV=KW_RA

LOCATE FOR YL=Y.AND.DOM=D.AND.KW_RA=KV.AND.OR_R=1

IF RECNO()=R

@ 21,1 fill to 24,79 color scheme 12

@ 22,3 say 'Кол-во жильцов - '+ltrim(str(kol(0))) color scheme 12

@ 23,3 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12

@ 22,30 say 'К оплате - ' color scheme 12

@ 22,41 get c.itog disable color scheme 12

@ 23,30 say 'Сальдо - 'color scheme 12

@ 23,41 get ost_k disable color scheme 12

ELSE

@ 21,1 fill to 24,79 color scheme 12

@ 22,5 SAY 'Привязан к - ' color scheme 12

@ 22,20 SAY ALLTRIM(FAM)

@ 23,5 SAY 'Табель - ' color scheme 12

@ 23,20 SAY ALLTRIM(STR(tab))

endif

GO R

RETURN
FUNCTION INFO3 && Статус-строка в процедуре: Ввод оплаты

@ 21,0 clear to 24,80

@ 21,1 TO 24,79 DOUBLE

R=RECNO()

Y=YL

D=DOM

KV=KW_RA

@ 21,1 fill to 24,79 color scheme 12

@ 22,3 SAY 'Адрес: '+YL+' Дом '+dom+' Кв-ра '+kw_ra

@ 23,3 say 'Кол-во жильцов - '+ltrim(str(kol(0))) color scheme 12

@ 23,26 say 'Из них льготников - ' +ltrim(str(kl_l(0))) COLOR SCHEME 12

FUNCTION r && Функция обновления при работе с базой по оплате счетчика

REPLACE for tab=c.tab c.el_c WITH _elek*(a.elec1-a.elec),;

c.itog_n WITH c.itog_n+c.el_c,c.itog WITH c.itog+c.el_c

RETURN

** Функции к Процедурам РАСЧЕТОВ **

*********************************************************************************** ** Процедура расчета по квартплате **

***********************************************************************************

FUNCTION ras_1

DEACTIVATE WINDOW vib

DO CASE

CASE rs_n=1

CLEAR READ

SELE c

ZAP

APPEND FROM rabot FIELDS tab,yl,dom,kw_ra,lgot,n_lg,or_r,kol_vo,kw_l,;

tel_l,g_w_l,x_w_l,k_ys_l,el_c_l,otop_l,kv_m

reindex

CLOSE DATA

USE rabot IN a

SET FILTER TO or_r=1

SELECT b

USE oplata

******Создание новой базы из двух имеющихся (RABOT and OPLATA)*********************

JOIN WITH a TO rach FOR yl=a.yl.and.dom=a.dom.and.kw_ra=a.kw_ra.and.tab=a.tab; FIELDS a.fam,a.yl,a.dom,a.kw_ra,a.tel,a.elec,a.elec1,tab,kw_pl,itog_n,tel_r,;

rad_r,g_w,x_w,k_ysl,otopl,el_c,a.kol_vo,a.kw_l,a.tel_l,a.rad_l,a.g_w_l,a.x_w_l,;

a.k_ys_l,a.el_c_l,a.otop_l,a.kv_m && Вспомогательная база (слияние двух баз)

***********************************************************************************

CLOSE DATA

SELE a

USE rach

IF .NOT. FILE('rach.cdx')

INDEX ON tab TAG tab

INDEX ON fam TAG fam

INDEX ON yl+dom+kw_ra+str(tab) TAG adrr UNIQUE

ENDIF

SELE c

USE rabot

SET ORDER TO ADRR

SELE g

USE table_r

SET ORDER TO tab

SELE rach

SET RELA TO yl+dom+kw_ra+str(tab) INTO c ADDI

SET RELA TO TAB INTO g ADDI

** РАСЧЕТ **

REPLACE ALL kw_pl WITH IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,kv_m,0),;

g_w WITH IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,kol_vo,0),;

x_w WITH IIF(g.xw_l=0,_xol_w,g.xw_l) *IIF(x_w_l=.t.,kol_vo,0),;

k_ysl WITH IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,kol_vo,0),;

otopl WITH IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,kv_m,0),;

tel_r WITH IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,IIF(empty(tel),0,1),0),;

rad_r WITH IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0),;

el_c WITH IIF(g.el_l=0,_elek,g.el_l)*IIF(el_c_l=.t.,(elec1-elec),0)

REPLACE ALL itog_n WITH kw_pl+tel_r+rad_r+g_w+x_w+k_ysl+el_c+otopl

CALCULATE SUM(KW_PL),SUM(G_W),SUM(X_W),SUM(K_YSL),SUM(OTOPL),SUM(RAD_R),;

SUM(TEL_R),SUM(EL_C),SUM(ITOG_N) TO SKW,SG,SX,SK,SOT,SR,ST,SEL,SM

@ 22,0 SAY 'Кв.плата Гор.вода Хол.вода Ком.усл Отопление Э\энер.Телеф. Радио; ИТОГ '

@ 23,0 SAY LTRIM(STR(SKW,9,2))

@ 23,9 SAY LTRIM(STR(SG,9,2))

@ 23,18 SAY LTRIM(STR(SX,9,2))

@ 23,27 SAY LTRIM(STR(SK,9,2))

@ 23,36 SAY LTRIM(STR(SOT,9,2))

@ 23,46 SAY LTRIM(STR(SEL,9,2))

@ 23,53 SAY LTRIM(STR(ST,9,2))

@ 23,61 SAY LTRIM(STR(SR,7,2))

@ 23,68 SAY LTRIM(STR(SM,9,2))

ON KEY LABEL esc DO vib_8

ON KEY LABEL ctrl+w DO vib_8

ON KEY LABEL ctrl+q DO vib_8

ON KEY LABE F5 ACTIVATE POPUP poisk

BROWSE TITLE 'F1 - Помощь ESC - выход F5 - Поиск' FIELDS;

tab :h='Таб',;

fam :h='Фамилия' ,;

kw_pl :h='Кв.пл.' :W=INFO1() :V=INFO2() :F,;

g_w :h='Гор.вода' :W=INFO1() :V=INFO2() :F,;

x_w :h='Хол.вода' :W=INFO1() :V=INFO2() :F,;

k_ysl :h='Ком.усл' :W=INFO1() :V=INFO2() :F,;

otopl :h='Отопл.' :W=INFO1() :V=INFO2() :F,;

tel_r :h='Телефон' :W=INFO1() :V=INFO2() :F,;

rad_r :h='Радио' :W=INFO1() :V=INFO2() :F,;

el_c :h='Энергия' :W=INFO1() :V=INFO2() :F,;

itog_n :H='Итог' :W=INFO1() :V=INFO2() :F;

WIND KDR COLOR SCHEME 12

RELEASE SKW,SG,SX,SK,SOT,SR,ST,SEL,SM,F

clear

CASE rs_n=2

CLEAR READ

DEACTIVATE WINDOW vib

ENDCASE

RETURN

***********************************************************************************

PROCEDURE vib_8 && выбор сохранение данных расчета

ON KEY LABE esc

ON KEY LABEL ctrl+w

ON KEY LABEL ctrl+q

DEACTIVATE WINDOW kdr

ACTIVATE WINDOW vib

@ 2,10 SAY 'Сохранить данные'

@ 0,0 FILL TO 8,43 COLOR W+/R

@ 5,7 GET rs_1 FUNCTION '*TH Сохранить;Отмена' VALID ras_2() DEFAULT 1;

SIZE 1,9,4 COLOR ,,,,w+/n,w+/n,w+/n,,W+/R,

READ CYCLE OBJECT 1

RETURN

FUNCTION ras_2 && сохранение данных расчета

DO CASE

CASE rs_1=1

DEACTIVATE WINDOW vib

CLEAR READ

SELE f

use oplata

UPDATE ON tab FROM a REPLACE kw_pl WITH a.kw_pl, g_w WITH a.g_w,;

tel_r WITH a.tel_r,rad_r WITH a.rad_r,k_ysl WITH a.k_ysl, el_c WITH a.el_c,;

otopl WITH a.otopl,x_w WITH a.x_w,itog_n WITH a.itog_n RANDOM

SELE a

set rela to

USE

ERASE rach.dbf

ERASE rach.cdx

close data

do open

ACTIVATE WINDOW VIB

@ 2,10 SAY 'Рассчитать льготы'

@ 0,0 FILL TO 8,43 COLOR W+/R

@ 5,12 GET rs_l FUNCTION '*TH Да;Нет' DEFA 1 SIZE 1,4,4;

COLOR ,,,,w+/n,w+/n,w+/n,,w+/r,

READ CYCLE OBJECT 1

DO CASE

CASE rs_l=1

DEACTIVATE WINDOW vib

CLEAR READ

DO ras_l

CASE rs_l=2

CLEAR READ

DEACTIVATE WINDOW vib

ENDCASE

CASE rs_1=2

DEACTIVATE WINDOW vib

SET RELA TO

USE

CLEAR READ

DEACTIVATE WINDOW kdr

ERASE rach.dbf

ERASE rach.cdx

CLOSE DATA

DO open

ENDCASE

RETURN

***********************************************************************************

** Процедура расчета по льготам **

***********************************************************************************

FUNCTION ras_lg

DEACTIVATE WINDOW vib

DO CASE

CASE rs_lg=1

CLEAR READ

CLOSE DATA

USE rabot IN a

**********************************Альтернатива*************************************

** SET FILTER TO lgot=.t..AND.EMPTY(dat_c).AND.; ** ** EMPTY(dat_po).OR.BETWEEN(date(),dat_c,dat_po) **

SET ORDER TO DATE

SELECT b

USE oplata

******Создание новой базы из двух имеющихся (RABOT and OPLATA)*********************

JOIN WITH a TO rach_l FOR yl=a.yl.and.dom=a.dom.and.kw_ra=a.kw_ra.and.tab=a.tab; FIELDS a.fam,a.yl,a.dom,a.kw_ra,a.tel,a.elec,a.elec1,a.n_lg,tab,kw_pll,itog_l,;

kv_m,tel_rl,rad_rl,g_wl,x_wl,k_ysll,otopll,el_cl,a.kol_vo,a.kw_l,a.tel_l,a.rad_l,;

a.g_w_l,a.x_w_l,a.k_ys_l,a.el_c_l,a.otop_l

***********************************************************************************

CLOSE DATA

SELE a

USE rach_l

IF .NOT. FILE('rach_l.cdx')

INDEX ON tab TAG tab

INDEX ON fam TAG fam

INDEX ON n_lg TAG n_lg

INDEX ON yl+dom+kw_ra+str(tab) TAG adrr

ENDIF

SET ORDER TO tab

SELE c

USE rabot

SET ORDER TO adrr

SELE d

USE lgot

SET ORDER TO n_lg

SELE g

USE TABLE_R

SET ORDER TO tab

SELE rach_l

SET RELA TO n_lg INTO d ADDI

SET RELA TO yl+dom+kw_ra+str(tab) into c ADDI

SET RELA TO tab INTO g ADDI

***********************************************************************************

** РАСЧЕТ **

***********************************************************************************

REPLACE ALL kw_pll WITH (IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,(kv_m/kol_vo),0))*d.kwp_l*(-1),;

g_wl WITH (IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,(-1),0))*d.gw_l,x_wl WITH; (IIF(g.xw_l=0,_xol_w,g.xw_l)*IIF(x_w_l=.t.,(-1),0))*d.xw_l,k_ysll WITH; (IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,(-1),0))*d.k_l_l,otopll WITH; (IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,(kv_m/kol_vo),0))*d.ot_l*(-1),;

rad_rl WITH (IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0))*d.rd_l*(-1),tel_rl WITH; (IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,1,0))*d.tl_l*(-1)

REPLACE ALL itog_l WITH kw_pll+g_wl+x_wl+k_ysll+otopll+tel_rl+rad_rl

CALCULATE SUM(KW_PLL),SUM(G_WL),SUM(X_WL),SUM(K_YSLL),SUM(OTOPLL),SUM(RAD_RL),;

SUM(TEL_RL),SUM(EL_CL),SUM(ITOG_L) TO SKW,SG,SX,SK,SOT,SR,ST,SEL,SM

CLEAR

@ 22,0 SAY 'Кв.плата Гор.вода Хол.вода Ком.усл Отопление Э\энер.Телеф. Радио; ИТОГ '

@ 23,0 SAY LTRIM(STR(SKW,9,2))

@ 23,9 SAY LTRIM(STR(SG,9,2))

@ 23,18 SAY LTRIM(STR(SX,9,2))

@ 23,27 SAY LTRIM(STR(SK,9,2))

@ 23,36 SAY LTRIM(STR(SOT,9,2))

@ 23,46 SAY LTRIM(STR(SEL,9,2))

@ 23,53 SAY LTRIM(STR(ST,9,2))

@ 23,61 SAY LTRIM(STR(SR,7,2))

@ 23,68 SAY LTRIM(STR(SM,9,2))

ON KEY LABEL esc DO vib_9

ON KEY LABEL F5 ACTIVATE POPUP poisk

ON KEY LABEL ctrl+w DO vib_8

ON KEY LABEL ctrl+q DO vib_8

BROWSE TITLE ' F1 - Помощь ESC - выход F5 - Поиск' FIELDS;

tab :h='Таб',;

fam :h='Фамилия',;

kw_pll :h='Кв.пл.' :W=INFO4() :V=INFO5() :F,;

g_wl :h='Гор.вода':W=INFO4() :V=INFO5() :F,;

x_wl :h='Хол.вода' :W=INFO4() :V=INFO5() :F,;

k_ysll :h='Ком.усл' :W=INFO4() :V=INFO5() :F,;

otopll :h='Отопл.' :W=INFO4() :V=INFO5() :F,;

tel_rl :h='Телефон' :W=INFO4() :V=INFO5() :F,;

rad_rl :h='Радио' :W=INFO4() :V=INFO5() :F,;

el_cl :h='Энергия' :W=INFO4() :V=INFO5() :F,;

itog_l :H='Итог' :W=INFO4() :V=INFO5() :F;

WIND KDR COLOR SCHEME 12

RELEASE SKW,SG,SX,SK,SOT,SR,ST,SEL,SM,F

CASE rs_lg=2

CLEAR READ

DEACTIVATE WINDOW vib

ENDCASE

PROCEDURE vib_9

ON KEY LABE esc

ON KEY LABEL ctrl+w

ON KEY LABEL ctrl+q

DEACTIVATE WINDOW kdr

ACTIVATE WINDOW vib

@ 2,10 SAY 'Сохранить данные'

@ 0,0 FILL TO 8,43 COLOR W+/R

@ 5,7 GET rs_lg_1 FUNCTION '*h Сохранить;Отмена' DEFAULT 1;

SIZE 1,9,4 COLOR ,,,,w+/n,w+/n,w+/n,,W+/R,

READ CYCLE OBJECT 1

DO CASE

CASE rs_lg_1=1

DEACTIVATE WINDOW vib

SELE f

USE OPLATA

UPDATE ON tab FROM a REPLACE kw_pll WITH a.kw_pll, g_wl WITH a.g_wl,;

tel_rl WITH a.tel_rl,rad_rl WITH a.rad_rl,k_ysll WITH a.k_ysll,;

el_cl WITH a.el_cl,otopll WITH a.otopll,x_wl WITH a.x_wl,itog_l WITH a.itog_l

SELE a

USE

ERASE rach_l.dbf

ERASE rach_l.cdx

ERASE date.idx

CLOSE DATA

CLEAR

DO open

CASE rs_lg_1=2

DEACTIVATE WINDOW vib

SELE a

USE

ERASE rach_l.dbf

ERASE rach_l.cdx

ERASE date.idx

ENDCASE

DO open

***********************************************************************************

** Расчет (квартплата - льготы = к оплате) **

***********************************************************************************

PROCEDURE ras_3

DO CASE

CASE rs_i=1

DEACTIVATE WINDOW vib

CLEAR READ

CLEAR

@ 12,35 SAY 'Идет расчет'

close data

use oplata in a

set order to adr

sele b

use rabot

set order to adrr

sele a

m=RECCOUNT()

go top

DO WHILE !EOF()

y_l=yl

do while y_l=yl

d=dom

do while y_l=yl AND d=dom

k=kw_ra

STORE 0 TO it_l,s_kw,s_gw,s_xw,s_kysl,s_ot,s_tl,s_rd

scan while yl=y_l.and.dom=d.and.kw_ra=k &&.and.a.yl=y_l.and.a.dom=d.and.a.kw_ra=k

IF or_r=1

it=itog_n

r=RECNO()

ENDIF

IF lgot=.T.

it_l=itog_l+it_l

s_kw=kw_pll+s_kw

s_gw=g_wl+s_gw

s_xw=x_wl+s_xw

s_kysl=k_ysll+s_kysl

s_ot=otopll+s_ot

s_tl=tel_rl+s_tl

s_rd=rad_rl+s_rd

ENDIF

ENDSCAN

n=RECNO()

os=it+it_l

GO r

t=tab

REPLACE itog WITH os,sum_it WITH it_l,sum_kw WITH s_kw,sum_gw WITH s_gw,;

sum_xw WITH s_xw,sum_ot WITH s_ot,sum_tl WITH s_tl,sum_rd WITH s_rd,;

sum_kysl WITH s_kysl

sele b && Определение остатка(задолженности)

locate for tab=t && квартиросъемщика

if found().and.empty(opl_ta)

replace ost_k WITH os*(-1)

else

REPLACE ost_k WITH opl_ta-os

ENDIF

sele a

IF N>M

DO BROW_OPL

RETURN

ELSE

GO n

ENDIF

enddo

enddo

enddo

deactivate window vib

CASE rs_i=2

clear read

deactivate window vib

ENDCASE

RETURN FUNCTION BROW_OPL && Просмотр начислений

DO open

SET PROCEDURE TO func

ON KEY LABE F5 ACTIVATE POPUP poisk

STORE .T. TO _PAD_OTCH

BROWSE FOR or_r=1 TITLE 'ESC - выход F5 - Поиск' FIELDS;

tab :h='Таб.' :W=INFO3(),;

fam :h='Фамилия' :W=INFO3() :25,;

lg=IIF(lgot=.t.,'v','') :1 :h='' :W=INFO3(),;

c.itog :h='К оплате':10 :W=INFO3(),;

x=iif(or_r=1,'=','') :h='' :W=INFO3(),;

c.itog_n :h='Начислен':10 :W=INFO3(),;

y=iif(or_r=1,'+','') :h='' :W=INFO3(),;

c.sum_it :h='По льготе' :10 :W=INFO3();

WIND kdr COLOR SCHEME 12

ON KEY

CLEAR

RETURN

** Функция отображения суммы начислений по квартплате **

** в процедуре расчета по квартплате (просмотр начислений) **

***********************************************************************************

FUNCTION INFO1

DO CASE

CASE VARREAD()='Kw_pl'

@ 22,0 fill to 23,8 COLOR SCHEME 12

CASE VARREAD()='G_w'

@ 22,8 fill to 23,17 COLOR SCHEME 12

CASE VARREAD()='X_w'

@ 22,17 fill to 23,26 COLOR SCHEME 12

CASE VARREAD()='K_ysl'

@ 22,26 fill to 23,35 COLOR SCHEME 12

CASE VARREAD()='Otopl'

@ 22,35 fill to 23,45 COLOR SCHEME 12

CASE VARREAD()='El_c'

@ 22,45 fill to 23,52 COLOR SCHEME 12

CASE VARREAD()='Tel_r'

@ 22,52 fill to 23,60 COLOR SCHEME 12

CASE VARREAD()='Rad_r'

@ 22,60 fill to 23,67 COLOR SCHEME 12

CASE VARREAD()='Itog_n'

@ 22,67 fill to 23,79 COLOR SCHEME 12

ENDCASE

RETURN FUNCTION INFO2 && Функция отображения суммы начислений по квартплате

DO CASE && в процедуре расчета по квартплате (просмотр начислений)

CASE VARREAD()='Kw_pl'

@ 22,0 fill to 23,8 COLOR SCHEME 1

CASE VARREAD()='G_w'

@ 22,8 fill to 23,17 COLOR SCHEME 1

CASE VARREAD()='X_w'

@ 22,17 fill to 23,26 COLOR SCHEME 1

CASE VARREAD()='K_ysl'

@ 22,26 fill to 23,35 COLOR SCHEME 1

CASE VARREAD()='Otopl'

@ 22,35 fill to 23,45 COLOR SCHEME 1

CASE VARREAD()='El_c'

@ 22,45 fill to 23,52 COLOR SCHEME 1

CASE VARREAD()='Tel_r'

@ 22,52 fill to 23,60 COLOR SCHEME 1

CASE VARREAD()='Rad_r'

@ 22,60 fill to 23,67 COLOR SCHEME 1

CASE VARREAD()='Itog_n'

@ 22,67 fill to 23,79 COLOR SCHEME 1

ENDCASE

FUNCTION INFO4 && Функция отображения суммы начислений по квартплате

DO CASE && в процедуре расчета по квартплате (просмотр начислений)

CASE VARREAD()='Kw_pll'

@ 22,0 fill to 23,8 COLOR SCHEME 12

CASE VARREAD()='G_wl'

@ 22,8 fill to 23,17 COLOR SCHEME 12

CASE VARREAD()='X_wl'

@ 22,17 fill to 23,26 COLOR SCHEME 12

CASE VARREAD()='K_ysll'

@ 22,26 fill to 23,35 COLOR SCHEME 12

CASE VARREAD()='Otopll'

@ 22,35 fill to 23,45 COLOR SCHEME 12

CASE VARREAD()='El_cl'

@ 22,45 fill to 23,52 COLOR SCHEME 12

CASE VARREAD()='Tel_rl'

@ 22,52 fill to 23,60 COLOR SCHEME 12

CASE VARREAD()='Rad_rl'

@ 22,60 fill to 23,67 COLOR SCHEME 12

CASE VARREAD()='Itog_l'

@ 22,67 fill to 23,79 COLOR SCHEME 12

ENDCASE

RETURN

FUNCTION INFO5 && Функция отображения суммы начислений по квартплате

DO CASE && в процедуре расчета по квартплате (просмотр начислений)

CASE VARREAD()='Kw_pll'

@ 22,0 fill to 23,8 COLOR SCHEME 1

CASE VARREAD()='G_wl'

@ 22,8 fill to 23,17 COLOR SCHEME 1

CASE VARREAD()='X_wl'

@ 22,17 fill to 23,26 COLOR SCHEME 1

CASE VARREAD()='K_ysll'

@ 22,26 fill to 23,35 COLOR SCHEME 1

CASE VARREAD()='Otopll'

@ 22,35 fill to 23,45 COLOR SCHEME 1

CASE VARREAD()='El_cl'

@ 22,45 fill to 23,52 COLOR SCHEME 1

CASE VARREAD()='Tel_rl'

@ 22,52 fill to 23,60 COLOR SCHEME 1

CASE VARREAD()='Rad_rl'

@ 22,60 fill to 23,67 COLOR SCHEME 1

CASE VARREAD()='Itog_l'

@ 22,67 fill to 23,79 COLOR SCHEME 1

ENDCASE

RETURN

***********************************************************************************

** Функция перехвата ошибок **

***********************************************************************************

FUNCTION EROR

PARAMETERS ER

DO CASE

CASE ER=114

! DEL *.CDX

DO OPEN

CASE ER=1707

DO CASE

CASE SELECT()=1

USE RABOT

CASE SELE()=3

USE OPLATA

CASE SELE()=4

USE LGOT

CASE SELE()=7

USE TABLE_R

ENDCASE

ENDCASE

RETURN
FUNCTION RAS_ON_ONE && Расчет на одного жильца в окне (INS-Работа с картотекой)

IF OR_R=0

RETURN

ELSE

R=RECNO()

t=tab

ORD_R=ORDER()

SET ORDER TO 0

Y=YL

D=DOM

K=KW_RA

SELE c

ORD_C=ORDER()

set order to tab

locate for t=tab

DO CASE

CASE FOUND()=.F.

SELE a

SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K

GO TOP

SELE c

APPEND FROM rabot FIELDS tab,yl,dom,kw_ra,lgot,n_lg,or_r,kol_vo,kw_l,tel,;

tel_l,rad_l,g_w_l,x_w_l,k_ys_l,el_c_l,otop_l,kv_m,elec,elec1,dat_c,dat_po

CASE FOUND()

sele a

SET SKIP TO

SET RELA TO

SET ORDER TO tab

SELE c

UPDATE ON tab FROM a REPLACE lgot WITH a.lgot,n_lg WITH a.n_lg,or_r WITH a.or_r,;

kol_vo WITH a.kol_vo,kw_l WITH a.kw_l,tel_l WITH a.tel_l,g_w_l WITH a.g_w_l,;

x_w_l WITH a.x_w_l,k_ys_l WITH a.k_ys_l,el_c_l WITH a.el_c_l,otop_l WITH a.otop_l,;

rad_l WITH a.rad_l,kv_m WITH a.kv_m,elec WITH a.elec,elec1 WITH a.elec1,;

dat_c WITH a.dat_c,;

dat_po WITH a.dat_po,tel WITH a.tel

endcase

SELE a

SET SKIP TO

SET RELA TO

SELE c

set rela to tab into g

set rela to n_lg into d ADDI

SET SKIP TO g,d

SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K

GO TOP

REPLACE ALL kw_pll WITH 0,g_wl WITH 0,x_wl WITH 0,k_ysll WITH 0,;

otopll WITH 0,rad_rl WITH 0,tel_rl WITH 0,itog_l WITH 0,;

itog WITH 0,sum_it WITH 0,sum_kw WITH 0,sum_gw WITH 0,;

sum_xw WITH 0,sum_ot WITH 0,sum_tl WITH 0,sum_rd WITH 0,sum_kysl WITH 0

GO TOP

SCAN

IF OR_R=1

REPLACE c.kw_pl WITH IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,kv_m,0),;

c.g_w WITH IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,kol_vo,0),;

c.x_w WITH IIF(g.xw_l=0,_xol_w,g.xw_l) *IIF(x_w_l=.t.,kol_vo,0),;

c.k_ysl WITH IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,kol_vo,0),;

c.otopl WITH IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,kv_m,0),;

c.tel_r WITH IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,IIF(empty(tel),0,1),0),;

c.rad_r WITH IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0),;

c.el_c WITH IIF(g.el_l=0,_elek,g.el_l)*IIF(el_c_l=.t.,(elec1-elec),0)

REPLACE c.itog_n WITH c.kw_pl+c.tel_r+c.rad_r+c.g_w+c.x_w+c.k_ysl+c.el_c+c.otopl

ENDIF

ENDSCAN

SET FILTER TO

go top

SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K.AND.lgot=.t.

go top

scan FOR EMPTY(dat_c).AND.EMPTY(dat_po).OR.BETWEEN(date(),dat_c,dat_po)

REPLACE kw_pll WITH;

(IIF(g.kwp_l=0,_kv_pl,g.kwp_l)*IIF(kw_l=.t.,(kv_m/kol_vo),0))*d.kwp_l*(-1),;

g_wl WITH (IIF(g.gw_l=0,_gor_w,g.gw_l)*IIF(g_w_l=.t.,(-1),0))*d.gw_l,x_wl;

WITH (IIF(g.xw_l=0,_xol_w,g.xw_l)*IIF(x_w_l=.t.,(-1),0))*d.xw_l,;

k_ysll WITH (IIF(g.k_l_l=0,_kom,g.k_l_l)*IIF(k_ys_l=.t.,(-1),0))*d.k_l_l,;

otopll WITH (IIF(g.ot_l=0,_otopl,g.ot_l)*IIF(otop_l=.t.,(kv_m/kol_vo),0))*;

d.ot_l*(-1),rad_rl WITH (IIF(g.rd_l=0,_rad,g.rd_l)*IIF(rad_l=.t.,1,0))*;

d.rd_l*(-1),tel_rl WITH (IIF(g.tl_l=0,_tel,g.tl_l)*IIF(tel_l=.t.,1,0))*d.tl_l*(-1)

REPLACE itog_l WITH kw_pll+g_wl+x_wl+k_ysll+otopll+tel_rl+rad_rl

endscan

go top

CALCULATE SUM(KW_PLL),SUM(G_WL),SUM(X_WL),SUM(K_YSLL),SUM(OTOPLL),;

SUM(RAD_RL),SUM(TEL_RL),SUM(EL_CL),SUM(ITOG_L);

TO SKW,SG,SX,SK,SOT,SR,ST,SEL,SM

go top

set filter to

os=0

OST=0

SET FILTER TO YL=Y.AND.DOM=D.AND.KW_RA=K

go top

scan

IF or_r=1

os=itog_n+SM

REPLACE itog WITH os,sum_it WITH SM,sum_kw WITH SKW ,sum_gw WITH SG,;

sum_xw WITH SX,sum_ot WITH SOT,sum_tl WITH ST,sum_rd WITH SR,;

sum_kysl WITH SK

ENDIF

ENDSCAN

SET FILTER TO

SET SKIP TO

set rela to

set order to &ord_c

SELE a

SET FILTER TO

go r

REPLACE ost_k WITH os-opl_ta

DO OPEN

GO R

@ 10,27 CLEAR TO 20,51

=POS_CH1()

SHOW GETS

SET ORDER TO &ORD_R

ENDIF

RETURN

***********************************************************************************

** Функция заполнения и изменения тарифов («СЕРВИС»-«Тарифы») **

***********************************************************************************

FUNCTION TARIFS_zar && Окно тарифов, при выборе пункта меню «СЕРВИС»-«Тарифы»

HIDE POPUP serv

ON KEY

on key label ESC do ret_ecs

sele a

_REC=RECNO()

sele f

DEFINE WINDOW m_zar1 FROM 5,12 TO 20,66 FILL '-'COLOR SCHEME 18

DEFINE MENU TARIFS

DEFINE PAD vibor OF TARIFS PROMPT 'Просмотр'

DEFINE PAD apend OF TARIFS PROMPT 'Добавить'

DEFINE PAD exit OF TARIFS PROMPT 'Выйти'

ON PAD vibor OF TARIFS ACTIVATE POPUP TAR_S

ON SELECTION PAD apend OF TARIFS DO INS_ST WITH PROMPT()

ON SELECTION PAD exit OF TARIFS DO INS_ST WITH PROMPT()

DEFINE POPUP TAR_S FROM 1,1 TITLE;

'Описание тарифа--------|-Ставка-|-Расчен на-|';

PROMPT FIELD info+'|'+STR(st_ka,8,2)+'|'+k_info

ON SELECTION POPUP TAR_S DO INS_REC WITH PROMPT(),RECNO()

ACTIVATE WINDOW M_ZAR1

ACTIVATE MENU TARIFS

on key label ESC

DEACTIVATE WINDOW M_ZAR1

RETURN
FUNCTION INS_rec

PARAMETERS mprompt,mrecno

hide popup TAR_S

SELE F

if empty(mprompt)

go mrecno

delete

else

go mrecno

SCATTER MEMVAR

@ 2,2 SAY 'Введите описание тарифа'

@ 3,2 get m.info

@ 5,2 SAY 'Ставка - 'get m.st_ka PICTURE '##.##'

@ 7,2 GET ras_on FUNCTION '*R На 1 кв.метр;На 1-го чел' VALID kv_chel() defa 1 COLOR SCHEME 16

@ 10,2 GET ras_on1 FUNCTION '*H Сохранить;Отказ' VALID del_rec1() defa 1;

COLOR SCHEME 15 size 1,10,4

@ 12,8 GET del_rec FUNCTION '*H Удалить' VALID del_rec() defa 1;

size 1,10,4

READ CYCLE

ENDIF

PACK

FUNCTION ret_ecs

DEACTIVATE WINDOW M_ZAR1

DEACTIVATE MENU

FUNCTION DEL_REC

delete

clear

RETURN
FUNCTION DEL_REC1

DO CASE

CASE ras_on1=1

IF m.k_ch=.t.

m.k_info='На 1-го чел.'

ELSE

m.k_info='На 1 кв.метр'

ENDIF

GATHER MEMVAR

CASE ras_on1=2

clear READ

ENDCASE

CLEAR

RETURN

Страница - 58 Приложение № 1.2 из - 58

Стартующий файл – MENI.PRG

***********************************************************************

** Основной загрузочный модуль **

***********************************************************************

SET ESCAPE OFF

CLEAR MACROS

SET DELETE ON

SET SAFETY OFF

SET DATE GERMAN

SET HEADING OFF

SET TALK OFF

SET STATUS OFF

SET CENTURY ON

SET COLOR OF SCHEME 12 TO N/W,GR/W, GR+/B,GR+/B,GR+/B,GR/N,GR/W,GR/W,GR/W,GR/W

SET COLOR OF SCHEME 14 TO N/W,GR/W, N/W, N/W,GR/W,W/GR,GR/W,GR/W,GR/W,W+/W

SET COLOR OF SCHEME 15 TO W/B,W/BG, N/W, N/W,GR/W,W/GR+,GR/W,GR/W,GR/W,B/W+

SET COLOR OF SCHEME 16 TO W+/BG,W+/BG, R/BG,N/BG,W+/BG,W+/GR,W+/BG,W+/BG,W+/BG,N/BG

SET COLOR OF SCHEME 17 TO N/G,B/W+, N/W, N/W,GR/W,W/GR+,GR/W,GR/W,GR/W,W/BG

SET COLOR OF SCHEME 18 TO W+/B,N/W, N/W, N/W,GR/W,B/W,B/W,GR/W,GR/W,B/W+

SET COLOR OF SCHEME 19 TO GR+/RB,W+/R, N/R, N/R,GR/W,B/R,GR/W,GR/W,N/R,W+/RB

SET PROC TO FUNC

ON ERROR DO EROR WITH ERROR()

DO open

PUBLIC _PAD_OTCH, _REC,_FILTR,

DIMENSION mes(4,3)

mes(1,1)='Январь'

mes(1,2)='Февраль'

mes(1,3)='Март'

mes(2,1)='Апрель'

mes(2,2)='Май'

mes(2,3)='Июнь'

mes(3,1)='Июль'

mes(3,2)='Август'

mes(3,3)='Сентябрь'

mes(4,1)='Октябрь'

mes(4,2)='Ноябрь'

mes(4,3)='Декабрь'

mess=month(date())

_tel=0 && телефон

_pod=SPACE(15) && подпись

_rad=0 && радио-точка

_kom=0 && коммунальные услуги

_gor_w=0 && горячая вода

_xol_w=0 && холодная вода

_otopl=0 && отопление

_elek=0 && электро-энергия

_kv_pl=0 && квартплата

avs=.f. && автосохранение в функции ввода оплаты

IF FILE('M_ZAR.MEM')

RESTORE FROM m_zar ADDITIVE

ENDIF

_POS_CH=.T. && Переменная для формирования отчета

***(Принимает значение - .F. в процедуре ДОПОЛНЕНИЕ/ИЗМЕНЕНИЕ

*** в процедуре РАСЧЕТА(СЛИЯНИЯ) принимает значение - .T.)

_REC=RECNO()

_FILTR=1

***********************************************************************

** Определение окон **

***********************************************************************

DEFINE WINDOW poisk SHADOW FROM 15,20 TO 18,50;

TITLE 'Укажите ключ'

DEFINE WINDOW kdr FROM 1,0 TO 20,80 DOUBLE;

FOOTER 'F3 - Меню F5 - Поиск' COLOR W+/B,N/BG,n/w,W+/W+,N+/GR,N/BG,N/BG,N/BG,N/BG,N/BG

DEFINE WINDOW INS FROM 0,0 TO 24,80 GROW MINIMIZE FLOAT;

FOOTER 'F1 - помощь' COLOR SCHEME 12

DEFINE WINDOW vib FROM 8,14 TO 16,57 SHADOW COLOR SCHEME 7

***********************************************************************

** Определение меню **

***********************************************************************

DEFINE MENU ZAR KEY F3

DEFINE PAD kadr OF zar PROMPT '\