home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 3.img / HOME.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-01  |  17.6 KB  |  310 lines
  1. 10  ' "HOME INVENTORY". (C) Copyright 1984,  F1 Software
  2. 30  CLEAR:KEYOFF:SCREEN0,1,0:DEFINTA-Z:DIMLIN$(24),RCRD(501),KIE$(500),MESSGE$(14):DIMFILD$(10),FLDTYPE(10),FLDLNGTH(10),FLDDEC(10),FLDLNNO(10),FACCR(10):WIDTH40:MONCHR$="N":DEFSEG=0:WIDTH80:IF(PEEK(&H410)AND&H30)=&H30THENMONCHR$="Y
  3. 80  IFMONCHR$="Y"THENFRGRND=7:BKGR=0:BRDR=0 ELSEFRGRND=15:BKGR=1:BRDR=1
  4. 90  BLNK$=SPACE$(79):BLNK50$=LEFT$(BLNK$,50):WRK$=LEFT$(BLNK$,35):GOSUB3920:UNDLN$=STRING$(33,"-"):SUNDLN$=STRING$(23,196):FRMAT$="$$###,###":COLORFRGRND,BKGR,BRDR:CLS:IFMONCHR$="Y"THENLOCATE,,1,12,13 ELSELOCATE,,1,6,7
  5. 130  DEFSEG=&H40:POKE&H17,64:DEFSEG:FORI=1TO10:KEYI,"":NEXTI:COLORFRGRND,BKGR:GOSUB3380:GOSUB3870:GOSUB5090:COLUR$="R":GOSUB3700:GOSUB5150:LOCATE6,56
  6. 190  LNNO=CSRLIN:ACCR=POS(0):BIL=0:SCR1=SCREEN(LNNO,ACCR,1):Z$="":IFMONCHR$="Y"THENLOCATE,,1,12,13 ELSELOCATE,,1,6,7
  7. 220  Z$=INKEY$:IFZ$=""THEN220 ELSEZ=ASC(RIGHT$(Z$,1))
  8. 222  IFLNNO=6THENIFZ$="A"THENGOSUB7000
  9. 230  IFMESSNO=0THEN260 ELSEMESSNO=0
  10. 240  LOCATE21,13:COLORFRGRND,BKGR:PRINTBLNK50$;:COLUR$="R":GOSUB3700:LOCATELNNO,ACCR
  11. 260  IFLEN(Z$)>1THEN520
  12. 270  IFZ>96ANDZ<123THENZ=Z-32:Z$=CHR$(Z):DEFSEG=&H40:POKE&H17,64:DEFSEG
  13. 280  IFISRT$="Y"THENGOSUB3780
  14. 290  IFACCR<MAXACCR+1THENIFZ>31THENCHGSW=1:PRINTZ$;:GOTO190 ELSE320
  15. 300  IFZ>31THENBEEP:MESSNO=3:GOSUB5030:GOTO190
  16. 320  IFZ<>13THEN380
  17. 330  IFLNNO=16THENNXTFLD=1:GOSUB5290:GOTO190
  18. 340  IFLNNO=6THENNXTFLD=2:GOSUB5290:GOTO190
  19. 350  NXTFLD=CRNTFLD+1:GOSUB5290:GOTO190
  20. 380  IFZ<>8THEN420
  21. 390  IFLNNO=6THENLOCATE6,56:GOTO190
  22. 400  IFACCR>39THENCHGSW=1:LOCATELNNO,ACCR-1:PRINT" ";:LOCATELNNO,ACCR-1
  23. 420  IFZ<>9THEN480
  24. 430  IFLNNO=6THENNXTFLD=2:GOSUB5290:GOTO190
  25. 440  IFLNNO=16THENNXTFLD=1:GOSUB5290:GOTO190
  26. 450  NXTFLD=CRNTFLD+1:GOSUB5290:GOTO190
  27. 480  IFZ=27THEN940
  28. 490  GOTO190
  29. 520  IFZ<>77THEN590
  30. 530  IFLNNO=6THENNXTFLD=2:GOSUB5290:GOTO190
  31. 540  IFLNNO=16ANDACCR=42THENNXTFLD=1:GOSUB5290:GOTO190
  32. 550  IFACCR>MAXACCR-1THENNXTFLD=CRNTFLD+1:GOSUB5290:GOTO190
  33. 560  LOCATELNNO,ACCR+1:GOTO190
  34. 590  IFZ<>71THEN620
  35. 600  NXTFLD=1:GOSUB5290:GOTO190
  36. 620  IFZ<>75THEN690
  37. 630  IFLNNO=8ANDACCR=39THENNXTFLD=1:GOSUB5290:GOTO190
  38. 640  IFLNNO=6ANDACCR=56THENNXTFLD=10:GOSUB5290:GOTO190
  39. 650  IFACCR<40THENNXTFLD=CRNTFLD-1:GOSUB5290:GOTO190
  40. 660  LOCATELNNO,ACCR-1:GOTO190
  41. 690  IFZ<>72THEN750
  42. 700  IFLNNO=6THENNXTFLD=10:GOSUB5290:GOTO190
  43. 710  IFLNNO=8THENNXTFLD=1:GOSUB5290:GOTO190
  44. 720  NXTFLD=CRNTFLD-1:GOSUB5290:GOTO190
  45. 750  IFZ<>80THEN810
  46. 760  IFLNNO=6THENNXTFLD=2:GOSUB5290:GOTO190
  47. 770  IFLNNO=16THENNXTFLD=1:GOSUB5290:GOTO190
  48. 780  NXTFLD=CRNTFLD+1:GOSUB5290:GOTO190
  49. 810  IFZ<>15THEN870
  50. 820  IFLNNO=6THENNXTFLD=10:GOSUB5290:GOTO190
  51. 830  IFLNNO=8THENNXTFLD=1:GOSUB5290:GOTO190
  52. 840  NXTFLD=CRNTFLD-1:GOSUB5290:GOTO190
  53. 870  IFZ<>59THEN930
  54. 880  GOSUB3130:GOSUB3870:GOSUB5090:NXTFLD=CRNTFLD:GOSUB5290:LOCATELNNO,ACCR:GOTO190
  55. 930  IFZ<>60THEN1040
  56. 940  COLUR$="F":GOSUB3700:LOCATE21,19:PRINTMESSGE$(1);:LOCATE21,54:GOSUB3840:COLORFRGRND,BKGR:IFZ$="Y"ORZ$="y"THEN990 ELSE1020
  57. 990  GOSUB5620:COLOR7,0,0:CLS:ONERRORGOTO0
  58. 1010  KEY ON:KEY 1,"LIST":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY 6,",LPT1:"+CHR$(13):KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"KEY":KEY 10,"SCREEN 0,0,0"+CHR$(13):END
  59. 1020  LOCATE21,13:PRINTBLNK50$;:LOCATELNNO,ACCR:GOTO190
  60. 1040  IFZ<>61THEN1100
  61. 1050  IFACCR>MAXACCRTHENLOCATELNNO,ACCR:GOTO190
  62. 1060  LOCATELNNO,ACCR:FORI=ACCRTOMAXACCR:PRINT" ";:NEXTI:LOCATELNNO,ACCR:CHGSW=1:GOTO190
  63. 1100  IFZ<>62THEN1150
  64. 1110  GOSUB4800:GOSUB3870:GOSUB5090:GOTO190
  65. 1150  IFZ<>63THEN1270
  66. 1160  GOSUB 3870:MESSNO=2:GOSUB 5030:COLOR FRGRND,BKGR:LOCATE 6,56:PRINT" ";:LOCATE 9,37:INPUT FIND$:IF LEN(FIND$)=0 THEN BEEP: GOTO 1160
  67. 1190  SAVRCRD=RCRDNO:RCRDNO=0:MESSNO=0:RCRDTOT=1
  68. 1200  RCRDNO=RCRDNO+1:IFRCRDNO>TOPRCRDTHENRCRDNO=SAVRCRD:MESSNO=12:GOTO1230
  69. 1220  GOSUB4770:IFFIND$<>LEFT$(XITEM$,LEN(FIND$))THEN1200
  70. 1230  GOSUB3870:GOSUB4770:GOSUB5090:IFMESSNO=12THENGOSUB5030
  71. 1240  NXTFLD=CRNTFLD:GOSUB5290:LOCATELNNO,ACCR:GOTO190
  72. 1270  IFZ<>64THEN1370
  73. 1280  MESSNO=0:SAVRCRD=RCRDNO
  74. 1290  RCRDNO=RCRDNO+1:RCRDTOT=RCRDTOT+1:IFRCRDNO>TOPRCRDTHENRCRDNO=1
  75. 1310  IFRCRDTOT>TOPRCRDTHENRCRDNO=SAVRCRD:MESSNO=14:GOTO1330
  76. 1320  GOSUB4770:IFFIND$<>LEFT$(XITEM$,LEN(FIND$))THEN1290
  77. 1330  GOSUB3870:GOSUB4770:GOSUB5090:IFMESSNO=14THENGOSUB5030
  78. 1340  NXTFLD=CRNTFLD:GOSUB5290:LOCATELNNO,ACCR:GOTO190
  79. 1370  IFZ<>65THEN1440
  80. 1380  MESSNO=10:GOSUB5030:GOSUB5900:RCRDNO=1:GOSUB4770:LOCATE21,13:COLORFRGRND,BKGR:PRINTBLNK50$;:GOSUB5090:PROPT$="B":GOTO190
  81. 1440  IFZ<>66THEN2800
  82. 1450  IFTOPRCRD=0THEN190
  83. 1500  LOCATE21,13:COLORFRGRND,BKGR:PRINTBLNK50$;:MESSNO=11:GOSUB5030:GOSUB5900:RCRDNO=1:GOSUB4770:GOSUB5090:PROPT$="B":PGNO=0:RM$=ROOM$:PLN=1:RP!=0:RV!=0:RPS!=0:RVS!=0:DLIV!=0:GP!=0:GV!=0:LOCATE21,13:COLORFRGRND,BKGR:PRINTBLNK50$;
  84. 1570  COLUR$="R":GOSUB3700:LOCATE21,15:Z$="":INPUT"Report to Screen or Printer, or Quit (S,P,Q)";Z$:IFZ$="S"ORZ$="s"THEN2210 ELSEIFZ$="P"ORZ$="p"THEN1600 ELSE1890
  85. 1600  ONERRORGOTO1860
  86. 1610  GOSUB2100
  87. 1620  IFRM$<>ROOM$THENGOSUB1920
  88. 1630  RP!=RP!+VAL(XPAID$):RV!=RV!+VAL(XVALUE$):DLIV!=DLIV!+VAL(XDLIV$):LSETTAX$=XTAX$:IFVAL(TAX$)=0THEN1690
  89. 1670  RPS!=RPS!+(VAL(TAX$)*VAL(XPAID$)/100):RVS!=RVS!+(VAL(TAX$)*VAL(XVALUE$)/100)
  90. 1690  PLN=PLN+1:IFPLN>56THENGOSUB2100:GOTO1690
  91. 1700  LPRINTUSING"#####";VAL(QTY$);:LPRINT"  ";ITEM$;:LPRINTUSING"######";VAL(PAID$);:LPRINT"  19";BOTYR$;:LPRINTUSING"#######";VAL(VALUE$);:LPRINT"  ";SERIAL$:RCRDNO=RCRDNO+1:IFRCRDNO>TOPRCRDTHEN1760 ELSEGOSUB4770:GOTO1620
  92. 1760  GOSUB1920:IFPLN<62THENLPRINT:LPRINT
  93. 1770  LPRINTTAB(40);LEFT$(UNDLN$,23):LPRINTTAB(28);"GRAND TOTAL ";:LPRINTUSINGFRMAT$;GP!;:LPRINT"    ";:LPRINTUSINGFRMAT$;GV!:LPRINTTAB(40);LEFT$(UNDLN$,23):FORI=1TO20:LPRINT:NEXTI:GOSUB3870:RCRDNO=1:GOSUB4770:GOSUB5090
  94. 1830  CRNTFLD=1:NXTFLD=CRNTFLD:GOSUB5290:ONERRORGOTO0
  95. 1850  GOTO190
  96. 1860  RESUME1870
  97. 1870  ONERRORGOTO0
  98. 1880  GOSUB4970
  99. 1890  GOSUB3870:RCRDNO=1:GOSUB4770:GOSUB5090:CRNTFLD=1:NXTFLD=CRNTFLD:GOSUB5290:GOTO190
  100. 1920  IFPLN<58THENLPRINTTAB(40);LEFT$(UNDLN$,23):PLN=PLN+1 ELSEGOSUB2100
  101. 1930  LPRINTTAB(29);"SUB TOTAL  ";:LPRINTUSINGFRMAT$;RP!;:LPRINT"    ";:LPRINTUSINGFRMAT$;RV!:LPRINTTAB(29);"SALES TAX  ";:LPRINTUSINGFRMAT$;FIX(RPS!);:LPRINT"    ";:LPRINTUSINGFRMAT$;FIX(RVS!)
  102. 1970  LPRINTTAB(29);"DELIVERY   ";:LPRINTUSINGFRMAT$;DLIV!;:LPRINT"    ";:LPRINTUSINGFRMAT$;DLIV!:LPRINTTAB(40);LEFT$(UNDLN$,23):RP!=RP!+FIX(RPS!)+DLIV!:LPRINTTAB(13);"TOTAL FOR ROOM: ";RM$;"   ";:LPRINTUSINGFRMAT$;FIX(RP!);
  103. 2020  RV!=RV!+FIX(RVS!)+DLIV!:LPRINT"    ";:LPRINTUSINGFRMAT$;RV!:LPRINTTAB(40);LEFT$(UNDLN$,23):RM$=ROOM$:PLN=PLN+7:IFRCRDNO>TOPRCRDTHEN2070 ELSEGOSUB2100
  104. 2070  GP!=GP!+RP!:GV!=GV!+RV!:RP!=0:RV!=0:RPS!=0:RVS!=0:DLIV!=0:RETURN
  105. 2100  IFPLN>1ANDPLN<67THENFORI=PLNTO66:LPRINT:NEXTI
  106. 2110  PLN=7:PGNO=PGNO+1:LPRINTTAB(22);" INVENTORY OF HOUSEHOLD CONTENTS":LPRINTTAB(22);UNDLN$:LPRINTTAB(30);"ROOM: ";RM$;SPACE$(27);"PAGE: ";:LPRINTUSING"##";PGNO:LPRINTTAB(30);LEFT$(UNDLN$,14):LPRINT
  107. 2170  LPRINT"  QTY  DESCRIPTION                          PAID  YEAR  VALUE  SERIAL NO.":LPRINTTAB(47);"$            $":RETURN
  108. 2210  COLORFRGRND,BKGR:CLS:LOCATE1,1:HDGON$="Y":GOSUB2660
  109. 2220  IFRM$<>ROOM$THENGOSUB2480
  110. 2230  RP!=RP!+VAL(XPAID$):RV!=RV!+VAL(XVALUE$):DLIV!=DLIV!+VAL(XDLIV$):LSETTAX$=XTAX$:IFVAL(XTAX$)=0THEN2290
  111. 2270  RPS!=RPS!+(VAL(TAX$)*VAL(XPAID$)/100):RVS!=RVS!+(VAL(TAX$)*VAL(XVALUE$)/100)
  112. 2290  PLN=PLN+1:IFPLN>23THENGOSUB2660:GOTO2290
  113. 2300  LOCATEPLN,1:PRINTUSING"#####";VAL(QTY$);:PRINT"  ";ITEM$;:PRINTUSING"######";VAL(PAID$);:PRINT"  19";BOTYR$;:PRINTUSING"#######";VAL(VALUE$);:PRINT"  ";SERIAL$:RCRDNO=RCRDNO+1:IFRCRDNO>TOPRCRDTHEN2360 ELSEGOSUB4770:GOTO2220
  114. 2360  GOSUB2480:LOCATE18,40:PRINTSUNDLN$:LOCATE19,21:PRINT"GRAND TOTAL .......";:PRINTUSINGFRMAT$;GP!;:PRINT"    ";:PRINTUSINGFRMAT$;GV!:LOCATE20,40:PRINTSUNDLN$:GOSUB2760:GOTO2450
  115. 2430  ONERRORGOTO0
  116. 2440  GOSUB4970
  117. 2450  GOSUB3870:RCRDNO=1:GOSUB4770:GOSUB5090:CRNTFLD=1:NXTFLD=CRNTFLD:GOSUB5290:GOTO190
  118. 2480  HDGON$="N":GOSUB2660:LOCATE8,1:PRINTTAB(29);"SUB TOTAL  ";:PRINTUSINGFRMAT$;RP!;:PRINT"    ";:PRINTUSINGFRMAT$;RV!:PRINTTAB(29);"SALES TAX  ";:PRINTUSINGFRMAT$;FIX(RPS!);:PRINT"    ";:PRINTUSINGFRMAT$;FIX(RVS!)
  119. 2530  PRINTTAB(29);"DELIVERY   ";:PRINTUSINGFRMAT$;DLIV!;:PRINT"    ";:PRINTUSINGFRMAT$;DLIV!:PRINTTAB(40);SUNDLN$:RP!=RP!+FIX(RPS!)+DLIV!:LOCATE12,40:PRINTUSINGFRMAT$;RP!;:RV!=RV!+FIX(RVS!)+DLIV!:PRINT"    ";:PRINTUSINGFRMAT$;RV!
  120. 2600  PRINTTAB(40);SUNDLN$:RM$=ROOM$:PLN=99:IFRCRDNO>TOPRCRDTHEN2630 ELSEGOSUB2660
  121. 2630  GP!=GP!+RP!:GV!=GV!+RV!:RP!=0:RV!=0:RPS!=0:RVS!=0:DLIV!=0:RETURN
  122. 2660  IFPLN>1THENGOSUB2760
  123. 2670  LOCATE1,22:PRINT" INVENTORY OF HOUSEHOLD CONTENTS":LOCATE2,30:PRINT"ROOM: ";RM$;SPACE$(27);"PAGE: ";:PGNO=PGNO+1:PRINTUSING"##";PGNO:IFHDGON$="N"THEN2735
  124. 2710  LOCATE4,1:PRINT"  QTY  DESCRIPTION                          PAID  YEAR  VALUE  SERIAL NO.":LOCATE5,1:PRINT"  SOUNDSOUNDSOUND  SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND                          SOUNDSOUNDSOUNDSOUND  SOUNDSOUNDSOUNDSOUND  ";:PRINT"SOUNDSOUNDSOUNDSOUNDSOUND  SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND":GOTO2740
  125. 2735  LOCATE4,1:PRINT"                                            PAID        VALUE            ":LOCATE5,1:PRINT"                                            SOUNDSOUNDSOUNDSOUND        ";:PRINT"SOUNDSOUNDSOUNDSOUNDSOUND            
  126. 2740  HDGON$="Y":PLN=5:RETURN
  127. 2760  LOCATE25,20:PRINT"Press any key to continue OR <ESC> to end";:Z$="
  128. 2770  Z$=INKEY$:IFZ$=""THEN2770
  129. 2772  IFASC(Z$)<>27THENCLS ELSE1890
  130. 2780  RETURN
  131. 2800  IFZ<>67THEN2850
  132. 2810  RCRDNO=RCRDNO-1:IFRCRDNO<1THENRCRDNO=TOPRCRD
  133. 2815  IFTOPRCRD=0THENRCRDNO=1
  134. 2820  GOSUB4770:GOSUB5090:GOTO190
  135. 2850  IFZ<>68THEN2970
  136. 2860  PROPT$=CHR$(SCREEN(6,56)):NXTFLD=1:GOSUB5290:COLORFRGRND,BKGR:LOCATE19,39:PRINT"   ";:IFPROPT$="A"THENMESSNO=6:GOSUB4530:RCRDNO=TOPRCRD:GOTO2930
  137. 2900  IFPROPT$="B"THENRCRDNO=RCRDNO+1:GOSUB4770:GOTO2930
  138. 2910  IFPROPT$="D"THENMESSNO=8:LSETXDELIND$="D":GOSUB4690:RCRDNO=RCRDNO+1:RCRDCHK=RCRDCHK-1:IFRCRDNO>TOPRCRDTHENTOPRCRD=TOPRCRD-1:GOSUB4770:GOTO2930 ELSEGOSUB4770:GOTO2930
  139. 2920  MESSNO=7:GOSUB4530
  140. 2930  IFPROPT$<>"B"THENGOSUB5030:COMPRSS=1
  141. 2940  IFPROPT$<>"A"THENGOSUB5090:PROPT$="B" ELSEPROPT$="B
  142. 2950  GOTO190
  143. 2970  IFZ<>82THEN3030
  144. 2980  LOCATE3,56:COLORFRGRND,BKGR:IFISRT$="Y"THENISRT$="N":PRINT"           ";:GOTO3010
  145. 3000  ISRT$="Y":COLUR$="R":GOSUB3700:PRINT" INSERT ON ";
  146. 3010  LOCATELNNO,ACCR:COLUR$="R":GOSUB3700:GOTO190
  147. 3030  IFZ<>83THEN190
  148. 3040  LOCATELNNO,ACCR:IFACCR>MAXACCRTHEN3100
  149. 3050  IFACCR>MAXACCR-1THEN3090
  150. 3060  FORI=ACCR+1TOMAXACCR:PRINTCHR$(SCREEN(LNNO,I));:NEXTI:CHGSW=1
  151. 3090  PRINT" ";
  152. 3100  LOCATELNNO,ACCR:GOTO190
  153. 3130  COLORFRGRND,BKGR:CLS:LOCATE1,1:PRINTLIN$(1):PRINTLIN$(2):PRINTLIN$(3):LOCATE6,1:PRINT"KEYTHENTHENTHEN<0xCB!>THENTHENTHENCLOSE":LOCATE7,1:PRINT"OPENF1 OPENF2 OPEN F1 - Help                    - displays this Help screen
  154. 3170  LOCATE 8,1:PRINT"TOTHENTHENTHENTAB(THENTHENTHENRANDOMIZE F2 - End session     - closes the file with your changes, ends the run":LOCATE 9,1:PRINT"OPENF3 OPENF4 OPEN F3 - Erase to end            - erases data from cursor to end of field
  155. 3190  LOCATE 10,1:PRINT"TOTHENTHENTHENTAB(THENTHENTHENRANDOMIZE F4 - Restore screen     - loads all data fields with their old contents":LOCATE 11,1:PRINT"OPENF5 OPENF6 OPEN F5 - Find first     - specify search key to find a record
  156. 3210  LOCATE 12,1:PRINT"TOTHENTHENTHENTAB(THENTHENTHENRANDOMIZE F6 - Find next     - find the next record with the same key":LOCATE 13,1:PRINT"OPENF7 OPENF8 OPEN F7 - Sort file     - sorts file into Room/Item order
  157. 3230  LOCATE 14,1:PRINT"TOTHENTHENTHENTAB(THENTHENTHENRANDOMIZE F8 - Report     - report to screen/printer items in all rooms":LOCATE 15,1:PRINT"OPENF9 OPENF10OPEN F9 - Backward     - display previous record in file
  158. 3250  LOCATE 16,1:PRINT"SCREENTHENTHENTHENLOCATETHENTHENTHENLOAD F10- PROCESS / Forward     - act on Process option (Add,Browse,Change,":LOCATE 17,39:PRINT "Delete) / display next record in the file":LOCATE 18,3:PRINT"PROCESS OPTIONS :"
  159. 3270  LOCATE 19,3:PRINT "  Add(A) :  adds new records to end of file when F10 is pressed."
  160. 3280  LOCATE 20,3:PRINT "  Browse(B) :  displays contents of current record."
  161. 3290  LOCATE 21,3:PRINT "  Change(C) :  effects changes made to current record when F10 is pressed."
  162. 3310  LOCATE 22,3:PRINT "  Delete(D) :  deletes current record when F10 is pressed."
  163. 3340  Z$=INKEY$:IF Z$=""THEN 3340
  164. 3350  CLS:RETURN
  165. 3380  GOSUB4390
  166. 3390  LOCATE 10,48:PRINT SPACE$(8);:LOCATE 10,48:INPUT FILNME$:IF RIGHT$(FILNME$,4)=".BAK"THEN GOSUB 4390:LOCATE 16,21:PRINT"*** CANNOT USE .BAK FILES AS INPUT ***":GOTO 3390
  167. 3400  BAD = 0:FOR X =1 TO LEN(FILNME$) : IF ASC(MID$(FILNME$,X,1)) < 65 THEN BAD = BAD +1 ELSE IF ASC(MID$(FILNME$,X,1) > 90 THEN BAD = BAD +1 : NEXT
  168. 3402  IF BAD > 0 THEN BEEP: LOCATE 11,1:PRINT SPC(45) : LOCATE 11,15:PRINT "Filename should be alphabetic characters only" : GOTO 3390
  169. 3410  IFFILNME$=""THENFILNME$="HOME.TXT
  170. 3412  IF LEN(FILNME$) < 4 THEN BEEP : LOCATE 11,19:PRINT "Filename must be 4 or more letters long": GOTO 3390
  171. 3415  IF MID$(FILNME$,LEN(FILNME$)-3,1)="."THEN BAKFL$=LEFT$(FILNME$,LEN(FILNME$)-4)+".BAK" ELSE BAKFL$=FILNME$+".BAK
  172. 3420  ON ERROR GOTO 3570
  173. 3430  OPEN FILNME$ FOR INPUT AS #1
  174. 3440  CLOSE:ON ERROR GOTO 0
  175. 3460  OPEN FILNME$ AS #1 LEN=85:FIELD #1, 1 AS XDELIND$, 8 AS XROOM$, 4 AS XQTY$, 35 AS XITEM$, 15 AS XSERIAL$:FIELD #1, 63 AS XFILL1$, 6 AS XPAID$, 6 AS XVALUE$, 2 AS XBOTYR$:FIELD #1, 77 AS XFILL2$, 4 AS XTAX$, 4 AS XDLIV$:FIELD #1, 85 AS XRCRD1$
  176. 3520  GP!=LOF(1)/85:TOPRCRD=INT(GP!+0.5)+3:IFTOPRCRD>501THENTOPRCRD=501
  177. 3530  IFTOPRCRD>0THENFORI=1TOTOPRCRD:RCRD(I)=I:NEXTI
  178. 3540  IFTOPRCRD<3THENTOPRCRD=0:GOTO3630
  179. 3550  TOPRCRD=TOPRCRD-1:IFTOPRCRD=0THEN3630 ELSEGET#1,TOPRCRD
  180. 3560  DELIND$=XDELIND$:IFDELIND$="A"ORDELIND$="D"THEN3630 ELSE3550
  181. 3570  RESUME3580
  182. 3580  LOCATE 11,1: PRINT SPC(70): GOSUB 4450
  183. 3590  LOCATE 18,54:Z$ = INKEY$ : IF Z$ ="" THEN 3590
  184. 3600  IF Z$ = "R" THEN CLS: CLOSE; GOTO 3380
  185. 3610  IF Z$="A"THEN COLOR 7,0,0 : CLS : END
  186. 3620  IF Z$ = "C" THEN 3440
  187. 3622  BEEP : GOTO 3590
  188. 3630  DELIND$=" ":ROOM$="        ":QTY$="    ":ITEM$=LEFT$(BLNK$,35):SERIAL$=LEFT$(BLNK$,15):PAID$="      ":VALUE$="      ":BOTYR$="  ":TAX$="    ":DLIV$="    ":IFTOPRCRD>0THENRCRDNO=1:GOSUB4770
  189. 3670  IFMONCHR$="Y"THENLOCATE,,1,12,13 ELSELOCATE,,1,6,7
  190. 3680  RCRDCHK=TOPRCRD:RETURN
  191. 3700  IFMONCHR$="Y"THEN3740
  192. 3710  IFCOLUR$="R"THENCOLOR15,0
  193. 3720  IFCOLUR$="F"THENCOLOR31,0
  194. 3730  RETURN
  195. 3740  IFCOLUR$="R"THENCOLOR0,7
  196. 3750  IFCOLUR$="F"THENCOLOR16,7
  197. 3760  RETURN
  198. 3780  LOCATELNNO,ACCR:IFACCR>MAXACCR-1THEN3820
  199. 3790  FORI=MAXACCRTOACCR+1STEP-1:LOCATELNNO,I:PRINTCHR$(SCREEN(LNNO,I-1));:NEXT:LOCATELNNO,ACCR
  200. 3820  RETURN
  201. 3840  Z$="
  202. 3850  Z$=INKEY$:IFZ$=""THEN3850 ELSEZ=ASC(RIGHT$(Z$,1)):RETURN
  203. 3870  COLORFRGRND,BKGR:CLS:FORI=1TO24:LOCATEI,1:PRINTLIN$(I);:NEXT:LOCATE6,56:RETURN
  204. 3920  LIN$(1)=LEFT$(BLNK$,19)+"      STRING$SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDWRITE":LIN$(2)=LEFT$(BLNK$,19)+"      OPEN    HOME  INVENTORY    OPEN":LIN$(3)=LEFT$(BLNK$,19)+"      NOTSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMERGE":LIN$(5)=LEFT$(BLNK$,19)+"           Process Options:
  205. 3960  LIN$(6)=LEFT$(BLNK$,19)+"Add,Browse,Change,Delete (A,B,C,D): B":LIN$(7)=BLNK$:LIN$(8)=LEFT$(BLNK$,19)+"             Room:         ":LIN$(9)=LEFT$(BLNK$,19)+"             Item:                ":LIN$(10)=LEFT$(BLNK$,19)+"         Quantity:     
  206. 4010  LIN$(11)=LEFT$(BLNK$,19)+"        Serial No:                ":LIN$(12)=LEFT$(BLNK$,19)+"       Price Paid:       ":LIN$(13)=LEFT$(BLNK$,19)+"Replacement Price:       ":LIN$(14)=LEFT$(BLNK$,19)+" Year Bought (YY):   
  207. 4050  LIN$(15)=LEFT$(BLNK$,19)+"Enter sales tax %:  ":LIN$(16)=LEFT$(BLNK$,19)+"  Delivery Charge:     ":LIN$(17)=BLNK$:LIN$(18)=BLNK$:LIN$(19)=LEFT$(BLNK$,19)+"        Record No:    ":LIN$(20)=BLNK$:LIN$(21)=BLNK$:LIN$(22)=BLNK$
  208. 4130  LIN$(23)="    F1-Help  F2-End session  F3-Erase to end  F4-Restore screen  F5-Find first  ":LIN$(24)="    F6-Find next  F7-Sort file  F8-Report  F9-Backward  F10-PROCESS / Forward":MESSGE$(1)=" End Session - Are you sure (Y/N)?  
  209. 4160  MESSGE$(2)=" FIND:  Key in first few characters of Item ":MESSGE$(3)=" Press Return key ("+CHR$(17)+CHR$(196)+CHR$(196)+CHR$(217)+") ":MESSGE$(4)="  Device Error - Press Esc ":MESSGE$(5)=" Cannot add - max. records is 500 
  210. 4200  MESSGE$(6)="   ADDED   ":MESSGE$(7)="   CHANGED   ":MESSGE$(8)="   DELETED   ":MESSGE$(9)=" Press F10 to process when ready ":MESSGE$(10)=" Sort in progress ":MESSGE$(11)=" Sort & Report in progress ":MESSGE$(12)="  NOT FOUND  
  211. 4260  MESSGE$(13)=" KEY CANNOT BE BLANK ": MESSGE$(14)="   NO MORE FOUND   ":FILD$(1)="STATUS":FLDTYPE(1)=0:FLDLNGTH(1)=1:FLDDEC(1)=0:FLDLNNO(1)=6:FACCR(1)=56:FILD$(2)=" ROOM ":FLDTYPE(2)=0:FLDLNGTH(2)=8:FLDDEC(2)=0:FLDLNNO(2)=8:FACCR(2)=39
  212. 4290  FILD$(3)=" ITEM ":FLDTYPE(3)=0:FLDLNGTH(3)=35:FLDDEC(3)=0:FLDLNNO(3)=9:FACCR(3)=39:FILD$(4)=" QTY  ":FLDTYPE(4)=9:FLDLNGTH(4)=4:FLDDEC(4)=0:FLDLNNO(4)=10:FACCR(4)=39
  213. 4310  FILD$(5)="SERIAL":FLDTYPE(5)=0:FLDLNGTH(5)=15:FLDDEC(5)=0:FLDLNNO(5)=11:FACCR(5)=39:FILD$(6)=" PAID ":FLDTYPE(6)=9:FLDLNGTH(6)=6:FLDDEC(6)=0:FLDLNNO(6)=12:FACCR(6)=39
  214. 4330  FILD$(7)="VALUE ":FLDTYPE(7)=9:FLDLNGTH(7)=6:FLDDEC(7)=0:FLDLNNO(7)=13:FACCR(7)=39:FILD$(8)=" YY   ":FLDTYPE(8)=9:FLDLNGTH(8)=2:FLDDEC(8)=0:FLDLNNO(8)=14:FACCR(8)=39
  215. 4350  FILD$(9)=" TAX% ":FLDTYPE(9)=0:FLDLNGTH(9)=4:FLDDEC(9)=0:FLDLNNO(9)=15:FACCR(9)=39:FILD$(10)="DLIV ":FLDTYPE(10)=9:FLDLNGTH(10)=4:FLDDEC(10)=0:FLDLNNO(10)=16:FACCR(10)=39:RETURN
  216. 4390  CLS:LOCATE 1,1:PRINT LIN$(1):PRINT LIN$(2):PRINT LIN$(3):LOCATE 6,23:PRINT"(C)Copyright 1984, F1 Software.":LOCATE 10,29:PRINT"Name of input file ?":LOCATE 12,22:PRINT"[Hit enter to name file HOME.TXT]":RETURN
  217. 4450  LOCATE15,19:PRINT"VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR":LOCATE16,19:PRINT"CALL                                        CALL":LOCATE17,19:PRINT"CALL  File not found - can create new file: CALL
  218. 4480  LOCATE18,19:PRINT"CALL    Continue, Retry, Abort (C,R,A)?     CALL":LOCATE19,19:PRINT"CALL                                        CALL":LOCATE20,19:PRINT"CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'":RETURN
  219. 4530  IFPROPT$="D"THENLSETXDELIND$="D" ELSELSETXDELIND$="A
  220. 4540  LSETXROOM$=ROOM$:LSETXQTY$=QTY$:LSETXITEM$=ITEM$:LSETXSERIAL$=SERIAL$:LSETXPAID$=PAID$:LSETXVALUE$=VALUE$:LSETXBOTYR$=BOTYR$:LSETXTAX$=TAX$:LSETXDLIV$=DLIV$:ONERRORGOTO4720
  221. 4640  IFPROPT$<>"A"THEN4690
  222. 4650  IFTOPRCRD>499THENMESSNO=5:GOTO4700
  223. 4660  TOPRCRD=TOPRCRD+1:RCRDNO=TOPRCRD:RCRD(RCRDNO)=RCRDNO:RCRDCHK=RCRDCHK+1:PUT#1,TOPRCRD:GOTO4700
  224. 4690  RCRDNUM=RCRD(RCRDNO):PUT#1,RCRDNUM
  225. 4700  ONERRORGOTO0
  226. 4704  GOSUB3870:NXTFLD=1:RETURN
  227. 4720  RESUME4730
  228. 4730  CLOSE:COLORFRGRND,BKGR:CLS:PRINT"DISK FULL  -  RECTIFY THEN CONTINUE":ONERRORGOTO0
  229. 4750  END
  230. 4770  IFRCRDNO>TOPRCRDTHENRCRDNO=1
  231. 4780  IFRCRDNO<1THENRCRDNO=TOPRCRD
  232. 4790  RCRDNUM=RCRD(RCRDNO):GET#1,RCRDNUM
  233. 4800  LSETDELIND$=XDELIND$:IFDELIND$="A"THEN4860
  234. 4820  IFDELIND$<>"D"THEN4850
  235. 4830  IFRCRDNO=TOPRCRDTHENTOPRCRD=TOPRCRD-1
  236. 4835  IFTOPRCRD=0THENGOSUB3630:GOTO4950
  237. 4840  IFZ=67THENRCRDNO=RCRDNO-1:GOTO4770 ELSERCRDNO=RCRDNO+1:GOTO4770
  238. 4850  IFTOPRCRD>0THENTOPRCRD=RCRDNO-1:RCRDNO=1:GOTO4770 ELSE4950
  239. 4860  LSETROOM$=XROOM$:LSETQTY$=XQTY$:LSETITEM$=XITEM$:LSETSERIAL$=XSERIAL$:LSETPAID$=XPAID$:LSETVALUE$=XVALUE$:LSETBOTYR$=XBOTYR$:LSETTAX$=XTAX$:LSETDLIV$=XDLIV$
  240. 4950  RETURN
  241. 4970  BEEP:MESSNO=4:LOCATE21,13:COLORFRGRND,BKGR:PRINTBLNK50$;:GOSUB5030:Z$="
  242. 5000  Z$=INKEY$:IFZ$<>CHR$(27)THEN5000
  243. 5010  LOCATELNNO,ACCR:RETURN
  244. 5030  COLUR$="R":GOSUB 3700:LOCATE 21,INT(37-(LEN(MESSGE$(MESSNO))/2)):PRINT MESSGE$(MESSNO);:LOCATE LNNO,ACCR:RETURN
  245. 5090  COLORFRGRND,BKGR:FORCRNTFLD=2TO10:GOSUB5150:NEXTCRNTFLD:LOCATE19,39:PRINTUSING"###";RCRDNO;:COLUR$="R":GOSUB3700:CRNTFLD=1:GOSUB5150:LOCATE6,56:PRINT"B";:LOCATE6,56:RETURN
  246. 5150  IFCRNTFLD=1THENLOCATE6,56:PRINTCHR$(SCREEN(6,56));:GOTO5250
  247. 5160  IFCRNTFLD=2THENLOCATE8,39:PRINTROOM$;:GOTO5250
  248. 5170  IFCRNTFLD=3THENLOCATE9,39:PRINTITEM$;:GOTO5250
  249. 5180  IFCRNTFLD=4THENLOCATE10,39:PRINTQTY$;:GOTO5250
  250. 5190  IFCRNTFLD=5THENLOCATE11,39:PRINTSERIAL$;:GOTO5250
  251. 5200  IFCRNTFLD=6THENLOCATE12,39:PRINTPAID$;:GOTO5250
  252. 5210  IFCRNTFLD=7THENLOCATE13,39:PRINTVALUE$;:GOTO5250
  253. 5220  IFCRNTFLD=8THENLOCATE14,39:PRINTBOTYR$;:GOTO5250
  254. 5230  IFCRNTFLD=9THENLOCATE15,39:PRINTTAX$;:GOTO5250
  255. 5240  IFCRNTFLD=10THENLOCATE16,39:PRINTDLIV$;
  256. 5250  IFCRNTFLD>0THENMAXACCR=56
  257. 5260  IFCRNTFLD>1ANDCRNTFLD<11THENMAXACCR=38+FLDLNGTH(CRNTFLD)
  258. 5270  RETURN
  259. 5290  IFCHGSW=0THEN5410 ELSECHGSW=0
  260. 5300  LSET WRK$=BLNK50$:IF CRNTFLD=1 THEN IF CHR$(SCREEN(6,56)) <> "A" THEN IF CHR$(SCREEN(6,56)) <> "B" THEN IF CHR$(SCREEN(6,56))<> "B" THEN IF CHR$(SCREEN(6,56)) <> "C" THEN IF CHR$(SCREEN(6,56)) <> "D" THEN BEEP : LOCATE 6,56:GOTO 190 :  GOTO 5410
  261. 5320  IFCRNTFLD=2THENGOSUB5460:LSETROOM$=WRK$:GOTO5410
  262. 5330  IFCRNTFLD=3THENGOSUB5460:LSETITEM$=WRK$:GOTO5410
  263. 5340  IF CRNTFLD=4 THEN GOSUB 5460:LSET QTY$=WRK$:GOTO 5410
  264. 5350  IF CRNTFLD=5 THEN GOSUB 5460:LSET SERIAL$=WRK$:GOTO 5410
  265. 5360  IF CRNTFLD=6 THEN GOSUB 5460:LSET PAID$=WRK$:GOTO 5410
  266. 5370  IF CRNTFLD=7 THEN GOSUB 5460:LSET VALUE$=WRK$:GOTO 5410
  267. 5380  IF CRNTFLD=8 THEN GOSUB 5460:LSET BOTYR$=WRK$:GOTO 5410
  268. 5390  IF CRNTFLD=9 THEN GOSUB 5460:LSET TAX$=WRK$:GOTO 5410
  269. 5400  IF CRNTFLD=10 THEN GOSUB 5460:LSET DLIV$=WRK$:GOTO 5410
  270. 5410  COLORFRGRND,BKGR:GOSUB5150:CRNTFLD=NXTFLD:COLUR$="R":GOSUB3700:GOSUB5150:LOCATE(FLDLNNO(CRNTFLD)),39:IFCRNTFLD=1THENLOCATE6,56
  271. 5450  RETURN
  272. 5460  FORI=1TOFLDLNGTH(CRNTFLD):MID$(WRK$,I,1)=CHR$(SCREEN(FLDLNNO(CRNTFLD),38+I)):NEXTI:IFFLDTYPE(CRNTFLD)=9THENGOSUB5520
  273. 5500  RETURN
  274. 5520  DECPLACE=0:SPAFL=0:FORI=1TOFLDLNGTH(CRNTFLD):IFMID$(WRK$,I,1)=" "THENSPAFL=1
  275. 5550  IFMID$(WRK$,I,1)="."THENDECPLACE=I:IFFLDDEC(CRNTFLD)=0THENSPAFL=1
  276. 5560  IFSPAFL=1THENMID$(WRK$,I,1)=" 
  277. 5570  IFDECPLACE>0ANDFLDDEC(CRNTFLD)<(I-DECPLACE+1)THEN5580 ELSE5590
  278. 5580  IFMID$(WRK$,I,1)<"0"ORMID$(WRK$,I,1)>"9"THENMID$(WRK$,I,1)="0
  279. 5590  NEXTI:RETURN
  280. 5620  COLORFRGRND,BKGR:CLS:LOCATE1,1:PRINTLIN$(1):PRINTLIN$(2):PRINTLIN$(3):LOCATE8,23:PRINT"Creating backup file  ";BAKFL$;:ONERRORGOTO5670
  281. 5660  KILLBAKFL$:GOTO5680
  282. 5670  RESUME5680
  283. 5680  ONERRORGOTO5840
  284. 5690  OPEN BAKFL$ AS #2 LEN=85:FIELD #2, 85 AS XRCRD2$:I=0:J=0:LOCATE10,30:PRINT"Record number: 
  285. 5730  I=I+1:IFI>TOPRCRDORI>500THEN5770 ELSERCRDNUM=RCRD(I):GET#1,RCRDNUM
  286. 5740  IF"D"=XDELIND$THEN5730
  287. 5750  IF"A"<>XDELIND$THEN5770
  288. 5760  LSETXRCRD2$=XRCRD1$:J=J+1:PUT#2,J:LOCATE10,45:PRINTUSING"###";J:GOTO5730
  289. 5770  CLOSE#1:IFJ<>RCRDCHKTHENCOMPRSS=0
  290. 5780  CLOSE#1:IFCOMPRSS=0THEN5870 ELSEKILLFILNME$
  291. 5790  LOCATE14,27:PRINT"Compressing file  ";FILNME$:OPEN FILNME$ AS #1 LEN=85:LOCATE16,30:PRINT"Record number: ":I=0
  292. 5830  I=I+1:IFI>JTHEN5870 ELSEGET#2,I:LSETXRCRD1$=XRCRD2$:PUT#1,I:LOCATE16,45:PRINTUSING"###";I:GOTO5830
  293. 5840  RESUME5850
  294. 5850  ONERRORGOTO0
  295. 5860  GOSUB4970:GOTO5620
  296. 5870  ONERRORGOTO0
  297. 5880  CLOSE:RETURN
  298. 5900  IFTOPRCRD=0THEN6140 ELSEJ=0
  299. 5910  FORI=1TOTOPRCRD:RCRDNUM=RCRD(I):GET#1,RCRDNUM:LSETDELIND$=XDELIND$:LSETROOM$=XROOM$:LSETITEM$=XITEM$:J=J+1:KIE$(J)=DELIND$+ROOM$+LEFT$(ITEM$,8):NEXTI:TOPRCRD=J:SRTA!=1
  300. 5990  SRTA!=2*SRTA!:IFSRTA!<=TOPRCRDTHEN5990
  301. 6010  SRTA!=INT(SRTA!/2):IFSRTA!=0THEN6140
  302. 6030  FORSRTB=1TOTOPRCRD-SRTA!:SRTL=SRTB
  303. 6050  SRTH=SRTL+SRTA!:IFKIE$(SRTL)<=KIE$(SRTH)THEN6120
  304. 6070  KSAVE$=KIE$(SRTL):I=RCRD(SRTL):KIE$(SRTL)=KIE$(SRTH):RCRD(SRTL)=RCRD(SRTH):KIE$(SRTH)=KSAVE$:RCRD(SRTH)=I:SRTL=SRTL-SRTA!:IFSRTL>0THEN6050
  305. 6120  NEXTSRTB:GOTO6010
  306. 6140  SRTA!=FRE("")
  307. 6150  IFLEFT$(KIE$(TOPRCRD),1)="D"THENTOPRCRD=TOPRCRD-1:GOTO6150
  308. 6160  RETURN
  309. 7000  COLUR$="R":GOSUB3700:ROOM$=SPACE$(8):QTY$=SPACE$(4):ITEM$=SPACE$(35):SERIAL$=SPACE$(15):PAID$=SPACE$(6):VALUE$=SPACE$(6):BOTYR$=SPACE$(2):TAX$=SPACE$(4):DLIV$=SPACE$(4):CHGSW=1:RETURN
  310.