Listing of file='IDS2PU08' on disk='vmedia/701-2715B.wvd.zip'
# Sector 619, program filename = 'IDS2PU08' 1000 REM "IDS2PU08" - Convert TC file to IDEAS2 file - MOD 2 - 10/19/81 1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : F6$(11)="N" : DIM D$(1992)1,D1$(4)62,D2$(16)16 : GOSUB 1390 1030 IF D3>=C5THEN 1400 : DATA LOAD DA T#6,(D3,D3)D1$() : IF STR(D1$(),,1)<>HEX(F0)THEN 1030 : D5=D3-C2 : D3=D3-1 : IF C1=1THEN 1150 : D7=VAL(STR(D1$(),3)) : IF D7=0THEN 1040 : J4=1+INT((C4-1)/D7) : D2=(VAL(STR(D1$(),2))-3)/(D7+1) : D2=D2+(D5-1)*INT(246/(D7+1)) : D4=D2/J4 : GOTO 1270 1040 GOSUB '38(81," ") : KEYIN E6$ : GOTO 1400 1150 IF VAL(STR(D1$(),2,1))>84THEN 1160 : D4=INT((3*(D5-1)*80+VAL(STR(D1$(),2,1))-4)/C4) : GOTO 1180 1160 IF VAL(STR(D1$(),2,1))>165THEN 1170 : D4=INT((3*(D5-1)*80+VAL(STR(D1$(),2,1))-5)/C4) : GOTO 1180 1170 D4=INT((3*(D5-1)*80+VAL(STR(D1$(),2,1))-6)/C4) 1180 J6=1 : J1=1 : J8=C4 : GOSUB 1280 1190 J5=J7 : IF 81-J5>=J8THEN J3=J8 : ELSE J3=81-J5 : PRINT HEX(0E);AT(23,24);J1;" of";D4;HEX(0F); : D1=D1+1 : ON D1GOTO 1200,1210,1220 1200 STR(F$(),J6,J3)=STR(D1$(),3+J5,J3) : J9=J9+J3 : IF 3+J5+J3-1=83THEN 1240 : D1=0 : GOTO 1240 1210 STR(F$(),J6,J3)=STR(D1$(),84+J5,J3) : J9=J9+J3 : IF 84+J5+J3-1=164THEN 1240 : D1=1 : GOTO 1240 1220 STR(F$(),J6,J3)=STR(D1$(),165+J5,J3) : J9=J9+J3 : IF 165+J5+J3-1=245THEN 1230 : D1=2 : GOTO 1240 1230 D1=0 1240 J6=J6+J3 : J8=C4-J6+1 : IF J8<>0THEN 1250 : GOSUB 1290 : J1=J1+1 : IF J1>D4THEN 1400 : J8=C4 : F$()=ALL(00) : J6=1 1250 IF J9<>241THEN 1260 : GOSUB 1280 : J9=1 1260 J7=MOD(J9-1,80)+1 : GOTO 1190 1270 FOR J1=1TO D4 : PRINT HEX(0E);AT(23,24);J1;HEX(0F);" of";D4 : FOR J2=0TO J4-1 : IF D1=0THEN GOSUB 1280 : D1=D1+1 : STR(F$(),1+J2*D7)=STR(D1$(),4+(D1-1)*(D7+1),D7) : IF D1=INT(246/(D7+1))THEN D1=0 : NEXT J2 : GOSUB 1290 : F$()=ALL(00) : NEXT J1 : GOTO 1400 1280 DATA LOAD DA T#6,(C2,C2)D1$() : RETURN 1290 STR(D$(),,C4)=STR(F$(),,C4) : GOSUB 1300 : F6$(14)="N" : GOSUB '41(C1$,D2$(),.5) : F=0 : IF Q>0THEN GOSUB 1320 : IF F=1THEN RETURN : STR(F$(),,C4)=STR(D$(),,C4) : GOSUB '42(C1$,0) : RETURN 1300 W=1 : FOR C=28TO 40STEP 3 : IF STR(E1$(C3),C,2)=HEX(0000)THEN 1310 : STR(D2$(),W)=STR(F$(),MOD(VAL(STR(E1$(C3),C),2),32768)) : W=W+VAL(STR(E1$(C3),C+2)) 1310 NEXT C : RETURN 1320 IF F6$(22)="1"AND F6$(23)="3"THEN RETURN : IF F6$(22)="3"AND F6$(23)="3"THEN 1380 : D6=D6+1 : IF F6$(22)="2"OR F6$(23)="2"THEN GOSUB 1330 : IF F6$(23)="1"THEN GOSUB 1360 : SELECT PRINT 205 : RETURN 1330 SELECT PRINT 005 : IF MOD(D6,20)=1THEN PRINT HEX(03010F06);"MOVING RECORDS FROM TC FILE TO I DEAS2 FILE" : F6$(14)="Y" : GOSUB '38(82," ") : PRINT HEX(0E);AT(23,24);J1;HEX(0F);" of";D4; : PRINT AT(2+MOD(D6-1,20),0);STR(F$(),,MIN(C4,75)); : IF F6$(22)="2"THEN GOSUB 1340 : RETURN 1340 PRINT HEX(0E);AT(23,40);"Overwrite (Y/N)?";HEX(0F); : KEYIN E6$ : IF POS("YN1yn0"=E6$)=0THEN 1350 : PRINT AT(23,40,); : IF POS("Nn0"=E6$)>0THEN F=1 : RETURN 1350 GOSUB '38(9," ") : GOTO 1340 1360 IF F6$(22)="3"THEN F=1 : IF D6=1THEN $OPEN #1 : IF MOD(D6,58)=1THEN GOSUB 1370 : GOSUB '48(0,STR(F$(),,MIN(C4,75)),0) : IF F=0THEN GOSUB '48(77,"(O)",0) : GOSUB '49(0) : RETURN 1370 GOSUB '48(0,HEX(0C),0) : GOSUB '49(0) : GOSUB '48(13,"DUPLICATE RECORDS - ('O' means record was overwritten)",0) : GOSUB '49(0) : GOSUB '49(0) : RETURN 1380 F=1 : RETURN 1390 F6$(14)="Y" : D1,D4,D6=0 : J9,J7=1 : F$(),D$(),D1$()=ALL(00) : D3=C2 : GOSUB '38(82," ") : RETURN 1400 $CLOSE#1 : COM CLEAR C1 : IF C2$<>" "THEN SELECT #6<C2$> : IF F6$(20)="Z"THEN R3$()=STR(R3$(),19) : F6$(20)=" " : IF F6$(21)="C"THEN 1410 : R3$()=STR(R3$(),10) : P=2 : IF F6$(53)="Y"AND STR(R3$(),,4)<>"IDS2"THEN P=4 : LOAD T#P,R3$(1)1000, 1410 STR(F6$(),21,3)=" " : STR(R3$(),,9)=STR(R3$(),10) : E$="IDS2P001IDS2P004" : H=2 : E=21 : G=500 : COM CLEAR E1$() : IF F6$(17)<>HEX(60)THEN LOAD T#2,<2>E$1000, : COM CLEAR E() : LOAD T#2,"IDEAS2" 3699 ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PU08" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"