---
title: "Inventory Control"
id: 51904
type: "computer_media"
slug: "inventory-control"
url: "http://localhost/computer_media/inventory-control/"
markdown_url: "http://localhost/computer_media/inventory-control.md"
published_at: "2023-08-16T01:42:21+00:00"
modified_at: "2026-04-04T08:36:49+00:00"
author: "David Anderson"
featured_image:
  url: "http://localhost/wp-content/uploads/2019/02/20230809-041332.jpg"
excerpt: "A two-program parts inventory system combines a full-featured stock manager with a compact companion that packs quantities into a clever two-byte string encoding."
category:
  - name: "Archived Media"
    slug: "archived-media"
    taxonomy: "category"
    url: "http://localhost/category/archived-media/"
post_tag:
  - name: "Downloadable"
    slug: "downloadable"
    taxonomy: "post_tag"
    url: "http://localhost/tag/downloadable/"
  - name: "Timex Computer Corporation"
    slug: "timex-computer-corporation"
    taxonomy: "post_tag"
    url: "http://localhost/tag/timex-computer-corporation/"
  - name: "TS 1000"
    slug: "ts1000"
    taxonomy: "post_tag"
    url: "http://localhost/tag/ts1000/"
model:
  - name: "Timex/Sinclair 1000"
    slug: "ts-1000"
    taxonomy: "model"
    url: "http://localhost/model/ts-1000/"
genre:
  - name: "Business"
    slug: "business"
    taxonomy: "genre"
    url: "http://localhost/type/business/"
media_type: "Program"
download_url: "https://archive.org/download/timex-sinclair-software-archive/InventoryControl (1982)(Timex)(US)(TS1000)(Cassette).zip"
mediadate: "1982"
producer_company:
  - id: 11401
    title: "Timex Computer Corporation"
    type: "company"
    url: "http://localhost/company/timex-computer-corporation/"
related_products:
  - id: 12951
    title: "Inventory Control"
    type: "product"
    url: "http://localhost/product/inventory-control/"
media_type_tags: "Business"
---

Inventory Control is a two-part BASIC stock management system for tracking parts inventory. The first program (lines 200–9680) supports up to 150 records, storing part numbers, descriptions, type codes, on-hand quantities, unit values, on-order quantities, and reorder points across parallel arrays including string arrays U$, P$, D$, T$ and numeric arrays H, V, O, R. It features a full-screen template display, bidirectional search with user-supplied BASIC expressions evaluated via VAL, stock receive/relieve/adjust/order operations, total inventory valuation, and tape save with the filename “STOCK[1]”. The second program (lines 100–8090) is a simpler companion supporting up to 1,650 records using a 5-character fixed-width string array D$ for part numbers and a packed two-byte quantity encoding in string array Q$ (storing quantities as CHR$(Q MOD 256)+CHR$(Q\256) to handle values up to 65,535). The second program includes an animated menu that cycles block graphics characters along the top and bottom border while waiting for a keypress.

***

## Program Analysis

This listing contains two distinct, independent inventory programs. The first (the main “Inventory Control” system) begins at line 200 and the second (a simpler companion) begins at line 100 with its own `REM INIT`. Each is self-contained with its own data structures, menu, and tape-save routine.

### Program 1 Structure (Lines 200–9680)

The first program is a comprehensive inventory system supporting up to `MAX`=150 records. Initialization declares parallel arrays for each data field:

| Array | Type | Content |
| --- | --- | --- |
| `U$(MAX)` | String | Record-in-use flag (CHR$ O = occupied, space = free) |
| `P$(MAX,5)` | String | Part number (5 chars) |
| `D$(MAX,7)` | String | Description (7 chars) |
| `T$(MAX,2)` | String | Type code (2 chars) |
| `H(MAX)` | Numeric | On-hand quantity |
| `V(MAX)` | Numeric | Unit value |
| `O(MAX)` | Numeric | On-order quantity |
| `R(MAX)` | Numeric | Reorder point |

