1 COMMON A, AL, B, BASEONLY, C, C$, C1, CAT$, CC, CKT$, D, D$, DD, DIA, DIMN$, DMS, E, EO, EX$, F, F$, FD, FF, FQ, FRQ, G$, GO$, I, I$, L, LATLONG, LD, LL, LN, LS, LW, LX, MAX, MENU, MIN, MX, N, NN, NT, OV, P, PI, PROG$, Q, QQ, QU, R, RA, RC, T, T$, U, U$, UH, UL$, V$, VC, W, WHIP, WIRD, WW, X, X$, X1, XS, Z$, ZP, ZS
10 '\bas\prog2\CHKLIST   15 NOV 86  Rev. 28 AUG 2001
20 CLEAR:CLS:KEY OFF
30 ON ERROR GOTO 190
40 UL$=STRING$(80,205)
50 DIM A$(255),F$(50,2)
60 COLOR 7,0
70 PRINT"CHECKLIST";
80 PRINT UL$;
90 PRINT TAB(24);"  Press letter in ( ) to:"
100 PRINT UL$;
110 PRINT TAB(19);"  (a)  Run program";
120 PRINT TAB(19);"  (b)  Exit";
130 Z$=INKEY$
140 IF Z$="a"OR Z$="A"THEN CLS:GOTO 210
150 IF Z$="b"OR Z$="B"THEN CLS:RUN"\bas\menu\dosmenu"
160 GOTO 130
170 CLS:END
180 '
190 PRINT "Error";ERR;;"in line";ERL:STOP
200 '
210 PRINT "THESE ARE THE CHECKLISTS ON FILE:"
220 PRINT UL$;
230 FILES"\data\chk\*.chk":LOCATE CSRLIN-1:PRINT STRING$(80,45);
240 INPUT "ENTER: name of Checklist ";I$:GOSUB 610:N$=I$
250 IF I$=""THEN CLS:GOTO 90
260 NO$="\data\chk\"+N$+".CHK":GOTO 320
270 PRINT "`";N$;;"' file not found.  Do you want to open one?  (y/n)";
280 Z$=INKEY$
290 IF Z$="N"OR Z$="n"THEN CLS:RESUME 240
300 IF Z$="Y"OR Z$="y"THEN CLS:RESUME 740
310 GOTO 280
320 CLS:PRINT "Loading `";N$;;"' data from Disk";
330 ON ERROR GOTO 270
340 OPEN "I",1,NO$
350 N=0
360 IF EOF(1)THEN 390
370 N=N+1
380 INPUT # 1,A$(N):GOTO 360
390 CLOSE
400 '
410 CLS:PRINT "CHECKLIST Filename: ";N$
420 PRINT UL$;
430 PRINT "Press letter in ( ) to select function:"
440 PRINT UL$;
450 PRINT "(a) ADD a listing";
460 PRINT "(b) FIND or EDIT a listing";
470 PRINT "(c) DISPLAY checklist";
480 PRINT "(e) Quit";
490 Z$=INKEY$
500 IF Z$="a"THEN CLS:GOTO 740
510 IF Z$="b"THEN CLS:GOTO 1160
520 IF Z$="c"THEN CLS:GOTO 790
530 IF Z$="e"THEN CLS:GOTO 10
540 GOTO 490
550 '
560 'SAVE DATA
570 PRINT "SAVING DATA to DISK";
580 OPEN "O",1,NO$
590 FOR Z=1 TO N
600 WRITE #1,A$(Z):NEXT Z:CLOSE:CLS:GOTO 410
610 '
620 FOR U=1 TO LEN(I$):V=ASC(MID$(I$,U,1))
630 IF V>96 AND V<123 THEN MID$(I$,U,1)=CHR$(V-32)
640 NEXT U:RETURN
650 '
660 'INPUTS
670 LINE INPUT "ENTER Name ....................... ?";I$:GOSUB 620
680 IF LEN(I$)<=21 THEN 710 ELSE BEEP
690 PRINT:PRINT ;"Too long! Maximum 21 characters! Press any key to continue...";
700 IF INKEY$=""THEN 700 ELSE 670
710 IF I$<>""THEN I$="( ) "+I$:A$(Z)=I$
720 RETURN
730 '
740 'NEW LISTING
750 N=N+1
760 PRINT "NEW LISTING";:PRINT
770 Z=N:GOSUB 670:CLS:GOTO 1440
780 '
790 'SORT
800 IF A$(1)<>""THEN 820
810 FOR Y=1 TO N:A$(Y)=A$(Y+1):NEXT Y:N=N-1:GOTO 800
820 SN=N:SM=SN:PRINT "Sorting at level";
830 SM=INT(SM/2):IF SM=0 THEN CLS:GOTO 940
840 LOCATE 1,17:PRINT USING "#####";SM
850 SK=SN-SM:SJ=1
860 SI=SJ:     SI$=RIGHT$(A$(SI),LEN(A$(SI))-2)
870 SL=SI+SM:  SL$=RIGHT$(A$(SL),LEN(A$(SL))-2)
880 IF A$(SI)<=A$(SL)THEN 910
890 SWAP A$(SI),A$(SL)
900 SI=SI-SM:IF SI>0 THEN 870
910 SJ=SJ+1:IF SJ>SK THEN 830
920 GOTO 860
930 '
940 '.....screen display
950 PRINT "CHECKLIST Filename: ";N$
960 PRINT UL$;
970 IF N/3=INT(N/3)THEN X=N/3 ELSE X=INT(N/3)+1
980 Y=26:IF X<1 THEN X=1
990 A=1:B=A+Y:C=B+Y
1000 FOR Z=1 TO X
1010 PRINT TAB(A);A$(Z);TAB(B);A$(Z+X);TAB(C);A$(Z+2*X)
1020 IF CSRLIN<=23 THEN 1060
1030 LOCATE 25:PRINT "Press any key to continue.....";
1040 Z$=INKEY$:IF Z$=""THEN 1040 ELSE 1050
1050 CLS:LOCATE 25:PRINT STRING$(80,32);:COLOR 7,0:LOCATE 1
1060 NEXT Z::REM'LOCATE 25:COLOR 15,0
1070 GOSUB 1630:GOTO 560
1080 END
1090 '
1100 'MENU RETURN
1110 PRINT:PRINT ;"NOT IN FILE";
1120 PRINT:PRINT ;"Press SPACE BAR to return to Menu";
1130 Z$=INKEY$:IF Z$=" "THEN CLS:GOTO 410
1140 GOTO 1130
1150 '
1160 'SEARCH
1170 INPUT "ENTER first few letters of Item Name";I$:GOSUB 620
1180 L=LEN(I$):F=0:FOR Z=1 TO N
1190 IF MID$(A$(Z),5,L)=I$ THEN F=F+1:F$(F,1)=A$(Z):F$(F,2)=STR$(Z)
1200 NEXT Z:IF F=0 THEN 1100
1210 CLS:IF F<21 THEN 1230
1220 PRINT "List too long to fit screen. Please enter more letters...";:GOTO 1170
1230 IF F=1 THEN Z=VAL(F$(F,2)):GOTO 1300
1240 FOR Z=1 TO F:PRINT CHR$(Z+96);;"> ";F$(Z,1):NEXT Z
1250 PRINT "Press letter ?> to select listing or SPACE BAR to return to menu"
1260 Y$=INKEY$:IF Y$=""THEN 1260
1270 IF Y$=" "THEN CLS:GOTO 410
1280 IF Y$<>" "THEN Q=ASC(Y$)
1290 IF Q>96 AND Q<=F+96 THEN Y=Q-96:Z=VAL(F$(Y,2)):CLS:GOTO 1300 ELSE 1260
1300 GOSUB 1410
1310 PRINT "Press number in ( ) for next step:";:PRINT
1320 PRINT "(1) EDIT Listing";
1330 PRINT "(2) DELETE Listing";
1340 PRINT "(3) Return to menu";
1350 Z$=INKEY$
1360 IF Z$="1"THEN CLS:GOTO 1440
1370 IF Z$="2"THEN 1550
1380 IF Z$="3"THEN CLS:GOTO 410
1390 GOTO 1350
1400 '
1410 PRINT:PRINT A$(Z):PRINT:RETURN
1420 '
1430 'EDIT LISTING
1440 GOSUB 1410:PRINT "Press number in ( ) for next step:";:PRINT
1450 PRINT " (1) Change Name";
1460 PRINT " (2) Add check";
1470 PRINT " (3) Delete check";
1480 PRINT " (4) O.K. as is";
1490 Z$=INKEY$:Q=VAL(Z$):IF Q<1 OR Q>5 THEN 1540
1500 IF Z$="1"THEN PRINT:GOSUB 670:CLS:GOTO 1440
1510 IF Z$="2"THEN MID$(A$(Z),2,1)=CHR$(251):CLS:GOTO 1440
1520 IF Z$="3"THEN MID$(A$(Z),2,1)=" ":CLS:GOTO 1440
1530 IF Z$="4"THEN CLS:GOTO 560
1540 GOTO 1490
1550 '
1560 'DELETE LISTING
1570 PRINT:PRINT ;"Are you sure you want this listing deleted ?  (y/n)";
1580 Z$=INKEY$:IF Z$="n"THEN 1310
1590 IF Z$="y"THEN 1600 ELSE 1580
1600 CLS:PRINT "LISTING DELETED";:FOR X=Z TO N
1610 A$(X)=A$(X+1):NEXT X:N=N-1:Z$="":X=0:F=0:Z=0:GOTO 560
1620 '
1630 'PRT
1640 GOSUB 1710:LOCATE 25,18:COLOR 0,2
1650 PRINT " Press #¯Ý1=PrintÝ2=Print/Form FeedÝ3=Continue";:COLOR 7,0
1660 COLOR 7,0
1670 Z$=INKEY$:IF Z$<"1"OR Z$>"3"THEN 1670 ELSE GOSUB 1710
1680 IF Z$="3"THEN RETURN
1690 FOR I%=1 TO 24:FOR J%=1 TO 80:LPRINT CHR$(SCREEN(I%,J%));:NEXT J%:NEXT I%
1700 IF Z$="2"THEN LPRINT CHR$(12) ELSE 1640
1710 LOCATE 25,1:PRINT STRING$(80,32);:RETURN
