image of READY prompt

Wang2200.org

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"