Listing of file='IDS2PF10' on disk='vmedia/701-2717B.wvd.zip'
# Sector 358, program filename = 'IDS2PF10' 1000 REM "IDS2PF10" - DATA FILE EDITOR - KEY FIELD SELECTION MODULE 1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : DIM F9$(250)2,F8$(250)2,F1$8,F4,C0,J5,J2,J3,Z,F8 : GOSUB '32("IDS2sF10") : IF F6$(18)="R"THEN F6$(11)="N" : F6$(12),F6$(13)="N" : F=1 : F1$=STR(E$(),2,8) : GOSUB '37(1) : GOSUB '37(5) : IF STR(E$(),10,1)>"4"THEN F7$=STR(E$(),82) : ELSE F7$=STR(E$(),2) : GOSUB '45(2,F7$) : GOSUB '45(3,"1") 1100 OR (F7$,20) : GOSUB '39(F7$,5) : MAT REDIM E$(24)83,F$(24)83 : DATA LOAD DA T#P,(A)E$(),F$() : MAT REDIM F$(250)8,E$(6)83 : OR (F1$,20) : GOSUB '39(F1$,5) : DATA LOAD DA T#P,(A)E$() : MAT REDIM E$(E8)1 : GOSUB '45(3,"1") 1200 F7$=" " : MAT SEARCHF$(),=STR(F7$,1,8)TO F9$STEP 8 : Z=INT(VAL(F9$,2)/8) : IF Z=0THEN STR(E$(),108,93)=ALL(20) : IF Z=0THEN Q=32 : IF Z=0THEN 1670 : E3$()=ALL(20) : STR(F$(),VAL(F9$,2))=ALL(FF) : MAT REDIM F$(250)8 : MAT SORTF$()TO F8$(),F9$() : STR(F$(),VAL(F9$,2))=ALL(20) : MAT MOVE F$(),F9$(1)TO E3$(1) : MAT REDIM F$(E9)1 : CONVERT Z/84+.999TO E$,(#) : GOSUB '45(4,E$) 1330 GOSUB '43(3) : PRINT HEX(060F) : FOR I=2TO 22 : PRINT AT(I,43); : FOR J=1TO 4 : X=(Q-1)*84+I-1+(J-1)*21 : IF X<250THEN PRINT " ";STR(E3$(X),1,8); : ELSE PRINT " "; : NEXT J,I : F=6 : GOSUB '36 : GOSUB '43(6) : IF D2<>1THEN 1600 : DIM J(5),J1(5),J2(5),J3(5),J4(5) : J=0 : FOR I=1TO Z : J9=I*6+493 : IF STR(E$(),J9+3,2)<>HEX(0000)THEN 1480 1475 J=J+1 : IF J>5THEN 1480 : J1(J)=INT(VAL(STR(E$(),J9),2)/16) : J(J)=I : J2(J)=VAL(STR(E$(),J9+2)) 1480 NEXT I : MAT J3=J : MAT J4=J1 : ON JGOTO 1590 : J=MIN(J,5) : FOR I=1TO J-1 : FOR K=I+1TO J : IF J4(K)>J4(I)THEN 1540 : L=J4(K) : J4(K)=J4(I) : J4(I)=L : L=J3(K) : J3(K)=J3(I) : J3(I)=L 1540 NEXT K,I : FOR I=1TO J-1 : IF J4(I)+J2(J3(I))=J4(I+1)THEN 1580 1570 GOSUB '35("Field specifications do not form a valid key , '31 to cancel") : GOSUB '34(250) : IF Q<>31THEN 1570 : LOAD T#2,"IDS2PF01"1000, 1580 NEXT I 1590 MAT REDIM F$(250)8 : FOR I=1TO J : F=I*5+1 : GOSUB '45(F,F$(J3(I))) : GOSUB '43(F+4) : IF E$=" "THEN GOSUB '45(F+4,"+") : NEXT I : MAT REDIM F$(E9)1 1600 Q=1 : IF E$=" "THEN 1870 : GOSUB 1970 : GOTO 1650 1640 PRINT HEX(07) 1650 GOSUB '63("Touch appropriat","e FN for key field or field name page, EXE CUTE to accept"," ") 1660 GOSUB '34(250) 1670 IF Q=32OR Q=130THEN 2510 : $TRAN(E6$,HEX(061107120813))R : ON VAL(E6$)GOTO 1870,1870,1870,1870,1870,1720,1750,1810 : GOTO 1640 1720 GOSUB '45(3,"1") : GOTO 1200 1750 GOSUB '43(4) : IF Q<2THEN PRINT HEX(07); : IF Q<2THEN 1650 : GOSUB '45(3,"2") : GOTO 1200 1810 GOSUB '43(4) : IF Q<3THEN PRINT HEX(07); : IF Q<3THEN 1650 : GOSUB '45(3,"3") : GOTO 1200 1870 X=Q : F=Q*5+1 1890 IF D2<>1THEN GOSUB '34(F) : ELSE GOSUB '43(F) : GOSUB 1970 : GOSUB '43(F) : IF E$=" "THEN 1650 : F=F+4 : IF F<10OR F>30OR MOD(F,5)<>0THEN 1940 : GOSUB '43(F) : IF E$=" "THEN GOSUB '45(F,"+") 1940 GOSUB '34(F) : IF E$="+"OR E$="-"THEN 1650 : GOSUB '35("Sort order specification must be '+' or '-'") : GOTO 1940 1970 DIM C(4) : C(1)=0 : C(2),C(3),C(4)=999 : FOR I=6TO 26STEP 5 2010 GOSUB '43(I-5) : F1$=E$ : GOSUB '37(I) : IF E$=" "THEN 2280 : IF I=6OR F1$<>" "THEN 2130 : FOR J=ITO 30 : GOSUB '43(J) : GOSUB '45(J-5,E$) : GOSUB '45(J," ") : NEXT J : I=I-5 : F=I : GOTO 2010 2130 GOSUB '43(I) : GOSUB '71(E$) : IF Q>0THEN 2210 : RETURN CLEAR 2170 F0$="Field "&E$&" is not defined in data file !" : GOSUB '35(F0$) : F=I : GOTO 1890 2210 J5=Q : J2=INT(VAL(STR(E$(),J5),2)/16) : GOSUB '55(I+1,J2) : F4=VAL(STR(E$(),J5+2)) : GOSUB '55(I+2,F4) : C0=INT(MOD(VAL(STR(E$(),J5+1)),16)/2) : GOSUB '55(I+3,C0) : C0=INT(C0/3.5)+2 : C(1)=C(1)+F4 : C(C0)=MIN(C(C0),C(1)+1-F4) 2280 GOSUB '43(I) : IF E$<>" "THEN 2340 : FOR J=I+1TO I+4 : GOSUB '45(J," ") : NEXT J : GOSUB '43(I) 2340 NEXT I : FOR I=2TO 4 : IF C(I)>C(1)THEN C(I)=C(1)+1 : NEXT I : C(4)=MAX(0,C(1)+1-C(4)) : C(3)=MAX(0,C(1)+1-C(4)-C(3)) : C(2)=MAX(0,C(1)+1-C(4)-C(3)-C(2)) : C(4)=C(1)-INT(C(2)/2)-INT((C(3)+MOD(C(2),2))/4) : FOR I=1TO 4 : GOSUB '55(30+I,C(I)) : NEXT I : RETURN 2460 DEFFN'71(E$) : MAT SEARCHF$(),=STR(E$,1,8)TO F9$STEP 8 : Q=VAL(F9$,2) : IF Q<>0THEN Q=(Q-1)/8*6+499 : RETURN 2510 X=0 : FOR I=8TO 28STEP 5 : GOSUB '43(I) : X=X+Q : NEXT I : IF X<81THEN 2520 : GOSUB '35("Specified key is longer than 80 bytes") : GOTO 1660 2520 IF STR(E$(),10,1)<"5"THEN MAT REDIM E$(24)83 : ELSE MAT REDIM E$(6)83 : GOSUB '43(1) : OR (E$,20) : GOSUB '39(E$,5) : DATA SAVE DA T#P,(A)E$() : MAT REDIM E$(E8)1 : IF STR(E$(),10,1)<"5"THEN COM CLEAR D2 : LOAD DC T#2,"IDS2PF11"1000, 3699 ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PF10" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"