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"