Listing of file='IDS2PF05' on disk='vmedia/701-2717B.wvd.zip'
# Sector 42, program filename = 'IDS2PF05'
1000 REM "IDS2PF05" - DATA FILE EDITOR - RECALL PARAMETERS FOR EDIT, DELETE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: IF F1$=" "THEN F1$=STR(F$(),Z*8-7,8)
: R3$(1)="IDS2PF03"
: GOSUB '45(6,F1$)
1050 GOSUB '34(6)
: GOSUB '71(E$)
: IF Q=0THEN GOSUB '35("Field name does not exist - Please re-enter")
: IF Q=0THEN 1050
: F1$=E$
: J9,J2=Q*6+493
: ROTATE(STR(E$(),J2+5,1),4)
: F4=255
: C0=7
: IF STR(E$(),J2+3,2)<>HEX(0000)THEN 1130
: J2=1
: J3=1992
: D7=1
: GOTO 1180
1130 D7=2
: GOSUB '45(7,STR(F$(),VAL(STR(E$(),J2+3))*8-7,8))
: F4=VAL(STR(E$(),495+6*VAL(STR(E$(),J2+3))))
: GOSUB '55(8,VAL(STR(E$(),J2+4)))
: J2=INT(VAL(STR(E$(),493+6*VAL(STR(E$(),J9+3))),2)/16)
: J3=J2+F4-1
: C0=INT(MOD(VAL(STR(E$(),494+6*VAL(STR(E$(),J9+3)))),16)/2)
1180 GOSUB '55(9,VAL(STR(E$(),J9+2)))
: GOSUB '55(10,INT(VAL(STR(E$(),J9),2)/16))
: GOSUB '55(11,INT(MOD(VAL(STR(E$(),J9+1)),16)/2))
: IF MOD(VAL(STR(E$(),J9+1)),2)=1THEN GOSUB '45(12,"Y")
: ELSE GOSUB '45(12,"N")
: IF STR(E$(),J9+5,1)>=HEX(80)THEN GOSUB '45(13,"Y")
: ELSE GOSUB '45(13,"N")
: E6$=STR(E$(),J9+5)AND HEX(7F)
: HEXUNPACKE6$TO STR(E$(),497,2)
: GOSUB '37(14)
: GOSUB '37(15)
1280 IF F8=3THEN 1300
: ELSE LOAD DC T#2,"IDS2PF06"1000,
1300 GOSUB '43(6)
: GOSUB '71(E$)
: E6$=BIN(Q)
: MAT SEARCHE$()<502,1490>,=E6$TO F8$()STEP 6
1340 E8$="Touch FN'9 to de"
: F0$="lete,"
: IF F8$(1)<>HEX(0000)THEN F0$=F0$&" FN'25 to delete "&F1$&" & sub-fields,"
: F0$=F0$&" FN'31 to abort"
: GOSUB '63(E8$,F0$," ")
: GOSUB '34(250)
: IF Q=31THEN 1710
: IF Q<>9AND Q<>25THEN 1340
: F4$()=ALL(FF)
: N,Y=1
: F4$(1)=BIN((J9-493)/6)
: IF Q=9THEN 1540
: X=1
1470 IF F8$(X)=HEX(0000)THEN 1520
: N=N+1
: BIN(F4$(N))=(VAL(F8$(X),2)+5)/6
: X=X+1
: GOTO 1470
1520 Y=Y+1
: IF F4$(Y)=HEX(FF)THEN 1540
: MAT SEARCHE$()<502,1490>,=STR(F4$(),Y,1)TO F8$()STEP 6
: GOTO 1470
1540 MAT SORTF4$()TO F8$(),F9$()
: FOR I=POS(F4$()=FF)-1TO 1STEP -1
: P=VAL(F4$(VAL(F9$(I),2)))-1
: STR(E$(),P*6+499)=STR(E$(),P*6+505)&ALL(00)
: MAT SEARCHE$()<502,1490>,>=STR(F4$(I))TO F8$()STEP 6
: J=1
1600 IF F8$(J)=HEX(0000)THEN 1630
: IF STR(E$(),501+VAL(F8$(J),2),1)=F4$(I)THEN STR(E$(),501+VAL(F8$(J),2),2)
=ALL(00)
: ELSE ADD(STR(E$(),501+VAL(F8$(J),2),1),FF)
: J=J+1
: GOTO 1600
1630 STR(F$(),P*8+1)=STR(F$(),P*8+9)&ALL(20)
: NEXT I
: F1$=" "
: IF D7=1THEN D3=D3-1
: GOTO 1710
1670 DEFFN'71(E$)
: MAT SEARCHF$(),=STR(E$,1,8)TO F9$STEP 8
: Q=INT((VAL(F9$,2)+7)/8)
: RETURN
1710 LOAD DC T#2,"IDS2PF03"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PF05"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"