Listing of file='IDS2PC07' on disk='vmedia/701-2725B.wvd.zip'
# Sector 645, program filename = 'IDS2PC07'
1000 REM 'IDS2PC07' -- MENU CONVERSION
1006 COM D0
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM J1$(1024)1,C9$64,J1$8
: SELECT #D1<D1$>,#D2<C2$>
: D0=D2
: GOSUB '39(F1$,D1)
: J1$=F1$OR ALL(20)
: GOSUB '39(J1$,D1)
: IF Q=0THEN STOP #
: FOR I=0TO 3
: DATA LOAD BA T#D1,(A+8+I)STR(J1$(),I*256+1,256)
: NEXT I
: GOSUB '32("IDS2sM01")
: STR(E$(),9)=" "
: GOSUB '45(1,J2$)
: F=0
1090 F=F+1
: IF F>F0THEN 1310
: ON FGOTO 1150,1160,1170,1180,1190,1200,1210,1220,1230,1240,1250,1260,1260
: IF F>13AND F<110THEN 1130
: IF F=110THEN 1300
: GOTO 1090
1130 X=MOD(F-2,6)
: ON X+1GOTO 1270,1290
: GOTO 1090
1150 GOSUB '45(F,J2$)
: GOTO 1090
1160 GOSUB '45(F,"1")
: GOTO 1090
1170 GOSUB '45(F,STR(R2$,1,2))
: GOTO 1090
1180 GOSUB '45(F,STR(R2$,3,2))
: GOTO 1090
1190 GOSUB '45(F,STR(R2$,5,2))
: GOTO 1090
1200 GOSUB '45(F,STR(R4$,1,3))
: GOTO 1090
1210 GOSUB '45(F," ")
: GOTO 1090
1220 GOSUB '45(F," ")
: GOTO 1090
1230 GOSUB '45(F," ")
: GOTO 1090
1240 GOSUB '45(F," ")
: GOTO 1090
1250 GOSUB '45(F,"0")
: GOTO 1090
1260 GOSUB '45(F," ")
: GOTO 1090
1270 J9=(F-14)/6
: IF J9<12THEN C9$=STR(J1$(),J9*72+145,8)
: ELSE C9$=" "
: GOSUB '45(F,C9$)
: IF C9$<>" "THEN GOSUB '45(F+2,"I")
: ELSE GOSUB '45(F+2," ")
: IF C9$<>" "THEN GOSUB '45(F+3,"0")
: ELSE GOSUB '45(F+3," ")
: FOR I=F+4TO F+5
: GOSUB '45(I," ")
: NEXT I
: GOTO 1090
1290 IF J9<12THEN C9$=STR(J1$(),J9*72+153,64)
: ELSE C9$=" "
: GOSUB '45(F,C9$)
: GOTO 1090
1300 GOSUB '45(F,STR(J1$(),73,8))
: GOSUB '45(F+1,STR(J1$(),81,64))
: GOTO 1090
1305 PRINT HEX(07);
1310 GOSUB '53("EXEC=Accept, FN'0-FN'16=Edit a line, FN'31=Cancel")
: GOSUB '34(250)
: IF Q=32THEN 1790
: IF Q<17THEN 1330
: IF Q<>31THEN 1305
: GOTO 1960
1330 F=Q*6+14
: GOTO 1370
1350 F=F+1
: IF F>F0THEN 1310
1370 GOSUB '34(F)
: IF F>13AND F<110THEN 1380
: GOTO 1350
1380 X=MOD(F-2,6)
: ON X+1GOTO 1430,1450,1460,1400,1420,1390,1380
1390 GOTO 1310
1400 C1$=E$
: IF E$>="0"AND E$<="9"THEN 1350
: IF E$>="A"AND E$<="F"THEN 1350
: GOSUB '35("User class must be 0 - 9 or A - F. Please re-enter")
: GOTO 1370
1420 IF E$=" "THEN 1350
: GOSUB '41("IDS2f005",E$,0)
: IF Q=0THEN 1370
: ELSE GOTO 1350
1430 IF E$=" "THEN 1440
: GOSUB '43(F+3)
: IF E$=" "THEN GOSUB '45(F+3,C1$)
: GOTO 1350
1440 FOR I=F+1TO F+5
: GOSUB '45(I," ")
: NEXT I
: GOTO 1310
1450 GOSUB '43(F-1)
: IF E$=" "THEN F=F+3
: IF E$=" "THEN GOTO 1310
: GOTO 1350
1460 IF POS("IWX"=E$)>0THEN 1350
: GOSUB '35("Program type must be 'I', 'W' or 'X'. Please re-enter")
: GOTO 1370
1790 GOSUB '43(1)
: LIMITS T#D0,E$,X,B,C,D
: IF D=0THEN 1800
: IF B-X>6THEN 1820
: GOSUB '35("Not enough room in old file - PLEASE CANCEL")
: GOTO 1310
1800 DATA SAVE DC OPEN T#D0,(8)E$
: GOTO 1790
1820 SCRATCH T#D0,E$
: GOSUB '43(2)
: IF E$=" "THEN Q=-1
: GOSUB '55(2,Q+1)
: STR(E$(),12,9)=R2$&R4$
: E$=STR(E$(),1,8)
: $TRAN(E$(),HEX(A222))R
: F$()=HEX(40)&STR(E$,1,8)&HEX(FD)&ALL(00)
: DATA SAVE BA T#D0,(X)STR(F$(),1,256)
: FOR I=0TO 5
: F$()=HEX(00FF10)&BIN(I)&HEX(D3)&"E$(), )="&HEX(22)
: Q=I*234+1
: CONVERT QTO STR(F$(),11,4),(####)
1900 F$()=F$()&STR(E$(),Q,234)&HEX(220D0000FD)
: IF I<5THEN 1920
: STR(F$(),1,1)=HEX(20)
: STR(F$(),195)=HEX(223A9F)&"R3$(1)="&HEX(22)&"\C4\CF\CE\D4\CC\CF\C1\C4"&HE
X(22B19B3AA1)&"T#2,"&HEX(22)&"IDS2MX01"&HEX(22FF10002C0D0000FE)&ALL(00)
1920 DATA SAVE BA T#D0,(X+1+I)STR(F$(),1,256)
: NEXT I
: F$()=HEX(200008)&ALL(00)
: DATA SAVE BA T#D0,(X+7)STR(F$(),1,256)
: LOAD DA T#D0,(X)1000,1005BEG 1950
1950 SAVE T#D0,()E$1000,1005
1960 COM CLEAR D1$
: LOAD T#2,"IDS2PCMN"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PC07"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"