image of READY prompt

Wang2200.org

Listing of file='KFAM2003' on disk='vmedia/701-2049C.wvd.zip'

# Sector 191, program filename = 'KFAM2003'
0001 REM KFAM2003,VER.02/18/76
0002 GOTO 3072
0012 COM Q6$64
3072 LOAD DC T#0,"KFAM0003"3072,3072
4800 DIM C$40,U1$8,U0$3,K1$8,K0$3,D8$21,X$64,M$(1)30
   : DIM K2$30,B$1,Y$1,D$(4)64,K$30
   : D8$="310320330350B10B20B30"
   : PRINT HEX(03)
5010 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8)
   : U1$=Q6$
   : IF STR(U1$,5,1)<>"F"THEN 5060
   : IF STR(U1$,6,1)<"0"THEN 5060
   : IF STR(U1$,6,1)<="9"THEN 5090
5060 GOSUB '50("NOT KFAM FILE NAME")
   : GOTO 5010
5090 GOSUB '125("ENTER THE NO. OF THE USER FILE DEVICE ADDRESS")
   : D2=X
   : U0$=STR(D8$,X*3-2,3)
   : ON D2-1GOTO 5143,5146,5149,5152,5155,5158
   : SELECT #2310
   : GOTO 5190
5143 SELECT #2320
   : GOTO 5190
5146 SELECT #2330
   : GOTO 5190
5149 SELECT #2350
   : GOTO 5190
5152 SELECT #2B10
   : GOTO 5190
5155 SELECT #2B20
   : GOTO 5190
5158 SELECT #2B30
5190 GOSUB '245("ENTER KEY FILE NUMBER (NORMAL=1)",1,0)
   : K9=Q9
   : IF K9>0THEN 5240
   : GOSUB '50("INVALID")
   : GOTO 5190
