home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 4.ddi / PRG / CONTJD.PRG < prev    next >
Encoding:
Text File  |  1990-02-28  |  1.7 KB  |  83 lines
  1. STOR M1*Z11 TO D
  2. STOR 20*B1 TO B
  3. IF YDDJ<10
  4. STOR "J"+CHR(48+YDDJ) TO BGCH
  5. ELSE
  6. STOR YDDJ-10 TO NUM
  7. STOR "J"+CHR(49)+CHR(48+NUM) TO BGCH
  8. ENDI
  9. USE \HOUSEM\DBF\DTE
  10. LOCA FOR D>DMIN.AND.D<=DMAX
  11. STOR &BGCH TO DTE
  12. USE \HOUSEM\DBF\DEJ
  13. LOCA FOR D>DMIN.AND.D<=DMAX
  14. STOR &BGCH TO DEJ
  15. IF PWDJ<10
  16. STOR "J"+CHR(48+PWDJ) TO PGCH
  17. ELSE
  18. STOR PWDJ-10 TO NUM
  19. STOR "J"+CHR(49)+CHR(48+NUM) TO PGCH
  20. ENDI
  21. IF PWDJ=7
  22. USE \HOUSEM\DBF\DTP
  23. LOCA FOR D>DMIN.AND.D<=DMAX.AND.M>MMIN.AND.M<=MMAX
  24. STOR &PGCH TO DSTP
  25. STOR 0-DSTP TO DXTP
  26. ELSE 
  27. USE \HOUSEM\DBF\DT
  28. LOCA FOR D>DMIN.AND.D<=DMAX.AND.M>MMIN.AND.M<=MMAX
  29. STOR &PGCH TO DT
  30. ENDI
  31. STOR (13-JCDJ)*10 TO JCBD
  32. IF CHX='DC'.OR.CHX='dc'
  33. USE \HOUSEM\DBF\DSS
  34. LOCA FOR D>DMIN.AND.D<=DMAX.AND.M>MMIN.AND.M<=MMAX
  35. STOR &PGCH TO DSS
  36. USE \HOUSEM\DBF\DS
  37. LOCA FOR D>DMIN.AND.D<=DMAX
  38. STOR &BGCH TO DS
  39. ELSE
  40. USE \HOUSEM\DBF\DSS1
  41. LOCA FOR D>DMIN.AND.D<=DMAX.AND.M>MMIN.AND.M<=MMAX
  42. STOR &PGCH TO DSS
  43. USE \HOUSEM\DBF\DS1
  44. LOCA FOR D>DMIN.AND.D<=DMAX
  45. STOR &BGCH TO DS
  46. ENDI
  47. USE \HOUSEM\DBF\DDA
  48. LOCA FOR D>DMIN.AND.D<=DMAX
  49. STOR &BGCH TO DDA
  50. USE \HOUSEM\DBF\DH
  51. LOCA FOR M>MMIN.AND.M<=MMAX
  52. STOR &BGCH TO DH
  53. IF YDDJ=7
  54. STOR 7 TO DSA
  55. ELSE
  56. STOR 10 TO DSA
  57. ENDI
  58. STOR 15 TO DSV
  59. USE \HOUSEM\DBF\ED
  60. LOCA FOR D>DMIN.AND.D<=DMAX
  61. STOR &BGCH TO ED
  62. IF JCDJ<10
  63. STOR "J"+CHR(48+JCDJ) TO JGCH
  64. ELSE
  65. STOR JCDJ-10 TO NUM
  66. STOR "J"+CHR(49)+CHR(48+NUM) TO JGCH
  67. ENDI
  68. USE \HOUSEM\DBF\ET
  69. LOCA FOR B>BMIN.AND.B<=BMAX
  70. STOR &JGCH TO ET
  71. USE \HOUSEM\DBF\CONJDZ
  72. APPE BLANK
  73. REPL DTE1 WITH DTE,DEJ1 WITH DEJ
  74. IF PWDJ=7
  75. REPL DSTP1 WITH DSTP,DXTP1 WITH DXTP
  76. ELSE 
  77. REPL DT1 WITH DT
  78. ENDI
  79. REPL JCBD1 WITH JCBD
  80. REPL DSS1 WITH DSS,DS1 WITH DS,DDA1 WITH DDA,DH1 WITH DH
  81. REPL DSA1 WITH DSA,DSV1 WITH DSV,ED1 WITH ED,ET1 WITH ET
  82. RETURN
  83.