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

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

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=<m.dat_po,.T.,.F.) ERROR 'Неверная
ДАТА'; COLOR SCHEME 17
@ 12,35 say '%начислений кв.платы' COLOR SCHEME 17
@ 12,60 get d.kwp_l PICTURE '#.##' COLOR SCHEME 17
@ 12,65 SAY '%' COLOR SCHEME 17
@ 13,35 SAY '%начислений телефона' COLOR SCHEME 17
@ 13,60 get d.tl_l PICTURE '#.##' COLOR SCHEME 17
@ 13,65 SAY '%' COLOR SCHEME 17
@ 14,35 say '%начислений радио' COLOR SCHEME 17
@ 14,60 get d.rd_l PICTURE '#.##' COLOR SCHEME 17
@ 14,65 SAY '%' COLOR SCHEME 17
@ 15,35 say '%начислений ком. услуг' COLOR SCHEME 17
@ 15,60 get d.k_l_l PICTURE '#.##' COLOR SCHEME 17
@ 15,65 SAY '%' COLOR SCHEME 17
@ 16,35 say '%начислений Гор.воды' COLOR SCHEME 17
@ 16,60 get d.gw_l PICTURE '#.##' COLOR SCHEME 17
@ 16,65 SAY '%' COLOR SCHEME 17
@ 17,35 say '%начислений Хол.воды'COLOR SCHEME 17
@ 17,60 get d.xw_l PICTURE '#.##' COLOR SCHEME 17
@ 17,65 SAY '%' COLOR SCHEME 17
@ 18,35 say '%начислений отопления' COLOR SCHEME 17
@ 18,60 get d.ot_l PICTURE '#.##' COLOR SCHEME 17
@ 18,65 SAY '%' COLOR SCHEME 17
@ 20,35 SAY 'КАТЕГОРИЯ' GET d.info COLOR SCHEME 17
@ 1,57 GET pod FUNCTION '*N Сохранить;Выход;Удалить' valid ad_in() default
1;
size 1,15,1 COLOR ,,,,gr+/b,w+/n,r+/b,,W+/GR,w/b
READ CYCLE SHOW red() color scheme 9
DEACTIVATE WINDOW INS
release windows hp
IF d_ins=1
DO P_INDEX
ENDIF
GO _REC
DO POS_CH
ON KEY
ON KEY LABEL F1 DO HELP WITH 6

RETURN



FUNCTION red

DO CASE
      CASE red=1
      SHOW GET pod,1 PROMPT 'Cохранить'
      SHOW GET pod,3 DISABLE
      CASE red=2
      SHOW GET pod,1 PROMPT 'Подтверждаю'
ENDCASE
DO CASE
            CASE m.or_r=1
      SHOW GET kw ENABLE COLOR SCHEME 16
      SHOW GET gw ENABLE COLOR SCHEME 16
      SHOW GET xw ENABLE COLOR SCHEME 16
      SHOW GET ks ENABLE COLOR SCHEME 16
      SHOW GET ot ENABLE COLOR SCHEME 16
      SHOW GET elc ENABLE COLOR SCHEME 16
      SHOW GET tl DISABLE COLOR ,,,,,,,,,BG+/BG

      SHOW GET rd DISABLE COLOR ,,,,,,,,,BG+/BG
      @ 10,2 FILL TO 20,29 COLOR SCHEME 16
DO CASE
      CASE m.lgot=.F.
      SHOW GET m.dat_c DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET m.dat_po DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.kwp_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.gw_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.xw_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.k_l_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.ot_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.tl_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.rd_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.info DISABLE COLOR ,,,,,,,,,W+/W
      @ 8,29 clear to 9,60
      @ 10,30 FILL TO 20,70 COLOR W+/BG
      CASE m.lgot=.T.
      SHOW GET m.dat_c ENABLE
      SHOW GET m.dat_po ENABLE
      SHOW GET d.kwp_l ENABLE
      SHOW GET d.gw_l ENABLE
      SHOW GET d.xw_l ENABLE
      SHOW GET d.k_l_l ENABLE
      SHOW GET d.ot_l ENABLE
      SHOW GET d.tl_l ENABLE
      SHOW GET d.rd_l ENABLE
      SHOW GET d.info ENABLE
      SHOW GET kw ENABLE COLOR SCHEME 16
      SHOW GET gw ENABLE COLOR SCHEME 16
      SHOW GET xw ENABLE COLOR SCHEME 16
      SHOW GET ks ENABLE COLOR SCHEME 16
      SHOW GET ot ENABLE COLOR SCHEME 16
      SHOW GET elc ENABLE COLOR SCHEME 16
      @ 10,30 FILL TO 20,70 COLOR SCHEME 17
