Listing of file='IDS2PB01' on disk='vmedia/701-2725B.wvd.zip'
# Sector 277, program filename = 'IDS2PB01'
1000 REM "IDS2PB01" - Release 2.1 - BATCH PROGRAM GENERATOR - FIELD NAMES
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: MAT REDIM E$(24)83,F$(27)83,E3$(24)83
: DATA LOAD DA T#3,(E3)E$(),F$(),E3$()
: MAT REDIM E$(E8)1,F$(E9)1,E3$(249)8
: R3$(1)="IDS2PR05"
: GOSUB '32("IDS2sB00")
: GOSUB '36
1035 F6=INT((F6-1)/83)+1
: GOSUB '55(17,F6)
: E$=" "
: MAT SEARCHE3$(),=STR(E$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN F8=(VAL(F9$,2)-1)/8
: GOSUB '55(18,INT((MAX(1,F8)-1)/84)+1)
: D1=Q
: MAT REDIM F$(249)9,E2$(249)9,E0$(249)1,E3$(249)8
: E0$(),E2$()=ALL(FF)
: IF F8=0THEN 1240
: FOR I=1TO F8
: F=MOD(VAL(STR(F$(I),6)),8)
: E$=" "
: IF F>0THEN CONVERT FTO E$,(#)
1170 E$=E$&E3$(I)
: MAT SEARCHE2$(),>=STR(E$,,9)TO F9$STEP 9
: P=VAL(F9$,2)
: M=INT(P/9)+1
: IF P<2233THEN MAT COPY -E2$()<P,2233-P>TO -E2$()<P+9,2233-P>
: IF M<249THEN MAT COPY -E0$()<M,249-M>TO -E0$()<M+1,249-M>
: STR(E2$(),P,9)=E$
: E0$(M)=BIN(I)
: NEXT I
1240 IF F8<249THEN STR(E2$(),F8*9+1)=" "
: GOSUB 1260
: GOTO 1310
1255 F7=F6*83-82
1260 FOR I=0TO 83
: IF I<83THEN PRINT AT(MOD(I,12)+11,11*INT(I/12)+2);STR(E2$(I+1+F6*83-83),,
1);" ";STR(E2$(I+1+F6*83-83),2,8)
: NEXT I
: RETURN
1310 MAT REDIM E2$(250)9
1320 E$="Touch EXEC to accept, any key listed in the upper left box, or FN'31
to cancel"
: GOSUB '63(STR(E$,,16),STR(E$,17)," ")
: GOSUB '34(250)
: ON Q+1GOTO 1400,1410,1410,1410,,,,,,1430
: ON Q-30GOTO 1390,1390,1430,1420
: STOP #
1390 LOAD T#2,R3$(1)1000,
1400 IF F8<249THEN 3000
1401 GOSUB '35("249 fields already defined. Touch EXECUTE or cancel (FN'31)")
: GOSUB '34(250)
: IF Q<>32THEN 1401
: GOTO 1320
1410 IF Q<=D1THEN 1413
1411 PRINT HEX(07);
: GOTO 1320
1413 PRINT HEX(060F);AT(22,72);Q
: F6=Q
: GOSUB 1255
: GOTO 1320
1420 R3$(1)="IDS2PB01"
: LOAD T#2,"IDS2PS17"1000,
1430 Z=Q
: IF F8=0THEN 1411
: E$=" Select field using cursor keys, then touch"
: IF Z=9THEN E$=E$&" DELETE (FN'9)"
: ELSE E$=E$&" EDIT"
: E$=E$&" or FN'31 to cancel."
: GOSUB '63(STR(E$,,16),STR(E$,17)," ")
: F7=MAX(1,F7)
1500 F7=MIN(F8,MAX(F7,1))
: PRINT HEX(060F);
: F=MOD(F7-1,83)
: Q=INT((F7-1)/83)+1
: IF Q=F6THEN 1530
: F6=Q
: PRINT HEX(060F);AT(22,72);Q
: GOSUB 1260
1530 PRINT HEX(0602040202000E);AT(MOD(F,12)+11,11*INT(F/12)+2);STR(E2$(F7),,1)
;" ";STR(E2$(F7),2,8);
: GOTO 1550
1540 PRINT HEX(07);
1550 KEYIN E6$,,1600
: ON POS(HEX(2008)=E6$)GOTO 1570,1580
: GOTO 1540
1570 F7=F7+2
1580 F7=F7-1
: GOSUB 1590
: GOTO 1500
1590 PRINT HEX(060F);AT(MOD(F,12)+11,11*INT(F/12)+2);STR(E2$(F+83*F6-82),,1);"
";STR(E2$(F+83*F6-82),2,8);
: RETURN
1600 $TRAN(E6$,HEX(0545064609490C4C0D4D21F0))R
: Q=VAL(E6$)
: ON QGOTO ,,,1620,1570,1580,1630,,1710,,,1640,1650,,,,,,,,,,,,,,,,,,1700,,
1800
: GOTO 1540
1620 F7=F8-1
: GOTO 1570
1630 F7=1
: GOTO 1580
1640 IF F7+12>F8THEN 1540
: F7=F7+11
: IF F>71THEN F7=F7-1
: GOTO 1570
1650 IF F7-12<1THEN 1540
: F7=F7-11
: IF F<11THEN F7=F7+1
: GOTO 1580
1700 GOSUB 1590
: GOTO 1320
1710 IF Z<>9THEN 1540
: GOTO 1720
1715 PRINT HEX(07);
1720 GOSUB '63("Touch DELETE (FN","'9) again to complete deletion or touch FN'
31 to cancel deletion"," ")
: KEYIN E6$,,1730
: GOTO 1715
1730 IF E6$=HEX(1F)THEN 1320
: IF E6$<>HEX(09)AND E6$<>HEX(49)THEN 1715
: X=F7*9-8
: STR(E2$(),X,2242-X)=STR(E2$(),X+9)
: E2$(249)=" "
: X=VAL(E0$(F7))
: STR(E0$(),F7)=STR(E0$(),F7+1)
: STR(E3$(),X*8-7)=STR(E3$(),X*8+1)
: STR(F$(),X*9-8)=STR(F$(),X*9+1)&ALL(00)
: MAT REDIM E3$(24)83,F$(27)83
: DATA SAVE DA T#3,(E3+8)F$()
: DATA SAVE DA T#3,(E3+17)E3$()
1764 GOTO 1035
1800 IF Z<>33THEN 1540
: E3$=STR(E2$(F7),2)
: F6=VAL(E0$(F7))
: GOTO 3020
3000 E3$=" "
: F6,F7=F8+1
3020 R3$(1)="IDS2PB01"
: LOAD T#2,"IDS2PR07"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PB01"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"