Liren Large Software Subsidy 6/06.iso/b/b034/gz.img/CBHS-9.PRG

Text File | 1989-12-20 | 3.1 KB | 155 lines

*│╔▒╛║╦╦π╫╙│╠╨≥╓«╛┼:CBHS-9.PRG
set talk off
set safety off
clear
dimension a(3,10)
t=0
do while t<=29
t=t+1
store 0 to a(t)
enddo
sjklf=0
bhklf=0
qtly=0
rs=0
if w3='╙═╞ß'
   yyezc=21004
   jse=92657
endif
if w3='│σ╤╣'
   yyezc=9683.2
   jse=43973
endif
if w3='╟░▓µ'
   yyezc=5838.4
   jse=25755
endif
select 1
use &qbl6 alias z1
select 2
use &qbl51 alias z2
select 3
use &qbl52 alias z3
go top
clear
@ 6,25 say '╟δ╩Σ╚δ╧┬├µ╕≈▓·╞╖╡─╧·╩█╝█╕±'
@ 7,25 say '=========================='
do while .not.eof()
jg3=.T.
@ 8,0 clear
@ 9,18 say '╧ε─┐:  '
@ 9,35 say ╧ε─┐
@ 11,18 say '╔╧╘┬╡─╧·╩█╝█╕±:  '
@ 11,45 say XSJG
do while jg3
jg1=0
jg2='      '
@ 13,18 say '▒╛╘┬╡─╧·╩█╝█╕±:  ' get jg1 picture '99.9999'
     read
@ 15,15 say '╩Σ╚δ╡─╧·╩█╝█╕±╢╘┬≡(Y/N)?  ' get jg2
     read
if jg2='Y'.or.jg2='y'
   replace next 1 XSJG with jg1
   jg3=.F.
endif
enddo
skip
enddo
jg4=.T.
do while jg4
jg5='     '
clear
@ 6,30 say '╟δ╩Σ╚δ╧┬├µ╩²╢ε'
@ 7,30 say '=============='
@ 9,25 say '╔╧╜╔╣▄└φ╖╤:  ' get sjklf picture '9999999.99'
@ 11,25 say '▓╣╗╪╣▄└φ╖╤:  ' get bhklf picture '9999999.99'
*@ 13,25 say '╞Σ╦√└√╚≤:    ' get qtly picture '9999999.99'
@ 13,25 say '╓░╣ñ╚╦╩²:    ' get rs picture '99999'
     read
@ 15,20 say '╩Σ╚δ╡─╩²╢ε╢╘┬≡(Y/N)?  ' get jg5
     read
if jg5='Y'.or.jg5='y'
   jg4=.f.
endif
enddo
replace all CLBYS with 0,DWCB with 0,XSSRBYS with 0,XSCBBYS with 0
delete all for ╧ε─┐='╔╧╜╔╣▄└φ╖╤'.or.╧ε─┐='▓╣╗╪╣▄└φ╖╤'.or.╧ε─┐='║╧╝╞'.or.╧ε─┐='└√╚≤╫▄╢ε╨í╝╞'
pack
n=0
do while n<114-qbl2
n=n+1
select 1
go n
select 3
append blank
go bottom
replace next 1 ╧ε─┐ with z1->▓·╞╖├√│╞,CLBYS with z1->▓·┴┐,DWCB with z1->ZJ╞╜╛∙│╔▒╛
enddo
select 1
use
select 3
index on ╧ε─┐ to &qbl53
set index to &qbl53
total to &qbl54 on ╧ε─┐
use &qbl54
replace all XSSRBYS with CLBYS*XSJG,XSCBBYS with CLBYS*DWCB
replace all CLLJS with CLLJS+CLBYS,XSSRLJS with XSSRLJS+XSSRBYS,XSCBLJS with XSCBLJS+XSCBBYS
append blank
go bottom
replace next 1 ╧ε─┐ with '╔╧╜╔╣▄└φ╖╤',XSCBBYS with sjklf
append blank
go bottom
replace next 1 ╧ε─┐ with '▓╣╗╪╣▄└φ╖╤',XSCBBYS with bhklf
sum all XSSRBYS,XSCBBYS,XSSRLJS,XSCBLJS to hj1,hj2,hj3,hj4
append blank
go bottom
replace next 1 ╧ε─┐ with '║╧╝╞',XSSRBYS with hj1,XSCBBYS with hj2,XSSRLJS with hj3,XSCBLJS with hj4
append blank
go bottom
replace next 1 ╧ε─┐ with '└√╚≤╫▄╢ε╨í╝╞',XSCBBYS with hj1-hj2
copy to &qbl52
use
select 2
a(1)=hj1
a(2)=a(1)*0.08
a(3)=a(2)*0.07
a(4)=hj2
a(5)=a(1)*0.001
a(6)=a(2)*0.02
a(7)=a(1)-a(2)-a(3)-a(4)-a(5)-a(6)
*a(8)=qtly
a(8)=a(2)+a(3)+a(5)+a(6)+yyezc+sjklf+bhklf
a(9)=yyezc
a(10)=a(7)+a(8)-a(9)
a(11)=0
a(12)=a(10)
a(13)=a(10)*0.63
a(14)=a(10)-a(13)
a(16)=(a(10)-jse)*0.201529
a(17)=(a(10)-jse)*0.798471
a(15)=a(16)+a(17)
a(18)=0
a(19)=0
a(21)=(a(14)-a(16)-a(17))*0.4467+a(17)
a(22)=(a(14)-a(16)-a(17))*0.2703
a(23)=(a(14)-a(16)-a(17))*0.2711+a(16)
a(24)=(a(14)-a(16)-a(17))*0.0119
a(20)=a(21)+a(22)+a(23)+a(24)
a(25)=0
a(26)=0
a(27)=a(23)
a(28)=rs
a(29)=a(27)/a(28)
tt=0
do while tt<=28
tt=tt+1
go tt
replace next 1 ▒╛╘┬╩² with a(tt)
enddo
replace all └█╝╞╩² with └█╝╞╩²+▒╛╘┬╩²
use
release all
set safety on
return