ENDCASE
            CASE m.or_r=0
      SHOW GET kw DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET gw DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET xw DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET ks DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET ot DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET elc DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET tl DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET rd DISABLE COLOR ,,,,,,,,,W+/W
      DO CASE
      CASE m.lgot=.F.
      SHOW GET m.dat_c DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET m.dat_po DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.kwp_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.gw_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.xw_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.k_l_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.ot_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.tl_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.rd_l DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET d.info DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET kw DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET gw DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET xw DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET ks DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET ot DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET elc DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET tl DISABLE COLOR ,,,,,,,,,W+/W
      SHOW GET rd DISABLE COLOR ,,,,,,,,,W+/W
      @ 8,29 clear to 9,60
      @ 10,30 FILL TO 20,70 COLOR W+/BG
      CASE m.lgot=.T.
      SHOW GET m.dat_c ENABLE
      SHOW GET m.dat_po ENABLE
      SHOW GET d.kwp_l ENABLE
      SHOW GET d.gw_l ENABLE
      SHOW GET d.xw_l ENABLE
      SHOW GET d.k_l_l ENABLE
      SHOW GET d.ot_l ENABLE
      SHOW GET d.tl_l ENABLE
      SHOW GET d.rd_l ENABLE
      SHOW GET d.info ENABLE
      SHOW GET kw ENABLE COLOR SCHEME 16
      SHOW GET gw ENABLE COLOR SCHEME 16
      SHOW GET xw ENABLE COLOR SCHEME 16
      SHOW GET ks ENABLE COLOR SCHEME 16
      SHOW GET ot ENABLE COLOR SCHEME 16
      SHOW GET elc ENABLE COLOR SCHEME 16
      @ 10,30 FILL TO 20,70 COLOR SCHEME 17
ENDCASE
      @ 10,2 FILL TO 20,29 COLOR W+/W
      ENDCASE

RETURN



****************************************************************************
*******
**                  Дополнение (Редактирование) ставок по льготам        **
****************************************************************************
*******

FUNCTION INS_LG

      SELE d
ON KEY LABEL F1 DO HELP WITH 5
DEFINE WINDOW m_zar FROM 5,14 TO 23,58 SHADOW;
TITLE 'Сегодня - '+dtoc(date()) COLOR SCHEME 17
ACTIVATE WINDOW M_ZAR
@ 1,0 to 1,33 double
SCATTER MEMVAR BLANK
@ 3,1 to 3,31
@ 3,7 say 'Ввод ставок по льготам'
@ 2,1 SAY 'КОД - ' GET m.n_lg PICTURE '99';
VALID UNIC_LG() ERROR 'Код уже существует'
@ 2,10 SAY 'КАТЕГОРИЯ' GET m.info
@ 4,3 say '%начислений кв.платы'
@ 4,29 get m.kwp_l PICTURE '#.##'
@ 4,35 SAY '%'
@ 5,3 SAY '%начислений телефона'
@ 5,29 get m.tl_l PICTURE '#.##'
@ 5,35 SAY '%'
@ 6,3 say '%начислений радио'
@ 6,29 get m.rd_l PICTURE '#.##'
@ 6,35 SAY '%'
@ 7,3 say '%начислений ком. услуг'
@ 7,29 get m.k_l_l PICTURE '#.##'
@ 7,35 SAY '%'
@ 8,3 say '%начислений Гор.воды'
@ 8,29 get m.gw_l PICTURE '#.##'
@ 8,35 SAY '%'
@ 9,3 say '%начислений Хол.воды'
@ 9,29 get m.xw_l PICTURE '#.##'
@ 9,35 SAY '%'
@ 10,3 say '%начислений отопления'
@ 10,29 get m.ot_l PICTURE '#.##'
@ 10,35 SAY '%'
@ 12,2 GET LG_INS FUNCTION '*HN Сохранить;Отмена;Удалить' VALID LG_INS()
DEFA 1 SIZE 1,10,2
read CYCLE COLOR SCHEME 5
SELE a
ON KEY
ON KEY LABEL F1 DO HELP WITH 6
RELEASE WINDOWS M_ZAR
RETURN



-----------------------
[pic]