home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b077 / 1.img / SBGL.ZIP / YH6.PRG < prev    next >
Encoding:
Text File  |  1979-12-31  |  1.4 KB  |  107 lines
  1. clear
  2. set talk off
  3. set device to screen
  4. close database
  5. sele 1
  6. use yhf
  7. sele 2
  8. use yh index yh2
  9. sele 3
  10. use yh1 
  11. dele all
  12. pack
  13. sele 4
  14. use sb index sb1
  15. a='        '
  16. p150='   '
  17. cc='   '
  18. @ 4,10 say "╟δ╩Σ╚δ╓╒╓╣╚╒╞┌" get a pict '99.99.99'
  19. @ 5,10 say "╫ε╢╠╗╗╙═╖┤└í╚╒╞┌" get p150 pict '999'
  20. @ 6,10 say "╢¼╝╛╡─╫ε╢╠╩▒╝Σ" get cc pict '999'
  21. read
  22. sele 1
  23. p150=val(p150)
  24. cc=val(cc)
  25. copy to yhf1 for yhf6>=p150 field yhf1,yhf2,yhf3
  26. use yhf1
  27. clear
  28. @ 4,18 say "╒²╘┌╝╞╦πú¼╟δ╔╘║≥úí"
  29. set cons off
  30. j1=substr(a,4,2)
  31. j2=substr(a,7,2)
  32. j3=substr(a,1,2)
  33. a=j1+'/'+j2+'/'+j3
  34. a=ctod(a)
  35. p160=a-365
  36. sele 4
  37. do while .not. eof()
  38. b=sb1
  39. c=sb4
  40. sele 2
  41. seek c          
  42. do while c=yh1 .and. .not. eof()
  43. d=yh12
  44. e=yh2
  45. p1=yh5
  46. p2=yh6
  47. p4=yh13
  48. p7=yh3
  49. sele 1
  50. loca for b=yhf1 .and. e=yhf2
  51. p3=yhf3
  52. do while p3+d<=a
  53. p3=p3+d
  54. sele 3
  55. p5=month(p3)
  56. if p5>=4 .and. p5<=9
  57. if p1<>'          '
  58. loca for y1=p1
  59. if eof()
  60. appe blank
  61. repl y1 with p1,y2 with p4
  62. else
  63. repl y2 with y2+p4
  64. endif
  65. else
  66. loca for y1=p2
  67. if eof()
  68. appe blank
  69. repl y1 with p2,y2 with p4
  70. else
  71. repl y2 with y2+p4
  72. endif
  73. endif
  74. else
  75. if p2<>'          '
  76. loca for y1=p2
  77. if eof()
  78. appe blank
  79. repl y1 with p2,y2 with p4
  80. else
  81. repl y2 with y2+p4
  82. endif
  83. else 
  84. loca for y1=p1
  85. if eof()
  86. appe blank
  87. repl y1 with p1,y2 with p4
  88. else
  89. repl y2 with y2+p4
  90. endif
  91. endif
  92. endif
  93. enddo
  94. sele 2
  95. skip 
  96. enddo
  97. sele 4
  98. skip
  99. enddo
  100. do yhc.prg
  101. set cons on
  102. do yh7.prg 
  103. retu
  104.  
  105.  
  106.  
  107.