Разработка базы данных «Учет добычи и отгрузки угля на шахте» (Приложения к дипломному проекту. Текст программы), страница 3

ndat='01.'+'0'+STR(nm,1)+'.08' && начальная дата

sele a

SET FILTER TO data>=CTOD(ndat).and.data<=dat1

*SUM uf1d, uf2d, uf3d, uf4d, uf5d, uf6d, ufgd, ufpd, ufdd TO ARRAY M

DO WHILE !EOF()

m(1)=m(1)+uf1d

m(2)=m(2)+uf2d

m(3)=m(3)+uf3d

m(4)=m(4)+uf4d

m(5)=m(5)+uf5d

m(6)=m(6)+uf6d

m(7)=m(7)+ufgd

Продолжение приложения Г

m(8)=m(8)+ufpd

m(9)=m(9)+ufdd

SKIP

ENDDO

SELECT e

APPEND BLANK

replace dat WITH dat1, uf1m WITH m(1), uf2m WITH m(2), uf3m WITH m(3), uf4m WITH m(4), uf5m WITH m(5), uf6m WITH m(6)

replace ufgm WITH m(7), ufpm WITH m(8), ufdm WITH m(9)

repl  ufsm with uf1m+uf2m+uf3m+uf4m+uf5m+uf6m+ufgm+ufpm+ufdm

** план с начала месяца

replace  up1m WITH b.up1d/kol_dn*den , up2m WITH b.up2d/kol_dn*den , up3m WITH b.up3d/kol_dn*den

replace  up4m WITH b.up4d/kol_dn*den , up5m WITH b.up5d/kol_dn*den , up6m WITH b.up6d/kol_dn*den

replace upgm WITH b.upgd/kol_dn*den, uppm WITH b.uppd/kol_dn*den, updm WITH b.updd/kol_dn*den

repl  upsm with up1m+up2m+up3m+up4m+up5m+up6m+upgm+uppm+updm

** с начала года

SELECT f

d=CURDIR()+'\data\svodka_g'

USE &d  EXCLUSIVE

DELETE ALL

PACK

ndat='01.01.08' && начальная дата

sele a

SET FILTER TO data>=CTOD(ndat).and.data<=dat1

GO top

*SUM uf1d, uf2d, uf3d, uf4d, uf5d, uf6d, ufgd, ufpd, ufdd TO ARRAY g

DO WHILE !EOF()

g(1)=g(1)+uf1d

g(2)=g(2)+uf2d

g(3)=g(3)+uf3d

g(4)=g(4)+uf4d

g(5)=g(5)+uf5d

g(6)=g(6)+uf6d

g(7)=g(7)+ufgd

g(8)=g(8)+ufpd

Продолжение приложения Г

g(9)=g(9)+ufdd

SKIP

ENDDO

SELECT f

APPEND BLANK

replace dat WITH dat1, uf1m WITH g(1), uf2m WITH g(2), uf3m WITH g(3), uf4m WITH g(4), uf5m WITH g(5), uf6m WITH g(6)

replace ufgm WITH g(7), ufpm WITH g(8), ufdm WITH g(9)

repl  ufsm with uf1m+uf2m+uf3m+uf4m+uf5m+uf6m+ufgm+ufpm+ufdm

** план с начала года

SELECT b

SET FILTER TO mes<=nm

** SUM up1d, up2d, up3d, up4d, up5d, up6d, upgd, uppd, updd TO ARRAY g

DO WHILE !EOF()

g(1)=g(1)+up1d

g(2)=g(2)+up2d

g(3)=g(3)+up3d

g(4)=g(4)+up4d

g(5)=g(5)+up5d

g(6)=g(6)+up6d

g(7)=g(7)+upgd

g(8)=g(8)+uppd

g(9)=g(9)+updd

SKIP

ENDDO

SELECT f

replace  up1m WITH g(1)+e.up1m , up2m WITH g(2)+e.up2m , up3m WITH g(3)+e.up3m

replace  up4m WITH g(4)+e.up4m , up5m WITH g(5)+e.up5m , up6m WITH g(6)+e.up6m

replace upgm WITH g(7)+e.upgm, uppm WITH g(8)+e.uppm, updm WITH g(9)+e.updm

repl  upsm with up1m+up2m+up3m+up4m+up5m+up6m+upgm+uppm+updm    

ENDIF

** запись в таблицу svodka

SELECT d

t=CURDIR()+'\data\svodka'

USE &t  EXCLUSIVE

DELETE ALL

PACK

Продолжение приложения Г

APPEND BLANK

replace dat WITH c.dat, fd WITH c.uf1d,pd WITH c.up1d, uch WITH 'Участок 1'

replace od WITH fd-pd, prd WITH fd/pd*100

replace fm WITH e.uf1m, pm WITH e.up1m

replace om WITH fm-pm, prm WITH fm/pm*100

replace fg WITH f.uf1m, pg WITH f.up1m

replace og WITH fg-pg, prg WITH fg/pg*100

APPEND BLANK

replace dat WITH c.dat, fd WITH c.uf2d,pd WITH c.up2d, uch WITH 'Участок 2'

replace od WITH fd-pd, prd WITH fd/pd*100

replace fm WITH e.uf2m, pm WITH e.up2m

replace om WITH fm-pm, prm WITH fm/pm*100

replace fg WITH f.uf2m, pg WITH f.up2m

replace og WITH fg-pg, prg WITH fg/pg*100

APPEND BLANK

replace dat WITH c.dat, fd WITH c.uf3d,pd WITH c.up3d, uch WITH 'Участок 3'

replace od WITH fd-pd, prd WITH fd/pd*100

replace fm WITH e.uf3m, pm WITH e.up3m

replace om WITH fm-pm, prm WITH fm/pm*100

replace fg WITH f.uf3m, pg WITH f.up3m

replace og WITH fg-pg, prg WITH fg/pg*100

APPEND BLANK

replace dat WITH c.dat, fd WITH c.uf4d,pd WITH c.up4d, uch WITH 'Участок 4'

replace od WITH fd-pd, prd WITH fd/pd*100

replace fm WITH e.uf4m, pm WITH e.up4m

replace om WITH fm-pm, prm WITH fm/pm*100

replace fg WITH f.uf4m, pg WITH f.up4m

replace og WITH fg-pg, prg WITH fg/pg*100

APPEND BLANK

replace dat WITH c.dat, fd WITH c.uf5d,pd WITH c.up5d, uch WITH 'Участок 5'

replace od WITH fd-pd, prd WITH fd/pd*100

replace fm WITH e.uf5m, pm WITH e.up5m

replace om WITH fm-pm, prm WITH fm/pm*100

replace fg WITH f.uf5m, pg WITH f.up5m

replace og WITH fg-pg, prg WITH fg/pg*100

APPEND BLANK

replace dat WITH c.dat, fd WITH c.uf6d,pd WITH c.up6d, uch WITH 'Участок 6'

replace od WITH fd-pd, prd WITH fd/pd*100

replace fm WITH e.uf6m, pm WITH e.up6m

replace om WITH fm-pm, prm WITH fm/pm*100

replace fg WITH f.uf6m, pg WITH f.up6m

replace og WITH fg-pg, prg WITH fg/pg*100