home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b077 / 1.img / SBGL.ZIP / YH9.PRG < prev    next >
Encoding:
Text File  |  1980-01-01  |  1.1 KB  |  81 lines
  1. clear
  2. set talk off
  3. set device to screen
  4. close database
  5. sele 5
  6. use yjh
  7. dele all 
  8. pack
  9. sele 1
  10. use yhf
  11. sele 2
  12. use yh index yh2
  13. sele 3
  14. use yh1 
  15. sele 4
  16. use sb index sb1
  17. a='        '
  18. p150='   '
  19. @ 4,10 say "╟δ╩Σ╚δ╓╒╓╣╚╒╞┌" get a pict '99.99.99'
  20. @ 5,10 say "╦∙╥¬╡─╫ε╢╠╗╗╙═╓▄╞┌" get p150 pict '999'
  21. read
  22. p150=val(p150)
  23. sele 1
  24. copy to yhf1 for yhf6>=p150 field yhf1,yhf2,yhf3
  25. use yhf1
  26. sele 4
  27. j1=substr(a,4,2)
  28. j2=substr(a,7,2)
  29. j3=substr(a,1,2)
  30. a=j1+'/'+j2+'/'+j3
  31. a=ctod(a)
  32. do while .not. eof()
  33. b=sb1
  34. c=sb4
  35. sele 2
  36. seek c          
  37. do while c=yh1 .and. .not. eof()
  38. d=yh12
  39. e=yh2
  40. p1=yh5
  41. p2=yh6
  42. p4=yh13
  43. p7=yh3
  44. sele 1
  45. loca for yhf1=b .and. yhf2=e
  46. p3=yhf3
  47. do while p3+d<=a
  48. p3=p3+d
  49. sele 3
  50. p5=month(p3)
  51. if p5>=4 .and. p5<=9
  52. sele 5
  53. appe blank
  54. repl y1 with b,y2 with e,y3 with p3,y4 with p1,y5 with p4,y6 with ì
  55. p7
  56. if p1='          '
  57. repl y4 with p2
  58. endif
  59. sele 3
  60. else
  61. sele 5
  62. appe blank
  63. repl y1 with b,y2 with e,y3 with p3,y4 with p2,y5 with p4,y6 with ì
  64. p7
  65. if p2='          '
  66. repl y4 with p1
  67. endif
  68. sele 3
  69. endif
  70. enddo
  71. sele 2
  72. skip 
  73. enddo
  74. sele 4
  75. skip
  76. enddo
  77. retu
  78.  
  79.  
  80.  
  81.