FUNC (Автоматизированное рабочее место), страница 6

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