5240 K1$=U1$
   : STR(K1$,5,1)="K"
   : CONVERT K9TO STR(K1$,6,1),(#)
   : GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS")
   : D1=X
   : K0$=STR(D8$,X*3-2,3)
   : ON D1-1GOTO 5333,5336,5339,5342,5345,5348
   : SELECT #1310
   : GOTO 5380
5333 SELECT #1320
   : GOTO 5380
5336 SELECT #1330
   : GOTO 5380
5339 SELECT #1350
   : GOTO 5380
5342 SELECT #1B10
   : GOTO 5380
5345 SELECT #1B20
   : GOTO 5380
5348 SELECT #1B30
5380 GOSUB '243("ENTER LAST KEY",30)
   : K2$=Q6$
   : GOSUB '248(0,0,4)
5396 PRINT "TURN ON PRINTER"
   : GOSUB '243("KEY RETURN(EXEC) TO RESUME",2)
   : GOSUB '248(0,0,4)
5402 D=0
   : GOSUB '230(1,1,2,K9,U1$)
   : IF Q$=" "THEN 5450
   : STOP "ERROR OPENING FILES"
5450 LIMITS T#2,U1$,A,X,Y
   : S8=A
   : E=A+Y
   : PRINT HEX(03)
   : GOSUB '248(7,0,0)
   : PRINT "KFAM2003 KEY FILE CREATION UTILITY"
   : PRINT HEX(0A)
   : PRINT "USER FILE  ";U1$;TAB(30);"DEVICE = ";U0$
   : PRINT "KEY FILE   ";K1$;TAB(30);"DEVICE = ";K0$
5540 %SECTOR #####     RECORD NUMBER ######
5550 %KEY ################################
5580 IF Q2$<HEX(FF00)THEN 5600
   : IF V5$=V8$THEN 5610
5600 GOSUB '51("KEY FILE NOT INITIALIZED")
5610 S9=VAL(V6$)
   : R,I=VAL(STR(V1$,2))
   : B=VAL(V8$)
   : K0=VAL(STR(V1$,3))*256+VAL(STR(V1$,4))+1
   : K=VAL(STR(V1$,5))
   : T5$,K$=" "
   : S2=0
   : B$=STR(V1$,1)
   : IF B$="A"THEN 6410
   : IF B$="C"THEN 5760
   : S2=INT((K0-1)/256)
   : S8=A+S2
   : K0=K0-256*S2
5760 B1=B
5770 B1=B1+1
   : P1=P1+I
   : IF B1<=BTHEN 5870
   : IF S8<ETHEN 5820
   : GOSUB '51("LAST KEY NOT FOUND")
5820 DATA LOAD BA T#2,(S8,X)D$()
   : S8=S8+S9
   : B1=1
   : P1=K0
5870 MAT COPY D$()<P1,K>TO M$()
   : K$=M$(1)
   : Y$=K$
   : IF Y$<HEX(FF)THEN 6130
   : ADD(V5$,01)
   : IF V5$<=V8$THEN 6080
   : ADDC(Q2$,V6$)
   : V5$=HEX(01)
6080 PRINT HEX(010A0A0A0A)
   : PRINTUSING 5540,S8-A-S9-S2,B1
   : PRINTUSING 5550,"DELETED"
   : GOTO 5770
6130 GOSUB '233(1,0,K$,Q)
   : IF Q$="X"THEN 6240
   : IF Q$="S"THEN 6260
   : PRINT HEX(010A0A0A0A)
   : PRINTUSING 5540,S8-A-S9-S2,B1
   : PRINTUSING 5550,K$
   : IF Q$="D"THEN 6960
   : IF K$<>K2$THEN 5770
6194 SELECT PRINT 215
6196 IF D>0THEN 6200
   : PRINT "NO DUPLICATE KEYS"
6200 PRINT HEX(0C)
   : SELECT PRINT 005
   : V8=.5
   : GOSUB '239(1)
   : PRINT HEX(03)
   : COM CLEAR Q6$
   : LOAD DC T#0,"START050"
6240 GOSUB '51("PROGRAM ERROR")
6260 GOSUB '51("NO SPACE")
6290 DEFFN'50(Q6$)
   : PRINT HEX(010A0A0A)
   : PRINT Q6$
   : RETURN
6350 DEFFN'51(Q6$)
   : PRINT HEX(01)
   : PRINT Q6$
   : STOP
6410 DATA LOAD BA T#2,(S8,X)D$()
   : IF STR(D$(1),1,2)=HEX(8101)THEN 6440
6430 GOSUB '51("INVALID RECORD FORMAT")
6440 N=0
   : P=3
   : C=0
6470 X=INT((P-1)/64)
   : Y=P-64*X
   : X=X+1
   : Y$=STR(D$(X),Y,1)
   : IF Y$=HEX(FD)THEN 6680
   : IF Y$=HEX(08)THEN 6550
   : IF Y$<HEX(81)THEN 6430
   : IF Y$>HEX(C0)THEN 6430
6550 IF C=0THEN 6580
   : IF Y$=STR(C$,N,1)THEN 6610
6570 GOSUB '51("NOT BLOCKED AS SPECIFIED")
6580 N=N+1
   : IF N>38THEN 6430
   : STR(C$,N,1)=Y$
6610 C=C+1
   : AND (Y$,7F)
   : P=P+1+VAL(Y$)
   : IF C<BTHEN 6470
   : C=0
   : GOTO 6470
6680 IF C>0THEN 6570
   : X=(P-3)/B
   : IF X=RTHEN 6720
   : GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY")
6720 IF N=0THEN 6430
   : P=3
   : N1=0
6770 N1=N1+1
   : IF N1>NTHEN 6870
   : Y$=STR(C$,N1,1)
   : AND (Y$,7F)
   : Y=VAL(Y$)+1
   : IF P+Y>=K0THEN 6860
   : P=P+Y
   : GOTO 6770
6860 IF K0+K<=P+YTHEN 6880
6870 GOSUB '51("KEY FIELD OUT OF BOUNDS")
6880 IF STR(C$,N1,1)>HEX(80)THEN 6910
   : GOSUB '51("NUMERIC KEY INVALID")
6910 K0=(P-3)*B+3+K0-P
   : I=Y
   : GOTO 5760
6960 SELECT PRINT 215
   : PRINT "DUPLICATE KEY IGNORED"
   : PRINTUSING 5550,K$
   : ADD(V5$,01)
   : IF V5$<=V8$THEN 7040
   : ADDC(Q2$,V6$)
   : V5$=HEX(01)
7040 X=VAL(V5$)
   : Y=VAL(Q2$)*256+VAL(STR(Q2$,2))
   : PRINTUSING 5540,Y,X
   : PRINT "T4$ (HEX) = ";
   : HEXPRINT Q2$;V5$
   : D=D+1
7100 PRINT HEX(0A0A)
   : SELECT PRINT 005
   : GOTO 5770
7170 DEFFN'125(X$)
   : GOSUB '248(5,0,5)
   : PRINT ,"1.  310     5.  B10"
   : PRINT ,"2.  320     6.  B20"
   : PRINT ,"3.  330     7.  B30"
   : PRINT ,"4.  350"
7230 GOSUB '245(X$,1,0)
   : X=Q9
   : IF X<1THEN 7290
   : IF X>7THEN 7290
   : GOSUB '248(5,0,5)
   : RETURN
7290 PRINT HEX(010A0A0A)
   : PRINT "INVALID DEVICE ADDRESS"
   : GOTO 7230
8710 Q6=3
   : GOTO 9289
8975 DEFFN'242(W0,Q6$)
   : IF W0<=0THEN 9405
   : IF W0=1THEN 8990
   : STR(Q6$,2)=STR(Q6$,1,W0-1)
8990 PRINT Q6$;
   : RETURN
9010 DEFFN'243(Q6$,Q0)
   : GOSUB 9200
9022 SELECT CO 205
   : Q6$=" "
   : INPUT Q6$
   : IF Q0=0THEN 9231
   : IF Q0>1THEN 9025
   : IF Q6$="Y"THEN 9025
   : IF Q6$<>"N"THEN 9027
9025 IF LEN(Q6$)<=Q0THEN 9231
9027 GOSUB 9150
9032 DEFFN'244(Q0)
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9022
9038 DEFFN'245(Q6$,Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 9200
9044 GOSUB '242(ABS(Q2)+2,HEX(09))
   : PRINT "/"
   : GOSUB 9220
   : SELECT CO 205
   : Q9,W0=-1E-99
   : INPUT Q9
   : IF W0=Q9THEN 9058
   : IF Q9>=0THEN 9070
   : IF Q2<=0THEN 9070
9058 GOSUB 9150
9060 DEFFN'246(Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9044
9070 IF ABS(Q9)>=10^ABS(Q2)THEN 9058
   : W0=ABS(Q9*10^Q3)
   : IF INT(W0)<>W0THEN 9058
   : GOTO 8710
9150 GOSUB 8710
   : PRINT "RE-ENTER"
   : RETURN
9200 GOSUB 9405
   : PRINT HEX(010A);STR(Q6$,1);
9210 GOSUB 9405
   : GOSUB '242(Q0+2,"-")
   : PRINT TAB(64)
9220 PRINT HEX(010A0A)
   : RETURN
9231 PRINT HEX(0A);TAB(64)
   : GOTO 9405
   : Q6=0
9289 Q7=0
   : Q8=1
9290 DEFFN'248(Q6,Q7,Q8)
   : GOSUB 9405
   : IF Q8<1THEN 9350
   : GOSUB 9350
   : SELECT PRINT 205
   : Q6$=" "
   : PRINT STR(Q6$,Q7+1)
   : IF Q8<2THEN 9350
   : FOR W0=2TO Q8
   : PRINT HEX(0A);STR(Q6$,1)
   : NEXT W0
9350 PRINT HEX(01)
   : GOSUB '242(Q7,HEX(09))
   : GOSUB '242(Q6,HEX(0A))
9405 SELECT PRINT 005(64),CO 005
   : RETURN