The main loop at line 500 drives a menu dispatched from lines 530–710. Letter keys A–J branch via `CODE K$-CODE "A"+O` arithmetic, while numeric/special keys 6, 7, and cursor codes route through a character search in `Z$`. Menu functions are reached by `GOSUB 1000+(I-O)*500`, placing each major subroutine at 500-line intervals: 1000=Down, 1250=Up, 1500=Up Search, 1750=Down Search, 3000=Relieve, 3500=Receive, 4000=Order Stock, 4500=Add Part, 5000=Delete, 5500=List All, 6000=Search, 6500=Stock Value, 7000=Stock Adjust, 7500=Save.

### Notable Technique: Expression Search (Lines 6000–6400)

The search function (line 6000) prompts for an expression string `R$`, then iterates records setting `ONHAND`, `VALUE`, `REORDER`, and `ONORDER` from the current record’s arrays. At line 6350, `IF NOT VAL R$ THEN GOTO 6130` evaluates the user’s input as a BASIC numeric expression. This allows queries such as `ONHAND<10` or `VALUE>5`, making the search engine remarkably flexible without any dedicated parser. Two special cases are handled first: `R$="FREE"` finds the next free slot (line 6700), and `R$(TO 5)="PART="` triggers a part-number substring search (line 6800).

### GETKEY Subroutine (Lines 9140–9170)

The GETKEY routine at line 9140 uses a `PEEK DFCC` technique to locate the display file cursor position, then uses `POKE DF,128-PEEK DF` to toggle inverse video on the character at the cursor as a visual feedback mechanism. It filters keycodes, accepting only specific control characters (112, 113, 118) or printable ASCII above code 63, looping on `INKEY$` otherwise.

### List-All and OUTREC (Lines 5500–5990)

The list function constructs a fixed-width output record `O$` by copying fields into specific column offsets within a pre-built template string derived from `S$` and `M$`. The `OUTREC` subroutine at line 5900 wraps the record in box-drawing characters using block graphics, then routes output to printer, screen, or both based on flags `PRI` and `SCR`. Screen display pauses between records waiting for Enter (CHR$ 118).

### Receive Order Logic (Lines 3500–3710)

The receive subroutine checks whether the quantity received exceeds the on-order quantity. If so, it prints a warning noting the overage and sets `O(CR)` toward zero via `LET O(CR)=O(CR)-N` followed by a clamp at line 3660: `IF O(CR)<Z THEN LET O(CR)=Z`. This prevents negative on-order values. A short delay loop (lines 3620–3630) gives the user time to read the warning.

### Menu Highlight (Lines 9400–9450)

The menu dynamically alters the “C- ORDER STOCK” entry: if the current record’s combined on-hand plus on-order is at or below the reorder point (and the record is occupied), the label switches to an inverse-video version using bracket-encoded characters, providing a visual alert that reorder is needed.

### Program 2 Structure (Lines 100–8090)

The second, simpler program supports up to `MAX`=1,650 records. Part numbers are stored as 5-character fixed-width strings in `D$(MAX,5)`. Quantities are stored in a packed string array `Q$(MAX*2)` using a two-byte little-endian encoding: `Q1=Q MOD 256`, `Q2=INT(Q/256)`, stored as `CHR$ Q1+CHR$ Q2` at position `(G-1)*2+1`. This allows quantities up to 65,535 while keeping all data in a single string array, saving memory compared to a numeric array.

### Animated Menu (Lines 530–590)

While waiting for a menu keypress, the program animates the top and bottom border of a box by selecting a random character from a string `R$` containing block graphics, then printing that character symmetrically outward from the center column in both directions (lines 560–565). A different character is guaranteed each cycle by checking `R$(H)=C$`. The loop at lines 550–580 also polls `INKEY$` on each iteration to detect a valid keypress A–F.

