home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol083 / memo.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-14  |  26.1 KB  |  464 lines
  1. 1  'PERSONAL DATEBOOK
  2. 2  '(c) 1984 by LATERAL PROGRAMMING, INC. All rights reserved.
  3. 3  'P.O. Box 337, Altamonte Springs, FL 32715
  4. 4  '(305) 788-1433
  5. 5  'Version 1.01 JULY 1984
  6. 6  'Program name is "MEMO"
  7. 7  'PERSONAL DATEBOOK is a FREEWARE distribution product. You are urged to copy
  8. 8  'and distribute this program without restriction.
  9. 10  CLS:CLR=2:WIDTH 80:ON ERROR GOTO 444
  10. 11  GOSUB 443:GOSUB 430:IF MA%=2 THEN CA=0:CB=7:GOTO 15
  11. 12  IF MA%=1 THEN CA=4:CB=14:GOTO 15
  12. 13  IF MA%=3 THEN 433
  13. 14  SYSTEM
  14. 15  CLS:SCREEN 0,0,0:COLOR CLR,0:WIDTH 80:DEFINT I,J,K:YA%=1900:YB%=1999:KEY OFF:FOR I=1 TO 10:KEY I,"":NEXT:DIM LA$(12,2),MB(21),MY$(20),DA%(31),DB$(20):DIM FA$(20),HA$(20),PA$(20),RA$(20):DIM F$(19),F#(19)
  15. 16  DIM CX(19),CY(19),FL(19),TY$(19):DIM H$(30):DIM MC$(624),TA%(31):CLS:LOCATE 10,30:COLOR CA,CB:PRINT" ONE MOMENT PLEASE ";:COLOR CLR,0:GOTO 94
  16. 17  LOCATE 10,24:COLOR CA,CB:PRINT" DISK NEARLY FULL BUT OK TO USE ";:COLOR CLR,0:LOCATE 12,17:PRINT"ERASE OLD FILES OR USE NEW DISK FOR NEW MONTHS";:BEEP:BEEP:BEEP:LOCATE 14,27:PRINT"PRESS ANY KEY TO CONTINUE";:GOSUB 106
  17. 18  RS$=INKEY$:IF RS$=""THEN 18
  18. 19  ON ERROR GOTO 445
  19. 20  CLS:GOSUB 183
  20. 21  DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER:RESTORE 21:P=VAL(LEFT$(DATE$,2)):FOR I=1 TO P:READ P$:NEXT:GOSUB 182:GOSUB 103:COLOR CA,CB
  21. 22  LOCATE 24,1:PRINT"SYSTEM MONTH IS "LEFT$(P$,3)", "RIGHT$(DATE$,4)"  DO YOU WANT SYSTEM MONTH?  (Y/N)";:GOSUB 177:IF V$="Y"THEN 24
  22. 23  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ENTER DESIRED MONTH AND YEAR:";:COLOR CLR,0:GOTO 25
  23. 24  CH$=P$+RIGHT$(DATE$,4):COLOR CLR,0:GOTO 26
  24. 25  DEF SEG=0:POKE 1047,96:DEF SEG:GOSUB 106:ROW%=24:COL%=32:GOSUB 108:CH$=XP$
  25. 26  MY$=LEFT$(CH$,3)+", 19"+RIGHT$(CH$,2):RESTORE 27:FOR J=1 TO 12:FOR K=1 TO 2:READ LA$(J,K):NEXT:NEXT
  26. 27  DATA JAN,31,FEB,28,MAR,31,APR,30,MAY,31,JUN,30,JUL,31,AUG,31,SEP,30,OCT,31,NOV,30,DEC,31:GOSUB 117:GOSUB 124:GOSUB 129:GOSUB 135:GOSUB 189
  27. 28  GOSUB 104:GOSUB 139:GOSUB 142:IF FK%=59 GOTO 33
  28. 29  IF FK%=60 THEN 185
  29. 30  IF FK%=61 GOTO 270
  30. 31  IF FK%=68 GOTO 92
  31. 32  GOSUB 186:GOTO 28
  32. 33  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"ENTER DAY OF MONTH:";:ROW%=24:COL%=22:COLOR CLR,0:GOSUB 161:DT%=NUM%:DT$=STR$(NUM%):IF DT%<1 OR DT%>ND%THEN GOSUB 186:GOTO 33
  33. 34  IF DA%(DT%)<>0 THEN 40
  34. 35  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"NO MEMO IN FILE FOR "MO$" "DT$"   ENTER NEW MEMO OR PRESS <RET> TO QUIT";:COLOR CLR,0:COLOR CA,CB:LOCATE 1,38:PRINT"     ENTER NEW MEMO FOR "MO$" "DT$"      ";:COLOR CLR,0:GOSUB 146
  35. 36  IF L%=0 THEN GOSUB 135:GOTO 28
  36. 37  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"FILING MEMO";:COLOR CLR,0:FOR I=1 TO L%:LSET TAG$=CHR$(128):LSET DAT$=RIGHT$(DT$,2):LSET MD$=DB$(I):PUT#2,HB%+I:NEXT:GOSUB 188:DA%(DT%)=HB%+1:HB%=HB%+L%:GOSUB 135:GOTO 54
  37. 38  IF DA%(DT%)=0 GOTO 90
  38. 39  DT$=RIGHT$(STR$(DT%),2)
  39. 40  ERASE DB$:DIM DB$(20):COLOR CA,CB:LOCATE 1,38:PRINT"     MEMOS FOR "MO$" "DT$", "Y%"      ";:COLOR CLR,0:L%=0:FOR I=0 TO 19:GET#2,DA%(DT%)+I:IF TAG$<>CHR$(128)OR DAT$="KL"GOTO 43
  40. 41  IF VAL(DAT$)<>DT%THEN I=19:GOTO 43
  41. 42  DB$(I+1)=MD$:L%=L%+1:COLOR CLR,0:LOCATE I+2,39:PRINT DB$(I+1)
  42. 43  NEXT
  43. 44  GOSUB 140
  44. 45  GOSUB 142:IF FK%=59 GOTO 99
  45. 46  IF FK%=60 GOTO 54
  46. 47  IF FK%=61 GOTO 270
  47. 48  IF FK%=62 THEN GOSUB 102:GOTO 44
  48. 49  IF FK%=67 GOTO 28
  49. 50  GOSUB 186:GOTO 44
  50. 51  IF L%>19 THEN GOSUB 187:GOTO 44
  51. 52  KA=L%:GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ENTER NEW MEMO LINE(S) OR PRESS <RET> TO QUIT";:COLOR CLR,0:GOSUB 147:FOR I=1 TO L%:LSET TAG$=CHR$(128):LSET DAT$=RIGHT$(DT$,2):LSET MD$=DB$(I):PUT#2,HB%+I:NEXT:GOSUB 160
  52. 53  GOSUB 188:DA%(DT%)=HB%+1:HB%=HB%+L%
  53. 54  GOSUB 141:GOSUB 142:IF FK%=59 THEN 88
  54. 55  IF FK%=60 THEN GOSUB 182:GOSUB 105:KA=L%:GOSUB 160:GOTO 35
  55. 56  IF FK%=61 GOTO 51
  56. 57  IF FK%=62 GOTO 63
  57. 58  IF FK%=63 GOTO 68
  58. 59  IF FK%=64 GOTO 75
  59. 60  IF FK%=65 GOTO 81
  60. 61  IF FK%=67 THEN 44
  61. 62  GOSUB 186:GOTO 54
  62. 63  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"SELECT LINE TO BE RETYPED:";:LOCATE 25,1:PRINT"<F9> QUIT/EDIT MENU";:COLOR 2,0
  63. 64  ROW%=24:COL%=28:COLOR CLR,0:GOSUB 161:IF NUM%=99 GOTO 54
  64. 65  IF NUM%=0 OR NUM%>L%THEN GOSUB 186:GOTO 63
  65. 66  LOCATE 1,38:COLOR CA,CB:PRINT"     ENTER NEW LINE."SPC(7)"MUST END HERE"CHR$(25);:COLOR CLR,0:LOCATE NUM%+1,39:PRINT SPC(40):QA%=1:HC%=L%:L%=NUM%-1:GOSUB 147:DB$(NUM%)=ME$:L%=HC%:RD%=DA%(DT%)
  66. 67  FOR I=1 TO L%:LSET TAG$=CHR$(128):LSET DAT$=RIGHT$(DT$,2):LSET MD$=DB$(I):PUT#2,RD%+I-1:NEXT:GOSUB 188:COLOR CA,CB:LOCATE 24,28:PRINT SPC(2):COLOR CLR,0:GOTO 64
  67. 68  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"SELECT LINE TO BE DELETED:";:LOCATE 25,1:PRINT"<F9> QUIT/EDIT MENU";:COLOR 2,0
  68. 69  KA=L%:ROW%=24:COL%=28:COLOR CLR,0:GOSUB 161:IF NUM%=99 GOTO 54
  69. 70  IF NUM%=0 OR NUM%>L%THEN GOSUB 186:GOTO 68
  70. 71  IF NUM%=L%THEN L%=L%-1:GOTO 73
  71. 72  L%=L%-1:FOR I=NUM%TO L%:DB$(I)=DB$(I+1):NEXT
  72. 73  GOSUB 105:FOR I=1 TO L%:COLOR CLR,0:LOCATE I+1,39:PRINT DB$(I):LSET TAG$=CHR$(128):LSET DAT$=RIGHT$(DT$,2):LSET MD$=DB$(I):PUT#2,HB%+I:NEXT:GOSUB 160:DA%(DT%)=HB%+1:HB%=HB%+L%
  73. 74  LOCATE 24,28:COLOR CA,CB:PRINT SPC(2):GOTO 69
  74. 75  IF L%+1>20 THEN GOSUB 187:GOTO 54
  75. 76  KA=L%:GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"SELECT LINE WHERE INSERT IS TO BE MADE:";:LOCATE 25,1:PRINT"<F9> QUIT/EDIT MENU";:COLOR CLR,0:ROW%=24:COL%=41:COLOR CLR,0:GOSUB 161:IF NUM%=99 THEN 54
  76. 77  IF NUM%=0 OR NUM%>L%THEN GOSUB 186:GOTO 75
  77. 78  L%=L%+1:FOR I=L%TO NUM%+1 STEP-1:DB$(I)=DB$(I-1):NEXT:GOSUB 105:COLOR CLR,0:FOR I=1 TO L%:LOCATE I+1,39:PRINT DB$(I):NEXT:LOCATE NUM%+1,39:PRINT SPC(40):LOCATE 1,38:COLOR CA,CB
  78. 79  PRINT"     ENTER NEW LINE."SPC(7)"MUST END HERE"CHR$(25);:COLOR CLR,0:HC%=L%:QA%=1:L%=NUM%-1:GOSUB 147:L%=HC%:DB$(NUM%)=ME$:FOR I=1 TO L%:LSET TAG$=CHR$(128):LSET DAT$=RIGHT$(DT$,2):LSET MD$=DB$(I):PUT#2,HB%+I:NEXT
  79. 80  GOSUB 188:GOSUB 160:DA%(DT%)=HB%+1:HB%=HB%+L%:LOCATE 24,41:COLOR CA,CB:PRINT SPC(2):GOTO 75
  80. 81  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"SELECT LINE TO BE MOVED:";:LOCATE 25,1:PRINT"<F9> QUIT/EDIT MENU";:COLOR CLR,0:ROW%=24:COL%=26:COLOR CLR,0:GOSUB 161:IF NUM%=99 GOTO 54
  81. 82  IF NUM%=0 OR NUM%>L%THEN GOSUB 186:GOTO 81
  82. 83  MF%=NUM%:HD$=DB$(MF%):COLOR 4,0:LOCATE 22,39:PRINT HD$SPC(79-POS(C));:COLOR CLR,0:FOR I=MF%TO L%-1:DB$(I)=DB$(I+1):NEXT:DB$(L%)=STRING$(40,32):FOR I=MF%TO L%:LOCATE I+1,39:PRINT DB$(I):NEXT
  83. 84  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ENTER DESTINATION LINE NUMBER:";:COLOR CLR,0:ROW%=24:COL%=32:COLOR CLR,0:GOSUB 161:IF NUM%=0 OR NUM%>L%THEN GOSUB 186:GOTO 84
  84. 85  NA%=NUM%:IF NA%=L%THEN DB$(L%)=HD$:GOTO 87
  85. 86  FOR I=L%TO NA%+1 STEP-1:DB$(I)=DB$(I-1):NEXT:DB$(NA%)=HD$:FOR I=NA%TO L%:LOCATE I+1,39:PRINT SPC(40):NEXT
  86. 87  FOR I=NA%TO L%:LOCATE I+1,39:PRINT DB$(I):NEXT:LOCATE 22,39:PRINT SPC(40):RD%=DA%(DT%):FOR I=1 TO L%:LSET TAG$=CHR$(128):LSET DAT$=RIGHT$(DT$,2):LSET MD$=DB$(I):PUT#2,RD%+I-1:NEXT:GOTO 81
  87. 88  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"VERIFY:  DELETE MEMO?  (Y/N)";:COLOR CLR,0:GOSUB 177:GOSUB 182:IF V$="N"THEN GOSUB 140:GOTO 45
  88. 89  KA=L%:GOSUB 160:GOSUB 135:GOTO 90
  89. 90  DT%=DT%+1:IF DT%=<ND%GOTO 38
  90. 91  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"END OF MEMOS IN "MY$;:COLOR CLR,0:GOSUB 104:GOTO 28
  91. 92  LSET TAG$=CHR$(128):LSET DAT$=CHR$(27)+"Z":LSET MD$="":PUT#2,HB%+1:GOSUB 173:CLOSE:CLS:LOCATE 6,20:COLOR CA,CB:PRINT" ORGANIZING FILES BEFORE ENDING PROGRAM ":LOCATE 8,23:COLOR CLR,0:PRINT"(THIS CONSERVES SPACE ON THE DISK)
  92. 93  LOCATE 10,22:PRINT"HAVE YOU BACKED UP YOUR DISK LATELY?":GOSUB 501:GOTO 255
  93. 94  ON ERROR GOTO 97
  94. 95  SAVE"SPACETST":ON ERROR GOTO 0
  95. 96  KILL"SPACETST.BAS":GOTO 19
  96. 97  IF ERR<>61 THEN 445 ELSE RESUME 17
  97. 98  END
  98. 99  GOSUB 182:GOSUB 106:COLOR CA,CB:LOCATE 24,1:PRINT"MAKE SURE PRINTER IS READY THEN PRESS ANY KEY TO PRINT MEMO SCREEN";
  99. 100  IF INKEY$=""THEN 100
  100. 101  GOSUB 182:PB=0:PC%=VARPTR(PB):POKE PC%,205:POKE PC%+1,5:POKE PC%+2,203:CALL PC%:GOTO 44
  101. 102  FOR K=10 TO 23:LOCATE K,1:PRINT SPC(34):NEXT:RETURN
  102. 103  FOR K=2 TO 8:LOCATE K,2:PRINT SPC(33):NEXT:RETURN
  103. 104  FOR K=2 TO 23:LOCATE K,39:PRINT SPC(40):NEXT:LOCATE 1,38:COLOR CA,CB:PRINT SPC(41):COLOR CLR,0:RETURN
  104. 105  FOR K=2 TO 23:LOCATE K,39:PRINT SPC(40):NEXT:RETURN
  105. 106  DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG:RETURN
  106. 107  FOR I=1 TO 4000:NEXT:RETURN
  107. 108  XP$="":GOSUB 106
  108. 109  LTR$=INKEY$:IF LTR$=""GOTO 109
  109. 110  IF LEN(LTR$)>1 GOTO 109
  110. 111  IF LEN(XP$)=0 AND LTR$=CHR$(8)GOTO 109
  111. 112  IF LTR$=CHR$(8)THEN XP$=LEFT$(XP$,LEN(XP$)-1):GOTO 115
  112. 113  IF LTR$=CHR$(13)THEN RETURN
  113. 114  XP$=XP$+LTR$:LOCATE ROW%,COL%+LEN(XP$)-1:COLOR CLR,0:PRINT LTR$;:IF LEN(XP$)>33 THEN 116 ELSE 109
  114. 115  LOCATE ROW%,COL%:PRINT XP$" ";:GOTO 109
  115. 116  COLOR CLR,0:RETURN
  116. 117  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"OPENING FILE FOR "MY$;:COLOR CLR,0:FOR I=1 TO 3:AA%=ASC(MID$(MY$,I,1)):IF AA%>96 THEN MID$(MY$,I,1)=CHR$(AA%-32)
  117. 118  NEXT:MO$=LEFT$(MY$,3):MG%=0:FOR I=1 TO 12:IF MO$=LA$(I,1)THEN MG%=I:ND%=VAL(LA$(I,2))
  118. 119  NEXT:IF MG%=0 THEN 122
  119. 120  Y$=RIGHT$(MY$,4):Y%=VAL(Y$):IF Y%<YA%OR Y%>YB%THEN 122
  120. 121  GOTO 123
  121. 122  GOSUB 186:GOTO 21
  122. 123  MY$=MO$+", "+Y$:FB$=MO$+Y$+"."+"CAL":NB=Y%*100+MG%+10:RETURN
  123. 124  ERASE DA%:DIM DA%(31):CLOSE#2:OPEN FB$ AS #2 LEN=43:FIELD #2,1 AS TAG$,2 AS DAT$,40 AS MD$:DA$="":FG%=0:FOR I=1 TO 4:GET#2,I:IF TAG$<>CHR$(128)THEN HB%=4:FG%=1:I=4:GOTO 127
  124. 125  IF I<4 THEN DA$=DA$+MD$:GOTO 127
  125. 126  DA$=DA$+LEFT$(MD$,4):HB$=MID$(MD$,5,4):HB%=VAL(HB$)
  126. 127  NEXT:IF FG%=1 THEN RETURN
  127. 128  FOR I=1 TO 31:DA%(I)=VAL(MID$(DA$,I*4-3,4)):NEXT:RETURN
  128. 129  FC%=0:IF Y%MOD 400=0 GOTO 132
  129. 130  IF Y%MOD 100=0 GOTO 133
  130. 131  IF Y%MOD 4<>0 GOTO 133
  131. 132  FC%=1:IF ND%=28 THEN ND%=29
  132. 133  YC=365*Y%+INT((Y%-1)/4)-INT(0.75*(INT((Y%-1)/100)+1)):MH=0:FOR I=1 TO MG%-1:MH=MH+VAL(LA$(I,2)):NEXT:DD=YC+MH+1:IF FC%=1 AND MG%>2 THEN DD=DD+1
  133. 134  DW%=DD+INT(-DD/7)*7+6:RETURN
  134. 135  LOCATE 1,1:COLOR CA,CB:PRINT SPC(13)MY$SPC(13):COLOR 4,0:LOCATE 2,2:COLOR 14,0:PRINT"SUN  MON  TUE  WED  THU  FRI  SAT";:COLOR 4,0:CS%=1:FOR R%=3 TO 9:FOR C%=2 TO 32 STEP 5:CD%=CS%-DW%:IF CD%<1 OR CD%>ND%GOTO 138
  135. 136  CD$=STR$(CD%):CD$=RIGHT$(CD$,LEN(CD$)-1):IF DA%(CD%)<>0 THEN COLOR 12,0
  136. 137  LOCATE R%,C%:PRINT CD$:COLOR 4,0
  137. 138  CS%=CS%+1:NEXT:NEXT:COLOR CLR,0:RETURN
  138. 139  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"MAIN MENU:"SPC(69);:LOCATE 25,1:PRINT"<F1> PICK DAY  <F2> PICK MONTH/YEAR  <F3> ADDRESS LIST        <F10> END PROGRAM";:COLOR CLR,0:RETURN
  139. 140  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"MEMO MENU:"SPC(55)"<F9> MAIN MENU";:LOCATE 25,1:PRINT"<F1> PRINT MEMO    <F2> EDIT MEMO    <F3> ADDRESS LIST   <F4> CLEAR ADDRESS BOX";:COLOR CLR,0:RETURN
  140. 141  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"EDIT MENU: <F1> DELETE MEMO  <F2> RETYPE MEMO                    <F9> MEMO MENU";:LOCATE 25,1:PRINT"<F3> ADD LINE <F4> RETYPE LINE <F5> DELETE LINE <F6> INSERT LINE <F7> MOVE LINE";:COLOR CLR,0:RETURN
  141. 142  GOSUB 106
  142. 143  FK$=INKEY$:IF FK$=""GOTO 143
  143. 144  IF LEN(FK$)=2 THEN FK%=ASC(RIGHT$(FK$,1)):RETURN
  144. 145  GOTO 143
  145. 146  ERASE DB$:DIM DB$(20):L%=0:QA%=0
  146. 147  GOSUB 106:DEF SEG=0:POKE 1047,32:DEF SEG
  147. 148  ME$="":L%=L%+1:IF L%>20 THEN GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"MEMO FULL";:BEEP:COLOR CLR,0:GOTO 159
  148. 149  LOCATE L%+1,39:PRINT STRING$(40,46):LOCATE L%+1,39,1
  149. 150  LTR$=INKEY$:IF LTR$=""GOTO 150
  150. 151  IF LEN(ME$)<>0 AND LTR$=CHR$(13)GOTO 157
  151. 152  IF LEN(ME$)=0 AND LTR$=CHR$(13)GOTO 159
  152. 153  IF LTR$=CHR$(8)AND LEN(ME$)<>0 THEN ME$=LEFT$(ME$,LEN(ME$)-1):PRINT CHR$(29)"."CHR$(29);:GOTO 150 ELSE IF LTR$=CHR$(8)GOTO 150
  153. 154  IF LEN(LTR$)=2 GOTO 150
  154. 155  IF LEN(ME$)=40 THEN BEEP:GOTO 150
  155. 156  ME$=ME$+LTR$:PRINT LTR$;:GOTO 150
  156. 157  IF QA%=1 THEN QA%=0:LOCATE,,0:RETURN
  157. 158  DB$(L%)=ME$:GOTO 148
  158. 159  L%=L%-1:LOCATE,,0:RETURN
  159. 160  RD%=DA%(DT%):FOR I=0 TO KA-1:LSET TAG$=CHR$(128):LSET DAT$="KL":LSET MD$="":PUT#2,RD%+I:NEXT:DA%(DT%)=0:RETURN
  160. 161  GOSUB 162:NUM%=VAL(XP$):RETURN
  161. 162  XP$="":GOSUB 106
  162. 163  LTR$=INKEY$:IF LTR$=""GOTO 163
  163. 164  IF LEN(LTR$)>1 AND ASC(RIGHT$(LTR$,1))=67 THEN XP$="99":RETURN
  164. 165  IF LEN(XP$)=0 AND LTR$=CHR$(8)GOTO 163
  165. 166  IF LTR$=CHR$(8)THEN XP$=LEFT$(XP$,LEN(XP$)-1):GOTO 170
  166. 167  IF LTR$=CHR$(13)THEN RETURN
  167. 168  IF ASC(LTR$)<48 OR ASC(LTR$)>57 THEN GOSUB 172:GOTO 163
  168. 169  XP$=XP$+LTR$:LOCATE ROW%,COL%+LEN(XP$)-1:COLOR CLR,0:PRINT LTR$;:IF LEN(XP$)>2 THEN 171 ELSE 163
  169. 170  LOCATE ROW%,COL%:COLOR CLR,0:PRINT XP$;:COLOR CA,CB:PRINT" ";:COLOR CLR,0:GOTO 163
  170. 171  COLOR CLR,0:RETURN
  171. 172  LOCATE 24,60:COLOR CA,CB:PRINT"INPUT ERROR";:BEEP:GOSUB 107:LOCATE 24,60:PRINT SPC(11);:COLOR CLR,0:RETURN
  172. 173  DG$="":FOR I=1 TO 10:DA$=STR$(DA%(I)+10000):DA$=RIGHT$(DA$,4):DG$=DG$+DA$:NEXT:LSET TAG$=CHR$(128):LSET DAT$="00":LSET MD$=DG$:PUT#2,1:DG$="":FOR I=11 TO 20:DA$=STR$(DA%(I)+10000)
  173. 174  DA$=RIGHT$(DA$,4):DG$=DG$+DA$:NEXT:LSET TAG$=CHR$(128):LSET DAT$="00":LSET MD$=DG$:PUT#2,2:DG$="":FOR I=21 TO 30:DA$=STR$(DA%(I)+10000):DA$=RIGHT$(DA$,4):DG$=DG$+DA$:NEXT
  174. 175  LSET TAG$=CHR$(128):LSET DAT$="00":LSET MD$=DG$:PUT#2,3:DG$=STR$(DA%(31)+10000):DG$=RIGHT$(DG$,4):HB$=STR$(HB%+10000):HB$=RIGHT$(HB$,4):DG$=DG$+HB$:LSET TAG$=CHR$(128):LSET DAT$="00
  175. 176  LSET MD$=DG$:PUT#2,4:RETURN
  176. 177  GOSUB 106
  177. 178  V$=INKEY$:IF V$=""GOTO 178
  178. 179  IF V$="Y"OR V$="y"THEN V$="Y":RETURN
  179. 180  IF V$="N"OR V$="n"THEN V$="N":RETURN
  180. 181  BEEP:GOTO 177
  181. 182  COLOR CA,CB:LOCATE 24,1:PRINT SPC(79);:LOCATE 25,1:PRINT SPC(79);:COLOR CLR,0:RETURN
  182. 183  FOR J=1 TO 23:LOCATE J,36:COLOR CA,CB:PRINT SPC(2):NEXT:J=1:FOR I=1 TO 20:N=N+1:J=J+1:LOCATE J,36:PRINT USING"##";N;:NEXT:LOCATE 1,1:PRINT"         PERSONAL DATEBOOK             (c) 1984 by LATERAL PROGRAMMING, INC.   ";
  183. 184  LOCATE 9,1:PRINT SPC(35):COLOR CLR,0:RETURN
  184. 185  LSET TAG$=CHR$(128):LSET DAT$=CHR$(27)+"Z":LSET MD$="":PUT#2,HB%+1:GOSUB 173:CLOSE:COLOR CA,CB:LOCATE 1,1:PRINT SPC(35):COLOR CLR,0:GOSUB 182:GOSUB 103:GOSUB 102:GOTO 21
  185. 186  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"INPUT ERROR  PLEASE CHOOSE AGAIN";:BEEP:COLOR CLR,0:GOSUB 107:RETURN
  186. 187  LOCATE 1,38:COLOR CA,CB:PRINT SPC(41):GOSUB 182:LOCATE 24,1:PRINT"MEMO FULL (LIMIT IS 20 LINES)";:COLOR CLR,0:BEEP:GOSUB 107:RETURN
  187. 188  LOCATE 1,38:COLOR CA,CB:PRINT"     MEMOS FOR "MO$" "DT$", "Y%"            ";:COLOR CLR,0:GOSUB 105:FOR I=1 TO L%:LOCATE I+1,39:PRINT DB$(I):NEXT:RETURN
  188. 189  IF LEFT$(MY$,3)="JAN"THEN M=1
  189. 190  IF LEFT$(MY$,3)="FEB"THEN M=2
  190. 191  IF LEFT$(MY$,3)="MAR"THEN M=3
  191. 192  IF LEFT$(MY$,3)="APR"THEN M=4
  192. 193  IF LEFT$(MY$,3)="MAY"THEN M=5
  193. 194  IF LEFT$(MY$,3)="JUN"THEN M=6
  194. 195  IF LEFT$(MY$,3)="JUL"THEN M=7
  195. 196  IF LEFT$(MY$,3)="AUG"THEN M=8
  196. 197  IF LEFT$(MY$,3)="SEP"THEN M=9
  197. 198  IF LEFT$(MY$,3)="OCT"THEN M=10
  198. 199  IF LEFT$(MY$,3)="NOV"THEN M=11
  199. 200  IF LEFT$(MY$,3)="DEC"THEN M=12
  200. 201  Y=1900+VAL(RIGHT$(MY$,2)):IF Y/4-INT(Y/4)=0 AND Y/100-INT(Y/100)<>0 THEN LY=1
  201. 202  D=1:M=1:GOSUB 250:H$(1)="JAN 1 : New Year's Day":H$(4)="FEB 2 : Groundhog Day":H$(5)="FEB12 : Lincoln's Birthday":M=2:ZW=2:D=1
  202. 203  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 203
  203. 204  D=D+14:H$(7)="FEB"+RIGHT$(STR$(D),2)+" : Washington's Birthday":H$(6)="FEB14 : Valentine's Day":GOSUB 225:D=D-46:IF M=4 THEN D=D+31:M=3:GOTO 207
  204. 205  IF LY=1 AND M=3 THEN D=D+29:M=2:GOTO 207
  205. 206  IF M=3 THEN D=D+28:M=2
  206. 207  IF LY=1 AND D<1 THEN D=D+29:M=3:GOTO 209
  207. 208  IF D<1 THEN D=D+28:M=2
  208. 209  GOSUB 238:H$(8)=M$+RIGHT$(STR$(D),2)+" : Ash Wednesday":H$(9)="MAR17 : Saint Patrick's Day":GOSUB 225:MX=M:DF=D-2:IF DF<1 THEN M=M-1:DF=DF-31
  209. 210  GOSUB 238:H$(10)=M$+RIGHT$(STR$(DF),2)+" : Good Friday":M=MX:H$(11)=M$+RIGHT$(STR$(D),2)+" : Easter Sunday":M=5:ZW=1:D=1
  210. 211  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 211
  211. 212  D=D+7:H$(12)="MAY"+RIGHT$(STR$(D),2)+" : Mother's Day":D=1:M=5:ZW=2
  212. 213  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 213
  213. 214  D=D+28:IF D>31 THEN D=D-7
  214. 215  H$(13)="MAY"+RIGHT$(STR$(D),2)+" : Memorial Day":H$(15)="JUN14 : Flag Day":M=6:ZW=1:D=1
  215. 216  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 216
  216. 217  D=D+14:H$(16)="JUN"+RIGHT$(STR$(D),2)+" : Father's Day":H$(17)="JUL 4 : Independence Day":M=9:ZW=2:D=1
  217. 218  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 218
  218. 219  H$(18)="SEP"+RIGHT$(STR$(D),2)+" : Labor Day":M=10:ZW=2:D=1
  219. 220  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 220
  220. 221  D=D+7:H$(19)="OCT"+RIGHT$(STR$(D),2)+" : Columbus Day":H$(20)="OCT31 : Halloween":D=D-9:IF D<2 THEN D=D+7
  221. 222  H$(21)="NOV"+RIGHT$(STR$(D),2)+" : Election Day":H$(22)="NOV11 : Veterans Day":M=11:ZW=5:D=1
  222. 223  GOSUB 251:IF Z<>ZW THEN D=D+1:GOTO 223
  223. 224  D=D+21:H$(23)="NOV"+RIGHT$(STR$(D),2)+" : Thanksgiving Day":H$(24)="DEC25 : Christmas Day":H$(25)="DEC26 : Boxing Day":H$(26)="AUGThere are no holidays in "+MY$:GOTO 252
  224. 225  N=Y-1900:A=N/19:A=19*(A-INT(A)):B=INT((7*A+1)/19):M=0:M=(11*A+4.00001-B)/29:X=M-INT(M):IF X=1 THEN 228
  225. 226  IF X<>1 THEN M=29*X
  226. 227  GOTO 229
  227. 228  M=0
  228. 229  Q=INT(N/4):W=(N+Q+31-M)/7:W=7*(W-INT(W)):W=INT(W):DE=INT(25-M-W):IF DE>0 THEN M=4
  229. 230  IF DE<0 THEN M=3
  230. 231  IF DE=0 THEN M=3:D=31
  231. 232  IF DE<-9 THEN DE=DE+9:GOTO 232
  232. 233  IF DE<0 THEN D=31-ABS(DE)
  233. 234  IF DE>0 THEN D=DE
  234. 235  IF Y=1974 OR Y=1984 THEN D=D+7
  235. 236  IF Y=1994 THEN D=D+7-31:M=4
  236. 237  RETURN
  237. 238  IF M=1 THEN M$="JAN":RETURN
  238. 239  IF M=2 THEN M$="FEB":RETURN
  239. 240  IF M=3 THEN M$="MAR":RETURN
  240. 241  IF M=4 THEN M$="APR":RETURN
  241. 242  IF M=5 THEN M$="MAY":RETURN
  242. 243  IF M=6 THEN M$="JUN":RETURN
  243. 244  IF M=7 THEN M$="JUL":RETURN
  244. 245  IF M=8 THEN M$="AUG":RETURN
  245. 246  IF M=9 THEN M$="SEP":RETURN
  246. 247  IF M=10 THEN M$="OCT":RETURN
  247. 248  IF M=11 THEN M$="NOV":RETURN
  248. 249  IF M=12 THEN M$="DEC":RETURN
  249. 250  IF HY=1 THEN 251
  250. 251  Q=M:E=D:K=INT(0.6+(1/Q)):L=Y-K:O=Q+12*K:P=L/100:Z1=INT(P/4):Z2=INT(P):Z3=INT((5*L)/4):Z4=INT(13*(O+1)/5):Z=Z4+Z3-Z2+Z1+E-1:Z=Z-(7*INT(Z/7))+1:RETURN
  251. 252  LOCATE 11,1:COLOR 4,0:PRINT"HOLIDAYS FOR "MY$" ARE:";:I=13:FOR X=1 TO 30:IF LEFT$(H$(X),3)=LEFT$((MY$),3)THEN LOCATE I,1:PRINT MID$(H$(X),4);
  252. 253  IF LEFT$(H$(X),3)<>LEFT$((MY$),3)THEN I=I ELSE I=I+1
  253. 254  NEXT:RETURN
  254. 255  IF FD$="KILLED"GOTO 269
  255. 256  DEFINT I,J:OPEN FB$ AS #2 LEN=43:FIELD #2,1 AS TAG$,2 AS DAT$,40 AS MD$:J=5:FOR DT%=1 TO ND%:TA%(DT%)=0:IF DA%(DT%)=0 GOTO 265
  256. 257  DT$=RIGHT$(STR$(DT%),2):TA%(DT%)=J:FOR I=0 TO 19:GET#2,DA%(DT%)+I:IF TAG$<>CHR$(128)GOTO 264
  257. 258  IF DAT$="KL"GOTO 264
  258. 259  IF VAL(DAT$)<1 GOTO 264
  259. 260  IF VAL(DAT$)>ND%GOTO 264
  260. 261  IF MD$=""GOTO 264
  261. 262  IF VAL(DAT$)<>DT%THEN I=19:GOTO 264
  262. 263  MC$(J)=TAG$+DAT$+MD$:J=J+1
  263. 264  NEXT
  264. 265  NEXT:HB%=J-1:CLOSE:OPEN "SAVIT" AS #2 LEN=43:FIELD #2, 43 AS NC$:FOR I=5 TO HB%:LSET NC$=MC$(I):PUT#2,I:NEXT:DG$="":FOR I=1 TO 10:DA$=STR$(TA%(I)+10000):DA$=RIGHT$(DA$,4):DG$=DG$+DA$:NEXT
  265. 266  LSET NC$=CHR$(128)+"00"+DG$:PUT#2,1:DG$="":FOR I=11 TO 20:DA$=STR$(TA%(I)+10000):DA$=RIGHT$(DA$,4):DG$=DG$+DA$:NEXT:LSET NC$=CHR$(128)+"00"+DG$:PUT#2,2:DG$="
  266. 267  FOR I=21 TO 30:DA$=STR$(TA%(I)+10000):DA$=RIGHT$(DA$,4):DG$=DG$+DA$:NEXT:LSET NC$=CHR$(128)+"00"+DG$:PUT#2,3:DG$=STR$(TA%(31)+10000):DG$=RIGHT$(DG$,4):HB$=STR$(HB%+10000)
  267. 268  HB$=RIGHT$(HB$,4):DG$=DG$+HB$:LSET NC$=CHR$(128)+"00"+DG$:PUT#2,4:LSET NC$=CHR$(128)+CHR$(27)+"Z"+STRING$(40,0):PUT#2,HB%+1:CLOSE:KILL FB$:NAME "SAVIT" AS FB$
  268. 269  GOSUB 509:SYSTEM:END
  269. 270  V1$="ADDRESS.DAT":V2$="ADDRESS.ISI":RL%=255:KL=14:T=19:HE$=CHR$(11):SA%=INT(255/(KL+6)):BA$=STRING$(79,32):RC=28:DC=31:RB$=CHR$(46)+CHR$(29):SB$=CHR$(219)+CHR$(29):BS$=CHR$(29)+CHR$(46)+CHR$(29):FF$=CHR$(140)
  270. 271  DEF FNCRT$(E1,E2)=HE$+STRING$(E2,DC)+STRING$(E1,RC):D$=CHR$(94)+STRING$(KL,32):A%=INT(255/(KL+6)):CLOSE 1:OPEN "R",1,V1$,RL%:CLOSE 4:OPEN "R",4,V2$,242:FIELD 1,RL% AS FR$:FIELD 4,242 AS KS$:GOSUB 102:FL(1)=14:CX(1)=20:CY(1)=10:TY$(1)="A
  271. 272  FL(2)=14:CX(2)=20:CY(2)=11:TY$(2)="A":FL(3)=14:CX(3)=20:CY(3)=12:TY$(3)="A":FL(4)=26:CX(4)=8:CY(4)=13:TY$(4)="A":FL(5)=26:CX(5)=8:CY(5)=14:TY$(5)="A":FL(6)=26:CX(6)=8:CY(6)=15:TY$(6)="A":FL(7)=2:CX(7)=8:CY(7)=16:TY$(7)="A
  272. 273  FL(8)=5:CX(8)=29:CY(8)=16:TY$(8)="A":FL(9)=8:CX(9)=11:CY(9)=17:TY$(9)="A":FL(10)=3:CX(10)=22:CY(10)=17:TY$(10)="A":FL(11)=3:CX(11)=26:CY(11)=17:TY$(11)="A":FL(12)=4:CX(12)=30:CY(12)=17:TY$(12)="A":FL(13)=8:CX(13)=11:CY(13)=18:TY$(13)="A
  273. 274  FL(14)=3:CX(14)=22:CY(14)=18:TY$(14)="A":FL(15)=3:CX(15)=26:CY(15)=18:TY$(15)="A":FL(16)=4:CX(16)=30:CY(16)=18:TY$(16)="A":FL(17)=24:CX(17)=10:CY(17)=19:TY$(17)="A":FL(18)=34:CX(18)=0:CY(18)=20:TY$(18)="A":FL(19)=34:CX(19)=0:CY(19)=21:TY$(19)="A
  274. 275  COLOR 4,0:ON ERROR GOTO 444
  275. 276  LOCATE 11,1:PRINT"LAST NAME:          ..............":LOCATE 12,1:PRINT"FIRST NAME:         ..............":LOCATE 13,1:PRINT"MIDDLE NAME:        ..............":LOCATE 14,1:PRINT"COMPANY:..........................
  276. 277  LOCATE 15,1:PRINT"STREET: ..........................":LOCATE 16,1:PRINT"CITY:   ..........................":LOCATE 17,1:PRINT"STATE:  ..         ZIP CODE: .....":LOCATE 18,1:PRINT"PHONE #1: (........)  ...-...-....
  277. 278  LOCATE 19,1:PRINT"PHONE #2: (........)  ...-...-....":LOCATE 20,1:PRINT"COMMENTS: ........................":LOCATE 21,1:PRINT"..................................":LOCATE 22,1:PRINT"..................................":COLOR CLR,0:UA$="
  278. 279  FOR X=1 TO T:F$(X)="":F#(X)=0:NEXT
  279. 280  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ADDRESS MENU:                                    <F8> MEMO MENU  <F9> MAIN MENU";
  280. 281  LOCATE 25,1:COLOR CA,CB:PRINT"<F1> ADD RECORD  <F2> GET RECORD  <F3> SEARCH                                  ";:COLOR CLR,0:TY$="A":FL=1:GOSUB 142:IF FK%=59 THEN 287
  281. 282  IF FK%=60 THEN UA$="YES":GOTO 382
  282. 283  IF FK%=67 THEN GOSUB 102:CLOSE 1:CLOSE 4:GOTO 28
  283. 284  IF FK%=61 THEN 370
  284. 285  IF FK%=66 THEN CLOSE 1:CLOSE 4:GOTO 44
  285. 286  GOSUB 186:GOTO 280
  286. 287  GOSUB 182:COLOR CA,CB:LOCATE 24,1:PRINT"ENTER THE '<' KEY AT BEGINNING OF FIELD TO BACK UP TO PREVIOUS FIELD";:COLOR CLR,0:LOCATE 12,1
  287. 288  PRINT FNCRT$(20,10);"";:FL=14:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 291
  288. 289  IF ASC(T$)=60 THEN 275
  289. 290  F$(1)=T$
  290. 291  F$(1)=F$(1)+STRING$(14-LEN(F$(1)),32):PRINT FNCRT$(20,10);F$(1);:K$=F$(1)
  291. 292  PRINT FNCRT$(20,11);"";:FL=14:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 295
  292. 293  IF ASC(T$)=60 THEN 288
  293. 294  F$(2)=T$
  294. 295  F$(2)=F$(2)+STRING$(14-LEN(F$(2)),32):PRINT FNCRT$(20,11);F$(2);
  295. 296  PRINT FNCRT$(20,12);"";:FL=14:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 299
  296. 297  IF ASC(T$)=60 THEN 292
  297. 298  F$(3)=T$
  298. 299  F$(3)=F$(3)+STRING$(14-LEN(F$(3)),32):PRINT FNCRT$(20,12);F$(3);
  299. 300  PRINT FNCRT$(8,13);"";:FL=26:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 303
  300. 301  IF ASC(T$)=60 THEN 296
  301. 302  F$(4)=T$
  302. 303  F$(4)=F$(4)+STRING$(26-LEN(F$(4)),32):PRINT FNCRT$(8,13);F$(4);
  303. 304  PRINT FNCRT$(8,14);"";:FL=26:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 307
  304. 305  IF ASC(T$)=60 THEN 300
  305. 306  F$(5)=T$
  306. 307  F$(5)=F$(5)+STRING$(26-LEN(F$(5)),32):PRINT FNCRT$(8,14);F$(5);
  307. 308  PRINT FNCRT$(8,15);"";:FL=26:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 311
  308. 309  IF ASC(T$)=60 THEN 304
  309. 310  F$(6)=T$
  310. 311  F$(6)=F$(6)+STRING$(26-LEN(F$(6)),32):PRINT FNCRT$(8,15);F$(6);
  311. 312  PRINT FNCRT$(8,16);"";:FL=2:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 315
  312. 313  IF ASC(T$)=60 THEN 308
  313. 314  F$(7)=T$
  314. 315  F$(7)=F$(7)+STRING$(2-LEN(F$(7)),32):PRINT FNCRT$(8,16);F$(7);
  315. 316  PRINT FNCRT$(29,16);"";:FL=5:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 319
  316. 317  IF ASC(T$)=60 THEN 312
  317. 318  F$(8)=T$
  318. 319  F$(8)=F$(8)+STRING$(5-LEN(F$(8)),32):PRINT FNCRT$(29,16);F$(8);
  319. 320  PRINT FNCRT$(11,17);"";:FL=8:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 323
  320. 321  IF ASC(T$)=60 THEN 316
  321. 322  F$(9)=T$
  322. 323  F$(9)=F$(9)+STRING$(8-LEN(F$(9)),32):PRINT FNCRT$(11,17);F$(9);:R$="
  323. 324  PRINT FNCRT$(22,17);"";:FL=3:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 327
  324. 325  IF ASC(T$)=60 THEN 320
  325. 326  F$(10)=T$
  326. 327  F$(10)=F$(10)+STRING$(3-LEN(F$(10)),32):PRINT FNCRT$(22,17);F$(10);
  327. 328  PRINT FNCRT$(26,17);"";:FL=3:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 331
  328. 329  IF ASC(T$)=60 THEN 324
  329. 330  F$(11)=T$
  330. 331  F$(11)=F$(11)+STRING$(3-LEN(F$(11)),32):PRINT FNCRT$(26,17);F$(11);
  331. 332  PRINT FNCRT$(30,17);"";:FL=4:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 335
  332. 333  IF ASC(T$)=60 THEN 328
  333. 334  F$(12)=T$
  334. 335  F$(12)=F$(12)+STRING$(4-LEN(F$(12)),32):PRINT FNCRT$(30,17);F$(12);
  335. 336  PRINT FNCRT$(11,18);"";:FL=8:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 339
  336. 337  IF ASC(T$)=60 THEN 332
  337. 338  F$(13)=T$
  338. 339  F$(13)=F$(13)+STRING$(8-LEN(F$(13)),32):PRINT FNCRT$(11,18);F$(13);
  339. 340  PRINT FNCRT$(22,18);"";:FL=3:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 343
  340. 341  IF ASC(T$)=60 THEN 336
  341. 342  F$(14)=T$
  342. 343  F$(14)=F$(14)+STRING$(3-LEN(F$(14)),32):PRINT FNCRT$(22,18);F$(14);
  343. 344  PRINT FNCRT$(26,18);"";:FL=3:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 347
  344. 345  IF ASC(T$)=60 THEN 340
  345. 346  F$(15)=T$
  346. 347  F$(15)=F$(15)+STRING$(3-LEN(F$(15)),32):PRINT FNCRT$(26,18);F$(15);
  347. 348  PRINT FNCRT$(30,18);"";:FL=4:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 351
  348. 349  IF ASC(T$)=60 THEN 344
  349. 350  F$(16)=T$
  350. 351  F$(16)=F$(16)+STRING$(4-LEN(F$(16)),32):PRINT FNCRT$(30,18);F$(16);
  351. 352  PRINT FNCRT$(10,19);"";:FL=24:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 355
  352. 353  IF ASC(T$)=60 THEN 348
  353. 354  F$(17)=T$
  354. 355  F$(17)=F$(17)+STRING$(24-LEN(F$(17)),32):PRINT FNCRT$(10,19);F$(17);
  355. 356  PRINT FNCRT$(0,20);"";:FL=34:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 359
  356. 357  IF ASC(T$)=60 THEN 352
  357. 358  F$(18)=T$
  358. 359  F$(18)=F$(18)+STRING$(34-LEN(F$(18)),32):PRINT FNCRT$(0,20);F$(18);:PRINT FNCRT$(0,21);"";:FL=34:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 362
  359. 360  IF ASC(T$)=60 THEN 356
  360. 361  F$(19)=T$
  361. 362  F$(19)=F$(19)+STRING$(34-LEN(F$(19)),32):PRINT FNCRT$(0,21);F$(19);:R$=R$+F$(1):R$=R$+F$(2):R$=R$+F$(3):R$=R$+F$(4):R$=R$+F$(5):R$=R$+F$(6):R$=R$+F$(7):R$=R$+F$(8):R$=R$+F$(9):R$=R$+F$(10):R$=R$+F$(11):R$=R$+F$(12):R$=R$+F$(13):R$=R$+F$(14)
  362. 363  R$=R$+F$(15):R$=R$+F$(16):R$=R$+F$(17):R$=R$+F$(18):R$=R$+F$(19):IF UA$="YES"THEN 369
  363. 364  X=0:IF INT(LOF(4)/240)=0 THEN 367
  364. 365  X=X+1:GET 4,X:IF INSTR(KS$,D$)<>0 THEN 368
  365. 366  IF INT(LOF(4)/240)=X THEN 367 ELSE 365
  366. 367  X=X+1:KR$="":FOR Y=1 TO A%:KR$=KR$+CHR$(94)+STRING$(KL,32):G$=STR$(INT(LOF(4)/240)*A%+Y):KR$=KR$+STRING$(5-LEN(G$),32)+G$:NEXT:LSET KS$=KR$:PUT 4,X:LSET FR$=STRING$(RL%,0):FOR Y=1 TO A%:PUT 1,(INT(LOF(4)/240)-1)*A%+Y:NEXT
  367. 368  KR$=KS$:P=INSTR(KR$,D$):KB=X
  368. 369  K$=CHR$(94)+K$:KR$=MID$(KR$,1,P-1)+K$+MID$(KR$,P+LEN(K$),LEN(KR$)):LR%=VAL(MID$(KR$,P+LEN(K$),5)):LSET FR$=R$:PUT 1,LR%:LSET KS$=KR$:PUT 4,KB:GOTO 275
  369. 370  X=0:UA$="S":GOSUB 182:LOCATE 25,1:COLOR CA,CB:LOCATE 24,1:PRINT"SEARCH FOR ? - ";:COLOR CLR,0:FL=30:TY$="A":GOSUB 404:Q$=T$:GOSUB 182:LOCATE 25,1:COLOR CA,CB:LOCATE 24,1:PRINT"PRESS ANY KEY TO STOP SEARCH ";:COLOR CLR,0:FL=1:TY$="A
  370. 371  FOR X=1 TO INT(LOF(1)/RL%):GET 1,X:IF INSTR(FR$,Q$)<>0 AND FR$<>STRING$(RL%,0)THEN 374
  371. 372  IF INKEY$<>""THEN 275
  372. 373  NEXT:GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"END OF FILE";:COLOR CLR,0:BEEP:GOSUB 107:GOTO 275
  373. 374  GOSUB 387
  374. 375  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"SEARCH FOR RECORD:            <F7> ADDRESS MENU  <F8> MEMO MENU  <F9> MAIN MENU";:LOCATE 25,1:PRINT"             <F2> NEXT               <F4> PRINT ADDRESS                        ";:COLOR 2,0
  375. 376  TY$="A":GOSUB 142:IF FK%=60 THEN 373
  376. 377  IF FK%=66 THEN CLOSE 1:CLOSE 4:GOTO 44
  377. 378  IF FK%=67 THEN GOSUB 102:CLOSE 1:CLOSE 4:GOTO 28
  378. 379  IF FK%=65 THEN 275
  379. 380  IF FK%=62 THEN GOSUB 414:GOTO 375
  380. 381  GOSUB 186:GOTO 375
  381. 382  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ENTER LAST NAME";:COLOR CLR,0:FL=14:LOCATE 11,21:PRINT STRING$(14,46);:LOCATE 11,21:TY$="A":GOSUB 404:IF LEN(T$)=0 THEN 275
  382. 383  K$=T$:K$=CHR$(94)+K$:P=0:KB=1
  383. 384  FOR X=KB TO INT(LOF(4)/240):GET 4,X:IF INSTR(P+1,KS$,K$)=0 THEN P=0:NEXTELSE 386
  384. 385  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"END OF FILE";:COLOR CLR,0:BEEP:GOSUB 107:GOTO 275
  385. 386  KR$=KS$:KB=X:P=INSTR(P+1,KR$,K$):LR%=VAL(MID$(KR$,P+15,5)):GET 1,LR%
  386. 387  F$(1)=MID$(FR$,1,14):F$(2)=MID$(FR$,15,14):F$(3)=MID$(FR$,29,14):F$(4)=MID$(FR$,43,26):F$(5)=MID$(FR$,69,26):F$(6)=MID$(FR$,95,26):F$(7)=MID$(FR$,121,2):F$(8)=MID$(FR$,123,5):F$(9)=MID$(FR$,128,8):F$(10)=MID$(FR$,136,3):F$(11)=MID$(FR$,139,3)
  387. 388  F$(12)=MID$(FR$,142,4):F$(13)=MID$(FR$,146,8):F$(14)=MID$(FR$,154,3):F$(15)=MID$(FR$,157,3):F$(16)=MID$(FR$,160,4):F$(17)=MID$(FR$,164,24):F$(18)=MID$(FR$,188,34):F$(19)=MID$(FR$,222,34):LOCATE 11,21:PRINT F$(1);:LOCATE 12,21:PRINT F$(2);
  388. 389  LOCATE 13,21:PRINT F$(3);:LOCATE 14,9:PRINT F$(4);:LOCATE 15,9:PRINT F$(5);:LOCATE 16,9:PRINT F$(6);:LOCATE 17,9:PRINT F$(7);:LOCATE 17,30:PRINT F$(8);:LOCATE 18,12:PRINT F$(9);:LOCATE 18,23:PRINT F$(10);:LOCATE 18,27:PRINT F$(11);
  389. 390  LOCATE 18,31:PRINT F$(12);:LOCATE 19,12:PRINT F$(13);:LOCATE 19,23:PRINT F$(14);:LOCATE 19,27:PRINT F$(15);:LOCATE 19,31:PRINT F$(16);:LOCATE 20,11:PRINT F$(17);:LOCATE 21,1:PRINT F$(18);:LOCATE 22,1:PRINT F$(19);:IF UA$="S"THEN RETURN
  390. 391  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"GET A RECORD                  <F7> ADDRESS MENU  <F8> MEMO MENU  <F9> MAIN MENU";:LOCATE 25,1:PRINT"<F1> CHANGE  <F2> NEXT  <F3> DELETE  <F4> PRINT ADDRESS                        ";:COLOR CLR,0:TY$="A
  391. 392  GOSUB 142:IF FK%=59 THEN 287
  392. 393  IF FK%=66 THEN CLOSE 1:CLOSE 4:GOTO 44
  393. 394  IF FK%=67 THEN GOSUB 102:CLOSE 1:CLOSE 4:GOTO 28
  394. 395  IF FK%=60 THEN RE$="G":GOTO 384
  395. 396  IF FK%=61 THEN 400
  396. 397  IF FK%=65 THEN 275
  397. 398  IF FK%=62 THEN GOSUB 414:GOTO 391
  398. 399  GOSUB 186:GOTO 391
  399. 400  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ARE YOU SURE YOU WANT TO DELETE (Y/N) ";:COLOR 2,0
  400. 401  GOSUB 177:IF V$="N"THEN GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"NOT DELETED";:COLOR CLR,0:GOSUB 107:GOTO 275
  401. 402  IF V$<>"Y"THEN 401
  402. 403  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"DELETED";:COLOR CLR,0:K$=MID$(D$,2,LEN(D$)):R$=STRING$(RL%,0):GOTO 369
  403. 404  COLOR CLR,0:LOCATE,,1:T$="":PX=POS(0):PY=CSRLIN
  404. 405  A$=INKEY$:IF A$=""THEN 405
  405. 406  IF LEN(T$)<FL THEN PRINT RB$;
  406. 407  IF ASC(A$)=8 AND LEN(T$)>0 THEN PRINT BS$;:T$=LEFT$(T$,LEN(T$)-1):GOTO 405
  407. 408  IF ASC(A$)=13 THEN 413
  408. 409  IF ASC(A$)<32 OR ASC(A$)>127 THEN 405
  409. 410  T$=T$+A$:IF LEN(T$)=1 THEN LOCATE PY,PX:PRINT STRING$(FL,".");:LOCATE PY,PX
  410. 411  IF LEN(T$)>FL THEN T$=MID$(T$,1,LEN(T$)-1):BEEP:GOTO 405
  411. 412  PRINT A$;:GOTO 405
  412. 413  COLOR CLR,0:LOCATE,,0:RETURN
  413. 414  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ENTER OFFSET IN SPACES FROM LEFT MARGIN (0-50):";:COLOR CLR,0:ROW%=24:COL%=50:COLOR CLR,0:GOSUB 161:IF NUM%>50 THEN GOSUB 186:GOTO 414
  414. 415  OA%=NUM%
  415. 416  GOSUB 182:LOCATE 24,1:COLOR CA,CB:PRINT"ENTER NUMBER OF BLANK LINES AFTER ADDRESS (1-70):";:COLOR CLR,0:ROW%=24:COL%=52:COLOR CLR,0:GOSUB 161:IF NUM%<1 OR NUM%>70 THEN GOSUB 186:GOTO 416
  416. 417  SC%=NUM%:LOCATE 24,1:COLOR CA,CB:PRINT"MAKE SURE PRINTER IS READY THEN PRESS ANY KEY TO PRINT ADDRESS                 ";:COLOR CLR,0:GOSUB 106
  417. 418  IF INKEY$=""THEN 418
  418. 419  P$(1)=MID$(FR$,15,14)
  419. 420  IF RIGHT$(P$(1),1)=" "THEN P$(1)=LEFT$(P$(1),LEN(P$(1))-1):GOTO 420
  420. 421  P$(2)=MID$(FR$,29,14)
  421. 422  IF RIGHT$(P$(2),1)=" "THEN P$(2)=LEFT$(P$(2),LEN(P$(2))-1):GOTO 422
  422. 423  P$(3)=MID$(FR$,1,14)
  423. 424  IF RIGHT$(P$(3),1)=" "THEN P$(3)=LEFT$(P$(3),LEN(P$(3))-1):GOTO 424
  424. 425  P$(4)=MID$(FR$,43,26):P$(5)=MID$(FR$,69,26):P$(6)=MID$(FR$,95,26)
  425. 426  IF RIGHT$(P$(6),1)=" "THEN P$(6)=LEFT$(P$(6),LEN(P$(6))-1):GOTO 426
  426. 427  P$(7)=MID$(FR$,121,2):P$(8)=MID$(FR$,123,5):ON ERROR GOTO 429
  427. 428  LPRINT TAB(OA%);P$(1)+" "+P$(2)+" "+P$(3):LPRINT TAB(OA%);P$(4):LPRINT TAB(OA%);P$(5):LPRINT TAB(OA%);P$(6)+", "+P$(7)+"  "+P$(8):FOR I=1 TO SC%:LPRINT:NEXT:ON ERROR GOTO 444
  428. 429  RETURN
  429. 430  DEF SEG=&HB000:MA%=0:MI%=PEEK(0):POKE 0,0:MJ%=PEEK(0):POKE 0,255:IF MJ%=0 AND PEEK(0)=255 THEN MA%=2
  430. 431  POKE 0,MI%:DEF SEG=&HB800:MI%=PEEK(0):POKE 0,0:MJ%=PEEK(0):POKE 0,255:IF MJ%=0 AND PEEK(0)=255 THEN MA%=MA%+1
  431. 432  POKE 0,MI%:DEF SEG:RETURN
  432. 433  CLS:LOCATE 10,14:COLOR 4,0:PRINT"YOU HAVE BOTH COLOR AND MONOCHROME ADAPTERS INSTALLED":LOCATE 12,14:PRINT"DO YOU WANT THE COLOR (C) OR MONOCHROME (M) DISPLAY?
  433. 434  LOCATE 14,16:COLOR 12,0:PRINT"CAUTION:  If you switch to a nonexistant monitor":LOCATE 15,19:PRINT"you will have to reboot to regain display!";:COLOR CLR,0:GOSUB 106
  434. 435  RS$=INKEY$:IF RS$=""GOTO 435
  435. 436  IF RS$="C"OR RS$="c"THEN SD%=0:GOSUB 439:CA=4:CB=14:GOTO 15
  436. 437  IF RS$="M"OR RS$="m"THEN SD%=1:GOSUB 439:CA=0:CB=7:GOTO 15
  437. 438  BEEP:GOTO 435
  438. 439  IF SD%<>0 AND SD%<>1 THEN RETURN
  439. 440  IF SD%=0 THEN 442
  440. 441  KEY OFF:DEF SEG=0:SE%=PEEK(&H410):POKE &H410,SE%OR &H30:SCREEN 0,0,0:WIDTH 40:WIDTH 80:LOCATE,,1,12,13:DEF SEG:RETURN
  441. 442  DEF SEG=0:SE%=PEEK(&H410):POKE &H410,(SE%AND &HCF)OR &H20:SCREEN 0,0,0:WIDTH 40:WIDTH 80:LOCATE,,1,6,7:DEF SEG:RETURN
  442. 443  DEF SEG=&H0:POKE &H6C,&H53:POKE &H6D,&HFF:POKE &H6E,&H0:POKE &H6F,&HF0:DEF SEG:RETURN
  443. 444  REM
  444. 445  BEEP:BEEP:BEEP:BEEP:IF ERR=71 THEN CLS:COLOR CA,CB:LOCATE 10,29:PRINT" DISK NOT READY ERROR ";:COLOR CLR,0:LOCATE 12,17:PRINT"PERSONAL DATEBOOK MUST REMAIN IN DEFAULT DRIVE";:LOCATE 14,25:PRINT"INSERT DISK THEN RERUN PROGRAM";:GOTO 450
  445. 446  IF ERR=57 THEN CLS:COLOR CA,CB:LOCATE 10,23:PRINT" DEVICE I/O (INPUT/OUTPUT)  ERROR ";:COLOR CLR,0:LOCATE 12,8:PRINT" MIGHT BE BAD DISK:  TRY RUNNING PROGRAM AGAIN WITH BACKUP DISK ";:GOTO 450
  446. 447  IF ERR=61 THEN CLS:COLOR CA,CB:LOCATE 10,23:PRINT" DISK FULL ERROR:  CANNOT RECOVER ";:COLOR CLR,0:LOCATE 12,18:PRINT" DELETE UNNECESSARY FILES AND RERUN PROGRAM ";:GOTO 450
  447. 448  IF ERR=70 THEN CLOSE:CLS:COLOR CA,CB:LOCATE 10,25:PRINT" YOUR DISK IS WRITE PROTECTED ";:COLOR CLR,0:LOCATE 12,18:PRINT" REMOVE WRITE PROTECT TAB AND RERUN PROGRAM ";:GOTO 450
  448. 449  CLS:COLOR CA,CB:LOCATE 10,29:PRINT" UNRECOVERABLE  ERROR ";:COLOR CLR,0:LOCATE 12,9:PRINT" ERROR IS"ERR"/"ERL" CONTACT LATERAL PROGRAMMING FOR ADVICE ";
  449. 450  LOCATE 18,26:PRINT"PRESS ANY KEY TO END PROGRAM":GOSUB 106
  450. 451  IF INKEY$=""THEN 451
  451. 452  SYSTEM:END
  452. 500  'FREEWARE MESSAGE
  453. 501  LOCATE 13,1:COLOR 7,0:PRINT "PERSONAL DATEBOOK is a FREEWARE distribution product. You are urged to copy this"
  454. 502  LOCATE 14,1:PRINT "disk and distribute it freely. If desired, you may register your copy by sending"
  455. 503  LOCATE 15,1:PRINT "$12.95 to LATERAL PROGRAMMING, INC. at Box 337, Altamonte Springs, FL 32715."
  456. 504  LOCATE 17,1:PRINT "Registered owners will receive a printed copy of the documentation and  news  of"
  457. 505  LOCATE 18,1:PRINT "updates and revisions. Anyone sending a blank disk with their registration  will"
  458. 506  LOCATE 19,1:PRINT "also receive the latest copy of PERSONAL DATEBOOK."
  459. 507  LOCATE 21,1:PRINT "Registering  your  copy will enable us to continue publishing high quality soft-"
  460. 508  LOCATE 22,1:PRINT "ware under the FREEWARE concept. Your cooperation is sincerely appreciated!":RETURN
  461. 509  LOCATE 24,26:COLOR 11,0:PRINT "PRESS ANY KEY TO END PROGRAM";
  462. 510  RS$=INKEY$:IF RS$="" THEN GOTO 510
  463. 511  RETURN
  464.