home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b077 / 1.img / SBGL.ZIP / BJH6.PRG < prev    next >
Encoding:
Text File  |  1980-01-01  |  1.4 KB  |  110 lines

  1. clear
  2. set talk off
  3. set device to screen
  4. close database 
  5. if t='2'
  6. set cons off
  7. dele file sx.dbf
  8. use bjh
  9. copy to eb for bjh5<>0 field ì
  10. bjh1,bjh5,bjh12
  11. set cons on
  12. endif
  13. a='        '
  14. @ 4,10 say '╟δ╩Σ╚δ╜╪╓╣╚╒╞┌' get a pict '99.99.99'
  15. read
  16. clear
  17. @ 4,20 say "╒²╘┌╝╞╦πú¼╟δ╔╘║≥úí"
  18. j1=substr(a,4,2)
  19. j2=substr(a,7,2) 
  20. j3=substr(a,1,2)
  21. a=j1+'/'+j2+'/'+j3
  22. a=ctod(a)
  23. sele 1
  24. use eb
  25. sele 2
  26. use xs
  27. sele 5
  28. use de
  29. sele 6
  30. use sb index sb1
  31. sele 7
  32. use jh index jh1
  33. dele all for jh2='4'
  34. pack
  35. sele 1
  36. do while .not. eof()
  37. e=bjh5
  38. c=bjh12
  39. b=1
  40. p1=1
  41. do while c+e<=a
  42. f=c+e
  43. c=month(f)
  44. if p1=1
  45. p=bjh1
  46. sele 6
  47. seek p
  48. a1=sb13
  49. a2=sb14
  50. a3=sb4
  51. qq=sb24
  52. sele 2
  53. loca for xs16=qq .and. xs17='4'
  54. b1=xs1
  55. b2=xs2
  56. b3=xs3
  57. b4=xs4
  58. b5=xs5
  59. b6=xs6
  60. b7=xs7
  61. b8=xs8
  62. b9=xs9
  63. b10=xs10
  64. b11=xs11
  65. b12=xs12
  66. b13=xs13
  67. b14=xs14
  68. b15=xs15
  69. sele 5
  70. loca for de1=a3
  71. x1=a1*b1
  72. x2=a2*b2
  73. x3=de5*b3
  74. x4=de6*b4
  75. x5=de7*b5
  76. x6=de8*b6
  77. x7=de11*b7
  78. x8=a1*b8+a2*b10+de5*b11+de6*b12+de7*b13+de8*b14+de11*b15
  79. if a1<=a2
  80. p11=a1
  81. a1=a2
  82. a2=p11
  83. endif
  84. x9=b9*a1
  85. p1=2
  86. endif
  87. sele 7
  88. j1=year(a)
  89. j2=year(f)
  90. j1=j1-1
  91. loca for jh1=p .and. jh3=c
  92. if j2>j1
  93. if eof()
  94. appe blank
  95. repl jh1 with p,jh2 with '4',jh3 with c,jh4 with x1,jh5 with ì
  96. x2,jh6 with x3,jh7 with x4,jh8 with x5,jh9 with x6,jh10 with x7
  97. repl jh11 with x8,jh12 with x9
  98. endif
  99. endif
  100. c=f
  101. enddo
  102. sele 1
  103. skip
  104. enddo
  105. close database
  106. set cons on
  107. retu
  108.  
  109.  
  110.