home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / AUTOEDIT.BAS < prev    next >
BASIC Source File  |  1993-12-18  |  11KB  |  235 lines
  1. SUB AUTOEDIT
  2. $IF NOT %NOAUTOEDIT
  3. ' I don't want to hear a word about this code.  It was written in 1987 in
  4. ' GWBASIC and it works fine the way it is.  This is a real incredible piece of
  5. ' history here, since this one routine is the single piece of BASIC code that
  6. ' started this whole project.  AutoEdit was written so I would not have to
  7. ' do so much work fixing database records we downloaded from a local real
  8. ' estate database service.  Years later I was led to create my own database
  9. ' service to compensate for features that were missing in the commercial
  10. ' systems available.  The rest is history.  Since then, I have changed very
  11. ' little of the inner workings of this routine.  In fact, I don't really
  12. ' understand how it even works, and have made many attempts to reproduce
  13. ' it, but it is so spaghettied that I cannot even figure out what it does.
  14. ' I guess I was doing some pretty hard drugs when I wrote it!
  15.  
  16. DIM R$(50), A$(30)
  17. DIM CUSTOM$(25, 2)
  18.  
  19. initialize:
  20. 'initialize the autoeditor variables *************************
  21. y = 1: M$ = "Mr.": GOSUB 1118
  22. CHOP3RD = 1
  23. GOSUB AUTOEDITOR: GOTO endautoeditsub
  24.  
  25. nameformatting:
  26. 'split apart multiple names ***********************************
  27. A$(1) = "": A$(2) = ""
  28. R$(2) = RTRIM$(R$(2)): R$(2) = LTRIM$(R$(2))
  29. IF INSTR(R$(2), "TRUST") > 0 THEN A$(1) = R$(2): RETURN
  30. IF INSTR(R$(2), "&") > 0 THEN A$(1) = LEFT$(R$(2), INSTR(R$(2), "&") - 1): A$(2) = MID$(R$(2), INSTR(R$(2), "&") + 1): GOTO lname
  31. IF INSTR(R$(2), "+") > 0 THEN A$(1) = LEFT$(R$(2), INSTR(R$(2), "+") - 1): A$(2) = MID$(R$(2), INSTR(R$(2), "+") + 1): GOTO lname
  32. IF INSTR(R$(2), " AND ") > 0 THEN A$(1) = LEFT$(R$(2), INSTR(R$(2), " AND ")): A$(2) = MID$(R$(2), INSTR(R$(2), " AND ") + 5): GOTO lname
  33. A$(1) = R$(2): IF LEN(A$(1)) > 3 THEN A$ = RIGHT$(A$(1), 2): IF LEFT$(A$, 1) = " " THEN A$(1) = LEFT$(A$(1), LEN(A$(1)) - 2)
  34. FOR ii% = 1 TO 26: IF INSTR(A$(1), " " + CHR$(64 + ii%) + " ") > 4 THEN A$(1) = LEFT$(A$(1), INSTR(A$(1), " " + CHR$(64 + ii%) + " ") - 1) + " " + MID$(A$(1), INSTR(A$(1), " " + CHR$(64 + ii%) + " ") + 3)
  35. NEXT ii%
  36.  
  37. RETURN
  38.  
  39. lname:
  40. A$(1) = RTRIM$(A$(1)): A$(1) = LTRIM$(A$(1))
  41. A$(2) = RTRIM$(A$(2)): A$(2) = LTRIM$(A$(2))
  42. IF LEN(A$(1)) > 3 THEN A$ = RIGHT$(A$(1), 2): IF LEFT$(A$, 1) = " " THEN A$(1) = LEFT$(A$(1), LEN(A$(1)) - 2)
  43. IF INSTR(A$(1), " ") = 0 THEN RETURN
  44. FOR ii% = 1 TO 26: IF INSTR(A$(1), " " + CHR$(64 + ii%) + " ") > 4 THEN A$(1) = LEFT$(A$(1), INSTR(A$(1), " " + CHR$(64 + ii%) + " ") - 1) + " " + MID$(A$(1), INSTR(A$(1), " " + CHR$(64 + ii%) + " ") + 3)
  45. NEXT ii%
  46. IF INSTR(A$(2), " ") = 0 THEN A$(2) = LEFT$(A$(1), INSTR(A$(1), " ")) + A$(2): RETURN
  47. IF LEN(A$(2)) < 3 THEN RETURN
  48. A$ = RIGHT$(A$(2), 2)
  49. IF LEFT$(A$, 1) = " " THEN A$(2) = LEFT$(A$(1), INSTR(A$(1), " ")) + LEFT$(A$(2), INSTR(A$(2), " ") - 1): RETURN
  50. RETURN
  51. 'split apart multiple names ********************************
  52.  
  53.  
  54.  
  55. zipprocess:
  56.  
  57. R$(6) = RTRIM$(R$(6)): R$(6) = LTRIM$(R$(6))
  58. A$(4) = RTRIM$(R$(4)) + " " + R$(6)
  59.  
  60. RETURN
  61.  
  62.  
  63.  
  64.  
  65.  
  66. AUTOEDITOR:
  67. 'do a single autoedit for one record **************************
  68.  
  69.  
  70. 'YOU HAVE TO LET A$(Y,1), WHERE Y=1-5, EQUAL THE RAWDATA
  71. 'THEN REMOVE THE SECOND DIMENSION 1-NAME 2-NAME 3-ADD 4-CST 5-PAD
  72. R$(2) = GetVar$("AUTONAME")
  73. R$(4) = GetVar$("AUTOCITYSTATE")
  74. A$(3) = GetVar$("AUTONAME3")
  75. IF A$(3) = "" THEN A$(3) = GetVar$("AUTONAME2")
  76. IF A$(3) = "" THEN A$(3) = GetVar$("AUTOADDRESS")
  77. IF LEFT$(A$(3), 1) = "%" THEN LET A$(3) = GetVar$("AUTONAME2")
  78. A$(5) = GetVar$("AUTOPROPERTY"): A$(5) = LTRIM$(A$(5))
  79. R$(6) = GetVar$("AUTOZIP")
  80.  
  81. GOSUB nameformatting
  82. GOSUB zipprocess
  83.  
  84.  
  85.  
  86. 'do a single autoedit for one record **************************
  87.  
  88. NIGRIG:
  89. SECOND$ = "": INC$ = "": FLIP = 0: APT$ = "": Flag = 0
  90.  
  91. 1013 A$(8) = A$(1): A$(9) = A$(2): A$(10) = A$(3): A$(11) = A$(4): A$(12) = A$(5): A$(13) = "     "
  92. 1014 FOR n = 1 TO 5
  93. 1015 g$ = "": GG$ = ""
  94. 1016 FOR L = 1 TO LEN(A$(n)):
  95. 1017 IF MID$(A$(n), L, 1) = "" THEN 1021
  96. 1018 IF MID$(A$(n), L, 1) = " " AND LEN(g$) > 0 THEN GOTO 1052
  97. 1019 IF MID$(A$(n), L, 1) = " " THEN 1021
  98. 1020 g$ = g$ + MID$(A$(n), L, 1)
  99. 1021 NEXT L
  100. 1022 Flag = 0: IF LEN(g$) > 0 THEN Flag = 1: GOTO 1052
  101. 1023 Flag = 0: A$(n) = GG$: GG$ = "": IF LEN(A$(6)) < 5 THEN GOSUB 1058: GOTO 1025
  102. 1024 IF n <> 2 THEN GOSUB 1058 ELSE SECOND$ = "LOADED": GOSUB 1058
  103. 1025 NEXT n
  104.  
  105. 1026 REM
  106. '    ***********  insert the autoedited fields into the array  *********
  107. 1027 REM
  108.  
  109.  
  110. 1029
  111. 1030
  112. 1031
  113. 1032
  114.  
  115.  
  116. WW = 5: GOSUB 1125: CALL VSET2("PROPERTY", LTRIM$(pno$ + " " + pnm$))
  117. CALL VSET2("CITYLINE", A$(4))
  118. WW = 3: GOSUB 1125: R$(29) = sno$: R$(30) = snm$: CALL VSET2("ADDRESS", LTRIM$(sno$ + " " + snm$))
  119. CALL VSET2("NAME", A$(6))
  120.  
  121. GOSUB 1133
  122. CALL VSET2("FORMAL", A$(7))
  123. GOSUB 1131
  124. GOSUB 1135
  125. CALL VSET2("INFORMAL", A$(14))
  126.  
  127. 1051 RETURN
  128. 1052 REM
  129. 1053 IF LEN(g$) = 1 THEN GG$ = GG$ + g$ + " ": GOTO 1057
  130. 1054 LA$ = RIGHT$(g$, (LEN(g$) - 1)): FIR$ = LEFT$(g$, 1)
  131. 1055  LA$ = LCASE$(LA$)
  132. 1056 GG$ = GG$ + FIR$ + LA$ + " "
  133. 1057 g$ = "": IF Flag = 1 THEN GOTO 1023 ELSE GOTO 1021
  134. 1058 REM this part checks for name patterns
  135. 1059 REM using variable a$(n,y) where n is 1-5,6 and 7 and y=1-# of recs
  136. 1060 IF n = 3 OR n = 5 THEN 1098
  137. 1061 IF n = 1 OR n = 2 THEN 1063
  138. 1062 IF n = 4 THEN 1093
  139. 1063'IF INSTR(a$(n), "Inc") > 0 OR INSTR(a$(n), " Co ") > 0 OR INSTR(a$(n), " Co.") > 0 OR INSTR(a$(n), " Corp") > 0 OR INSTR(a$(n), " Assn") > 0 OR INSTR(a$(n), "Trust") > 0 OR INSTR(a$(n), " Bank ") > 0 THEN INC$ = a$(n):    IF n = 1 THEN RETURN
  140. 1064'IF INSTR(a$(n), "Apt") > 0 OR INSTR(a$(n), "Suite") > 0 OR INSTR(a$(n), "Unit") > 0 THEN APT$ = a$(n): a$(n) = ""
  141.  
  142. 1065 IF n = 2 AND A$(2) = "" THEN SECOND$ = "": GOTO 1092
  143. 1066 IF LEFT$(A$(n), 3) = "La " THEN A$(n) = LEFT$(A$(n), 2) + MID$(A$(n), 4)
  144. IF LEFT$(A$(n), 3) = "Le " THEN A$(n) = LEFT$(A$(n), 2) + MID$(A$(n), 4)
  145. 1067 IF LEFT$(A$(n), 3) = "Mc " THEN A$(n) = LEFT$(A$(n), 2) + MID$(A$(n), 4)
  146. 1068 IF LEFT$(A$(n), 4) = "Mac " THEN A$(n) = LEFT$(A$(n), 3) + MID$(A$(n), 5)
  147. 1069 IF LEFT$(A$(n), 2) = "O " THEN A$(n) = LEFT$(A$(n), 1) + MID$(A$(n), 3)
  148. IF LEFT$(A$(n), 3) = "St " THEN A$(n) = LEFT$(A$(n), 2) + "." + MID$(A$(n), 4)
  149. IF LEFT$(A$(n), 3) = "Di " THEN A$(n) = LEFT$(A$(n), 2) + MID$(A$(n), 4)
  150. IF LEFT$(A$(n), 4) = "Van " THEN A$(n) = LEFT$(A$(n), 3) + MID$(A$(n), 5)
  151. IF LEFT$(A$(n), 4) = "Von " THEN A$(n) = LEFT$(A$(n), 3) + MID$(A$(n), 5)
  152.  
  153. 1070 PATTERN$ = "": FOR t = 1 TO LEN(A$(n))
  154. 1071 temp$ = ""
  155. 1072 IF MID$(A$(n), t, 1) = " " THEN temp$ = "0" ELSE temp$ = "1"
  156. 1073 IF temp$ <> HOLD$ THEN PATTERN$ = PATTERN$ + temp$
  157. 1074 HOLD$ = temp$
  158. 1075 NEXT t
  159. 1076 IF LEN(INC$) > 4 AND n = 2 AND FLIP = 1 THEN A$(12) = A$(7): GOTO 1122
  160. 1077 IF PATTERN$ <> "1010" AND PATTERN$ <> "101010" AND LEN(INC$) > 4 AND n = 2 AND SECOND$ = "" THEN A$(11) = A$(6): GOTO 1122
  161. 1078 IF LEN(A$(n)) > 3 THEN IF PATTERN$ = "101010" AND RIGHT$(A$(n), 2) = ". " OR MID$(A$(n), LEN(A$(n)) - 3, 1) = " " THEN 1079 ELSE GOTO 1084
  162. 1079 temp$ = "": HOLD$ = "": RECOG = 1: FOR t = 1 TO LEN(A$(n)): IF MID$(A$(n), t, 1) <> " " THEN temp$ = temp$ + MID$(A$(n), t, 1): GOTO 1083
  163. 1080 IF GG$ <> "" THEN 1083
  164. 1081 IF HOLD$ = "" THEN HOLD$ = temp$: temp$ = "": GOTO 1083
  165. 1082 fgg$ = temp$: A$(14) = fgg$: GG$ = temp$ + " " + HOLD$: GOSUB 1112: A$(7) = M$ + " " + HOLD$: A$(6) = GG$: IF SECOND$ = "" THEN LSTNAME$ = HOLD$: newf$ = temp$: FLIP = 1: A$(18) = temp$: A$(20) = HOLD$ ELSE A$(19) = temp$: A$(21) = HOLD$
  166. 1083 NEXT t: GOTO 1085
  167. 1084 IF PATTERN$ = "101010" AND CHOP3RD = 1 THEN GOTO 1079 ELSE IF PATTERN$ <> "1010" THEN 1091
  168. 1085 RECOG = 1
  169. 1086 temp$ = "": HOLD$ = "": FOR t = 1 TO LEN(A$(n)): IF MID$(A$(n), t, 1) <> " " THEN temp$ = temp$ + MID$(A$(n), t, 1): GOTO 1090
  170. 1087 IF GG$ <> "" THEN 1090
  171. 1088 IF HOLD$ = "" THEN HOLD$ = temp$: temp$ = "": GOTO 1090
  172. 1089 fgg$ = temp$: A$(14) = fgg$
  173. GG$ = temp$ + " " + HOLD$
  174.  
  175. GOSUB 1112: A$(7) = M$ + " " + HOLD$
  176. A$(6) = GG$: IF SECOND$ = "" THEN LSTNAME$ = HOLD$: newf$ = temp$: FLIP = 1: A$(18) = temp$: A$(20) = HOLD$ ELSE A$(19) = temp$: A$(21) = HOLD$
  177. 1090 NEXT t
  178. 1091 IF SECOND$ = "LOADED" AND RECOG = 1 THEN GOSUB 1106 ELSE IF SECOND$ = "LOADED" AND n = 2 THEN A$(12) = A$(n)
  179. 1092 RECOG = 0: RETURN
  180. 1093 REM modify address......
  181. 1094 LON = LEN(A$(n)): IF LON < 12 THEN GOTO 1097 ELSE IF MID$(A$(n), LON - 6, 1) = " " AND MID$(A$(n), LON - 9, 1) = " " THEN 1095 ELSE GOTO 1097
  182. 1095 UC$ = MID$(A$(n), LON - 8, 2): UC$ = UCASE$(UC$)
  183. 1096 A$(n) = LEFT$(A$(n), LON - 10) + ", " + UC$ + "   " + RIGHT$(A$(n), 6): A$(15) = RIGHT$(A$(n), 6)
  184. 1097 SECOND$ = "": RETURN
  185. 1098 REM  custom manipulation of address, fields 3 and 5 (street address), search and replace. *******
  186. 1099 IF CUSTOM$ = "" THEN 1104
  187. 1100 FOR WHELP = 1 TO fussbudget
  188. 1101 ORGASMIC = INSTR(A$(n), CUSTOM$(WHELP, 1)): IF ORGASMIC = 0 THEN 1103
  189. 1102 A$(n) = LEFT$(A$(n), ORGASMIC - 1) + CUSTOM$(WHELP, 2) + MID$(A$(n), ORGASMIC + LEN(CUSTOM$(WHELP, 1)))
  190. 1103 NEXT WHELP
  191. 1104 IF APT$ = "" THEN 1105 ELSE IF n = 3 THEN A$(n) = A$(n) + " " + APT$: APT$ = ""
  192. 1105 RETURN
  193. 1106 REM CHECK FOR POSSIBLE HUSBAND AND WIFE
  194.  
  195. '***** LAST AND FIRST NAMES
  196. A$(20) = LSTNAME$: A$(21) = HOLD$: A$(18) = newf$: A$(19) = fgg$
  197.  
  198. 1107 IF LSTNAME$ <> HOLD$ THEN A$(6) = newf$ + " " + LSTNAME$ + " & " + A$(6): A$(7) = "Owners": A$(14) = newf$ + " and " + A$(6): GOTO 1111
  199. 1108 A$(6) = newf$ + " and " + fgg$ + " " + LSTNAME$
  200. 1109 A$(7) = "Mr. & Mrs. " + HOLD$: A$(14) = newf$ + " and " + fgg$: A$(18) = newf$: A$(19) = fgg$
  201. 1110 'SOUND 200, .5: PRINT a$(6): PRINT a$(7)
  202. 1111 RETURN
  203. 1112 cc = 0: M$ = "Mr."
  204. IF INSTR(Female$, temp$ + " ") THEN M$ = "Ms."
  205. RETURN
  206. 1113
  207. 1114
  208. 1115
  209. 1116
  210. 1117 RETURN
  211. 1118 IF LEN(Female$) THEN RETURN ELSE LET Buffer = FREEFILE: OPEN "FEMALES.DAT" FOR INPUT AS #Buffer
  212. 1119 IF EOF(Buffer) THEN CLOSE #Buffer: RETURN ELSE INPUT #Buffer, FEM$: Female$ = Female$ + " " + FEM$: GOTO 1119
  213. 1120 RETURN
  214. 1121 REM
  215. 1122 A$(6) = INC$: A$(7) = "Sir or Madam": GOTO 1092
  216. 1123
  217. 1124
  218. 1125 sno$ = "": snm$ = ""
  219. 1126 SP = INSTR(A$(WW), " "): IF SP = 0 THEN sno$ = "0": GOTO 1128
  220. 1127 sno$ = LEFT$(A$(WW), SP - 1): snm$ = MID$(A$(WW), SP + 1)
  221. 1128 IF INSTR(sno$, "%") > 0 THEN sno$ = ""
  222. IF VAL(sno$) = 0 THEN sno$ = "": snm$ = A$(WW)
  223. 1129
  224. 1130 RETURN
  225. 1131 SP = INSTR(A$(14), "and"): ps = INSTR(A$(14), "&"): IF SP > 1 AND ps > 1 AND ps > SP THEN A$(14) = MID$(A$(14), SP + 3)
  226. 1132 RETURN
  227. 1133 IF A$(7) = "*NULL*" THEN A$(7) = "Sir or Madam"
  228. 1134 RETURN
  229. 1135 IF A$(14) = "*NULL*" THEN A$(14) = "Friends"
  230. 1136 RETURN
  231.  
  232. endautoeditsub:
  233. $ENDIF
  234. END SUB
  235.