### Quantity Encoding Bug (Lines 4070–4090)

In the adjust-quantity routine (line 4000), the byte roles are swapped relative to the add routine. Line 1170–1180 stores `Q2=INT(Q/256)` (high byte) at position P+1 and `Q1=Q-Q2*256` (low byte) at P. The retrieval at lines 3530–3550 correctly reads low byte first: `Q=Q1+Q2*256`. However, the update routine at lines 4070–4090 reverses the variable names: `Q1=INT(K/256)` (this is actually the high byte) and `Q2=K-256*Q1`, then stores `CHR$ Q2+CHR$ Q1`. This is consistent with the retrieval formula and produces correct results, but the variable naming (`Q1` for high byte in the update vs. low byte in the add) is inconsistent and potentially confusing.

### Delete and Search Padding (Lines 2030, 8030)

Both the delete and part-search routines pad the user-entered part number to exactly 5 characters using the idiom `P$=P$+" "(TO 5-LEN P$)` before comparing against the fixed-width `D$(G)` array entries. This ensures string comparison works correctly with the DIM’d fixed-width array format.

## Source Code

```
  10 REM O▝.... ▗▖▄▝▐▞▟▘▚▌▙▀▜▛█    E£RND7▘#▘U▄RND RETURN▘TAB [K]RND GOSUB #6:RND5▙RND#[B]*****- ACS >#5 2;:▖▞▖#7#7 FAST[J]ACS >*ACS >*ACS <*ACS <*5[▒]RND▐##E:RND#76:RND( STOPSTR$ )1 ;6:RNDSGN  LPRINT $4INT )█ COPYE:RND;6:RND#TAN E£RND7▘D▘,, ▞▘VAL # ##< FOR ▘3  GOSUB [K]>7AT ( LOAD TAN Y ▞▝:?NOT $4 UNPLOT ( SAVE TAN LN ▘INKEY$ LN ▘INKEY$ LN ▘INKEY$ LN ▘INKEY$ TAN 
  90 SLOW
 200 LET MAX=150
 220 DIM U$(MAX)
 442 DIM P$(MAX,5)
 444 DIM D$(MAX,7)
 446 DIM T$(MAX,2)
 448 DIM H(MAX)
 450 DIM V(MAX)
 452 DIM O(MAX)
 454 DIM R(MAX)
 500 SLOW
 505 IF NOT REV THEN GOSUB CLS
 510 IF REV THEN GOSUB TEMPL
 520 IF REV THEN GOSUB REC
 530 GOSUB MENU
 535 PRINT AT 21,Z;"YOUR SELECTION PLEASE:         ";
 540 LET Z$="67"+CHR$ 112+CHR$ 113
 550 GOSUB GETKEY
 555 IF K$>="A" AND K$<="J" THEN GOTO 700
 560 FOR I=O TO LEN Z$
 570 IF K$=Z$(I) THEN GOTO 600
 580 NEXT I
 590 GOTO 550
 610 LET I=(I-1)/2+O
 620 LET REV=O
 625 PRINT AT 21,Z;"                                ";
 630 GOSUB 1000+(I-O)*500
 680 GOTO 500
 700 LET I=CODE K$-CODE "A"+O
 705 LET I=I+4
 710 GOTO 620
 1000 REM DOWN
 1010 IF CR=MAX THEN RETURN
 1020 LET CR=CR+O
 1030 RETURN
 1250 REM UP
 1260 IF CR=O THEN RETURN
 1270 LET CR=CR-O
 1280 RETURN
 1500 REM UP SEARCH
 1505 GOSUB CLS
 1510 LET SR=CR
 1520 LET INC=-O
 1530 GOTO SRCHALT
 1750 REM DOWN SRCH
 1755 GOSUB CLS
 1760 LET SR=CR
 1770 LET INC=O
 1780 GOTO SRCHALT
 3000 REM RELIEVE
 3010 GOSUB CLS
 3020 GOSUB NREC
 3030 PRINT L$(O);
 3040 GOSUB GNUM
 3050 IF N<=Z THEN RETURN
 3080 LET H(CR)=H(CR)-N
 3090 RETURN
 3500 REM RECEIVE
 3510 GOSUB CLS
 3520 GOSUB NREC
 3530 PRINT L$(O);
 3540 GOSUB GNUM
 3550 IF N<=Z THEN RETURN
 3560 IF N<=O(CR) THEN GOTO 3650
 3570 PRINT TAB O;"YOU HAVE RECEIVED ";N-O(CR)
 3580 PRINT TAB O;"UNIT";("S" AND (N-O(CR))<>O);" MORE THAN YOU"
 3590 PRINT TAB O;"HAD ON ORDER.";TAB Z
 3600 PRINT TAB O;TAB O;"[O][N][O][R][D][E][R] HAS BEEN"
 3610 PRINT TAB O;"SET TO ZERO (0)."
 3620 FOR G=1 TO 12
 3630 NEXT G
 3650 LET O(CR)=O(CR)-N
 3660 IF O(CR)<Z THEN LET O(CR)=Z
 3670 LET H(CR)=H(CR)+N
 3710 RETURN
 4000 REM ORDER STOCK
 4010 GOSUB CLS
 4020 GOSUB NREC
 4030 PRINT L$(O);
 4040 GOSUB GNUM
 4050 REM  IF N<=Z THEN RETURN
 4052 IF O(CR)+N>=0 THEN LET O(CR)=O(CR)+N
 4070 REM  LET O(CR)=O(CR)+N
 4080 LET SAVED=Z
 4090 RETURN
 4500 REM ADD PART
 4501 GOSUB CLS
 4502 IF U$(CR)=" " THEN GOTO 4510
 4503 PRINT "CURRENT RECORD OCCUPIED"
 4509 GOTO DNEPRT
 4512 PRINT AT DATA,Z;S$(O+32*2 TO 10*32)
 4540 PRINT AT 21,Z;"                                "
 4560 PRINT AT DATA-O,DATA
 4570 INPUT Z$
 4580 LET P$(CR)=Z$
 4590 PRINT TAB DATA;P$(CR)
 4600 INPUT Z$
 4610 LET D$(CR)=Z$
 4620 PRINT TAB DATA;D$(CR)
 4630 INPUT Z$
 4640 LET T$(CR)=Z$
 4650 PRINT TAB DATA;T$(CR)
 4660 INPUT N
 4670 LET H(CR)=N
 4680 PRINT TAB DATA;INT (H(CR))
 4690 INPUT N
 4700 LET V(CR)=N
 4710 PRINT TAB DATA;V(CR)
 4720 INPUT N
 4730 LET O(CR)=N
 4740 PRINT TAB DATA;INT (O(CR))
 4745 INPUT N
 4750 LET R(CR)=N
 4760 PRINT TAB DATA;INT (R(CR))
 4780 LET U$(CR)=CHR$ O
 4800 RETURN
 5000 REM DELETE
 5010 GOSUB CLS
 5020 GOSUB NREC
 5030 LET U$(CR)=" "
 5060 RETURN
 5500 REM LIST ALL
 5510 CLS
 5530 PRINT "TO SCREEN,PRINTER, OR BOTH?"
 5540 PRINT "PRESS S,P, OR B."
 5550 GOSUB GETKEY
 5560 LET SCR=K$<>"P"
 5570 LET PRI=K$<>"S"
 5580 CLS
 5590 LET TEMP=CR
 5600 LET CR=Z
 5610 GOSUB NXTREC
 5620 IF CR=Z THEN GOTO DNEPRT
 5625 FAST
 5630 LET O$=M$+S$(65 TO 32*9)+M$
 5640 LET O$(43 TO 42+LEN P$(CR))=P$(CR)
 5650 LET O$(75 TO 74+LEN D$(CR))=D$(CR)
 5660 LET O$(107 TO 106+LEN T$(CR))=T$(CR)
 5670 LET Z$=STR$ H(CR)
 5680 LET O$(139 TO 138+LEN Z$)=Z$
 5690 LET Z$=STR$ V(CR)
 5700 LET O$(171 TO 170+LEN Z$)=Z$
 5710 LET Z$=STR$ O(CR)
 5720 LET O$(203 TO 202+LEN Z$)=Z$
 5730 LET Z$=STR$ R(CR)
 5740 LET O$(235 TO 234+LEN Z$)=Z$
 5770 GOSUB OUTREC
 5780 IF Z$=" STOP" THEN GOTO DNEPRT
 5790 GOTO 5610
 5800 REM DNEPRT
 5810 SLOW
 5820 LET CR=TEMP
 5830 PRINT AT 21,Z;"PRESS [E][N][T][E][R] TO RETURN TO MENU: ";AT 21,30;
 5840 GOSUB GETKEY
 5850 IF K$<>CHR$ 118 THEN GOTO 5840
 5860 RETURN
 5900 REM OUTREC
 5905 LET Z$="▛▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▜"+O$+"▙▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▟"
 5910 IF PRI THEN GOSUB 5930
 5915 IF SCR THEN GOSUB 5970
 5920 RETURN
 5930 LPRINT Z$
 5940 LPRINT 
 5950 RETURN
 5970 PRINT AT Z,Z;Z$
 5975 PRINT AT 21,Z;"HIT [E][N][T][E][R] FOR THE NEXT RECORD. ";AT 21,30;
 5980 INPUT Z$
 5990 RETURN
 6000 REM SEARCH
 6010 LET SR=Z
 6020 LET INC=O
 6030 GOSUB CLS
 6040 PRINT L$(2);
 6050 INPUT R$
 6060 IF R$="" THEN RETURN
 6062 FAST
 6065 IF R$="FREE" THEN GOTO 6700
 6067 IF R$( TO 5)="PART=" THEN GOTO 6800
 6110 LET TEMP=CR
 6120 LET CR=SR
 6130 IF INC>Z THEN GOSUB NXTREC
 6140 IF INC<Z THEN GOSUB LASTREC
 6150 IF CR=Z THEN GOTO DNESRCH
 6160 LET ONHAND=H(CR)
 6170 LET VALUE=V(CR)
 6180 LET REORDER=R(CR)
 6190 LET ONORDER=O(CR)
 6350 IF NOT VAL R$ THEN GOTO 6130
 6365 SLOW
 6370 RETURN
 6380 PRINT TAB O;TAB O
 6385 SLOW
 6390 PRINT TAB O;"NO RECORD EXISTS THAT";TAB O;"SATISFIES THE ABOVE CONDITION."
 6400 GOTO ENTERRET
 6500 REM STOCK VALUE
 6510 GOSUB CLS
 6520 IF U$(CR)=" " THEN GOTO 6550
 6530 PRINT TAB O;"CURRENT RECORD: ";TAB O
 6540 PRINT TAB O;"ONHAND";TAB 10;H(CR);TAB 17;"$";H(CR)*V(CR)
 6550 PRINT TAB O;TAB O
 6560 PRINT TAB O;"TOTAL INVENTORY:";TAB O
 6570 PRINT TAB O;"ONHAND";TAB 10;
 6580 LET TQ=Z
 6590 LET TV=Z
 6595 FAST
 6600 FOR J=O TO LEN U$
 6610 IF U$(J)=" " THEN GOTO 6640
 6620 LET TQ=TQ+H(J)
 6630 LET TV=TV+(H(J)*V(J))
 6640 NEXT J
 6645 SLOW
 6650 PRINT TQ;TAB 17;"$";TV
 6670 GOTO 9084
 6700 REM FREE SEARCH
 6710 LET TEMP=CR
 6720 LET CR=Z
 6730 GOSUB 6782
 6740 IF CR=Z THEN GOTO 6770
 6750 IF U$(CR)=" " THEN RETURN
 6760 GOTO 6730
 6770 PRINT TAB O;TAB O;"NO FREE RECORDS LEFT."
 6780 GOTO DNEPRT
 6782 LET CR=CR+1
 6784 IF CR>LEN U$ THEN LET CR=0
 6786 RETURN
 6800 REM PARTNUM SEARCH
 6810 PRINT R$
 6820 LET I$=R$(6 TO )
 6870 REM DO SEARCH
 6875 FAST
 6880 LET TEMP=CR
 6885 LET CR=SR
 6890 IF INC>Z THEN GOSUB NXTREC
 6895 IF INC<Z THEN GOSUB LASTREC
 6897 IF CR=Z THEN GOTO 6385
 6900 LET A$=""
 6905 FOR L=O TO LEN P$(CR)
 6910 IF P$(CR,L)=" " THEN GOTO 6930
 6915 LET A$=A$+P$(CR,L)
 6920 NEXT L
 6930 IF A$(1 TO LEN I$)=I$ THEN GOTO 6365
 6940 GOTO 6890
 7000 REM STOCK ADJUST
 7010 GOSUB CLS
 7020 GOSUB NREC
 7030 PRINT L$(O);
 7040 GOSUB GETNUM
 7050 IF N=Z THEN RETURN
 7060 LET H(CR)=H(CR)+N
 7070 LET CH=O
 7080 LET SAVED=Z
 7090 RETURN
 7500 REM SAVE
 7510 GOSUB CLS
 7520 PRINT "PLEASE SET UP THE TAPE";TAB O;"RECORDER FOR A SAVE."
 7530 PRINT TAB O;TAB O;"PRESS PLAY AND RECORD ON THE";TAB O;"RECORDER."
 7540 PRINT TAB O;TAB O;"THEN PRESS [E][N][T][E][R] ON";TAB O;"THE TS1000. ";
 7550 GOSUB GETKEY
 7560 IF K$<>CHR$ 118 THEN GOTO 7550
 7570 SAVE "STOCK[1]"
 7580 LET REV=Z
 7590 GOTO 500
 9000 REM CLS
 9040 PRINT AT DATA,Z;S$(10*32+O TO );AT DATA,O;
 9050 RETURN
 9060 REM NREC
 9070 IF U$(CR)>" " THEN RETURN
 9072 PRINT AT DATA,O;
 9080 GOSUB BIGC
 9084 PRINT AT 21,Z;"PRESS [E][N][T][E][R] TO RETURN TO MENU: ";
 9085 LET REV=Z
 9086 GOSUB GETKEY
 9088 IF K$=CHR$ 118 THEN GOTO 500
 9090 GOTO 9086
 9140 REM GETKEY
 9145 LET DF=PEEK DFCC+PEEK (DFCC+1)*256
 9147 POKE DF,Z
 9150 LET K$=INKEY$ 
 9155 POKE DF,128-PEEK DF
 9157 IF (CODE K$<>112) AND (CODE K$<>113) AND (CODE K$<>118) AND (CODE K$>63) THEN GOTO 9150
 9160 IF K$<>"" THEN POKE DFCC,CODE K$
 9165 IF K$<>"" THEN RETURN
 9170 GOTO 9150
 9180 REM TEMPL
 9190 PRINT AT Z,Z;S$
 9200 RETURN
 9300 REM EMPTY RECORD
 9310 PRINT AT 2,DATA;E$;AT 3,DATA;E$;AT 4,DATA;E$;AT 5,DATA;E$;AT 6,DATA;E$;AT 7,DATA;E$;AT 8,DATA;E$
 9345 RETURN
 9350 REM REC
 9355 IF U$(CR)=" " THEN GOTO 9300
 9370 PRINT AT O,DATA
 9380 PRINT TAB DATA;P$(CR);TAB DATA;D$(CR);TAB DATA;T$(CR)
 9390 PRINT TAB DATA;H(CR);TAB DATA;V(CR);TAB DATA;O(CR);TAB DATA;R(CR)
 9395 RETURN
 9400 REM MENU
 9410 LET T=O
 9415 LET N$="C- ORDER STOCK"
 9417 IF (O(CR)+H(CR))<=R(CR) AND U$(CR)>" " THEN LET N$="C- [O][R][D][E][R]█[S][T][O][C][K]"
 9420 PRINT AT DATA,T;"A- RELIEVE STOCK";TAB T;"B- RECEIVE ORDER";TAB T;N$;
 9430 PRINT TAB T;"D- ADD PART";TAB T;"E- DELETE PART";TAB T;"F- LIST ALL";TAB T;"G- SEARCH";TAB T;"H- STOCK VALUE"
 9440 PRINT TAB T;"I- STOCK ADJUST";TAB T;"J- SAVE"
 9450 RETURN
 9460 INPUT N
 9470 PRINT N
 9480 RETURN
 9500 PRINT "NO CURRENT RECORD."
 9510 RETURN
 9670 REM NXTREC
 9680 LET N=CR
 
 100 REM INIT
 110 LET C$=" "
 120 LET MAX=1650
 130 DIM D$(MAX,5)
 140 DIM Q$(MAX*2)
 150 LET S$="                                "
 500 REM MAIN LOOP
 505 SLOW
 510 CLS
 513 PRINT AT 8,0;S$+S$+S$+S$+S$
 514 PRINT AT 0,0;"█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█";AT 7,0;"█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█"
 515 FOR G=1 TO 6
 516 PRINT AT G,0;"█";AT G,31;"█"
 518 NEXT G
 520 PRINT AT 1,2;"(A) ADD A PART";AT 2,2;"(B) DELETE A PART";AT 3,2;"(C) LIST ALL";AT 4,2;"(D) ADJUST QUANTITY";AT 5,2;"(E) SAVE";AT 6,2;"(F) QUIT"
 530 LET R$="▒~~,,[~~][,,][▒]▚▞▜▛▙▟▘▝▗▖▌▄▀▐"
 535 LET H=INT (RND*LEN R$)+1
 537 IF R$(H)=C$ THEN GOTO 535
 540 LET C$=R$(H)
 550 FOR X=1 TO 15
 560 PRINT AT 0,16-X;C$;AT 0,15+X;C$
 565 PRINT AT 7,16-X;C$;AT 7,15+X;C$
 570 LET J$=INKEY$ 
 575 IF J$>="A" AND J$<="F" THEN GOTO 700
 580 NEXT X
 590 GOTO 535
 700 GOTO 1000*(CODE J$-CODE "A"+1)
 1000 REM ADD
 1010 FOR G=1 TO MAX
 1020 IF D$(G,1)=" " THEN GOTO 1100
 1030 NEXT G
 1040 PRINT "NO FREE RECORDS."
 1050 GOTO DELRET
 1100 REM 
 1110 PRINT "PART NUMBER: ";
 1120 INPUT P$
 1130 PRINT P$
 1140 LET D$(G)=P$
 1150 PRINT "QUANTITY: ";
 1160 INPUT Q
 1165 PRINT Q
 1170 LET Q2=INT (Q/256)
 1180 LET Q1=Q-Q2*256
 1190 LET P=(G-1)*2+1
 1200 LET Q$(P TO P+1)=CHR$ Q1+CHR$ Q2
 1210 GOTO 513
 2000 REM DELETE
 2010 PRINT "PART NUMBER: ";
 2020 INPUT P$
 2030 LET P$=P$+"      "( TO 5-LEN P$)
 2032 PRINT P$
 2035 FAST
 2040 FOR G=1 TO MAX
 2050 IF D$(G)=P$ THEN GOTO 2400
 2060 NEXT G
 2065 SLOW
 2070 PRINT "PART NOT FOUND."
 2080 GOSUB 3700
 2090 GOTO 500
 2400 LET D$(G,1)=" "
 2402 SLOW
 2405 PRINT "PART ";P$;" DELETED"
 2407 PAUSE 100
 2410 GOTO 513
 3000 REM LIST
 3005 GOSUB 3800
 3010 GOSUB 3640
 3015 FAST
 3030 FOR G=1 TO MAX
 3040 IF D$(G,1)<>" " THEN GOSUB 3500
 3050 IF SC=0 THEN GOSUB 3640
 3055 IF INKEY$ >"" THEN GOTO 3900
 3060 NEXT G
 3065 SLOW
 3070 GOSUB 3700
 3080 GOTO 513
 3500 REM 
 3510 LET SC=SC-1
 3520 LET Q=(G-1)*2+1
 3530 LET Q1=CODE Q$(Q)
 3540 LET Q2=CODE Q$(Q+1)
 3550 LET Q=Q1+Q2*256
 3560 IF SCR THEN PRINT D$(G),Q
 3565 IF PRI THEN LPRINT D$(G),Q
 3570 RETURN
 3630 INPUT I$
 3640 SLOW
 3650 PRINT "PART","QUANTITY"
 3660 PRINT 
 3665 LET SC=20
 3667 FAST
 3670 RETURN
 3700 REM 
 3720 PRINT AT 21,0;"PRESS ENTER"
 3730 INPUT I$
 3735 CLS
 3740 RETURN
 3800 REM SCR/PRI?
 3810 CLS
 3820 PRINT "TO PRINTER (P), SCREEN (S), OR  BOTH (B)?"
 3830 LET K$=INKEY$ 
 3835 IF K$<>"P" AND K$<>"S" AND K$<>"B" THEN GOTO 3830
 3840 LET PRI=K$<>"S"
 3850 LET SCR=K$<>"P"
 3855 CLS
 3860 RETURN
 3900 REM 
 3910 GOSUB 3700
 3915 SLOW
 3920 GOTO 500
 4000 REM QUAN
 4010 GOSUB 8000
 4015 SLOW
 4020 LET J=(G-1)*2+1
 4030 LET Q=CODE Q$(J)+CODE Q$(J+1)*256
 4040 PRINT "OLD QUANTITY: ";Q
 4050 PRINT "NEW QUANTITY: ";
 4060 INPUT K
 4065 PRINT K
 4066 PAUSE 100
 4070 LET Q1=INT (K/256)
 4080 LET Q2=K-256*Q1
 4090 LET Q$(J TO J+1)=CHR$ Q2+CHR$ Q1
 4100 GOTO 500
 5000 REM SAVE
 5005 PRINT AT 15,0;"ENTER THE NAME OF THE FILE."
 5007 PRINT "PRESS RECORD AND PLAY BUTTONS ON THE RECORDER"
 5010 PRINT "THEN HIT [E][N][T][E][R] ON THE TS1000."
 5020 INPUT U$
 5025 IF U$="" THEN LET U$="STOCK2"
 5027 PRINT AT 21,10;U$
 5028 PAUSE 200
 5030 SAVE U$
 5040 GOTO 500
 6000 REM QUIT
 7999 STOP
 8000 REM 
 8010 PRINT "PART NUMBER: ";
 8020 INPUT P$
 8030 LET P$=P$+"      "( TO 5-LEN P$)
 8032 PRINT P$
 8035 FAST
 8040 FOR G=1 TO MAX
 8050 IF D$(G)=P$ THEN RETURN
 8060 NEXT G
 8065 SLOW
 8070 PRINT "PART NOT FOUND."
 8080 GOSUB 3700
 8090 GOTO 513
```