Listing of file='609Fprep' on disk='vmedia/701-2738G.wvd.zip'
# Sector 966, program filename = '609Fprep'
0010 REM '609Fprep' - PREPARE NEW ARCHIVE--for 2mc--10/17/84 & 10/25/84 by DGF
- 07/12/90 Support DS with 2200 type still at 1233 sectors. KKB
0020 DIM S5(1),S0(1),S3(1)
: DIM T1$(1)1,S1$(1)2
: DIM T1(3),S6(3),S1(3),T2$(3)80
: DIM T2(1),S7(1),S2(1),S4(1)
: DIM S2$(1)2,S1$1,S2$1,T1$80,T2$2,S0,S4,S5,S6,S7,S9,T0,T2,T3,T5,C0,T7
: A5$()="609FG070Prime 62"
: LOAD T<2>A5$()3000,BEG 90
0090 PRINT AT(21,0,239);
: DIM D0$5
: RESTORE LINE2520
: GOSUB '61
: T5$()=B5$
0160 GOSUB '62
: IF T5=0THEN 850
: IF VER(STR(T5$(),1,1),"A")=1THEN 230
: GOSUB 2560
: PRINT AT(23,0,);B2$;HEX(07);
: GOTO 160
0230 STR(D0$,5,1),B5$=T5$()
: S8=POS(" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"=B5$)
: DATA LOAD DA T#0,(B3+S8-1)A0$()
: IF STR(A0$(),2,8)<>" "THEN 300
: GOSUB 2570
: PRINT AT(23,0,);B2$;HEX(07);
: GOTO 160
0300 GOSUB 2580
: PRINT AT(22,0,);B2$;
: GOSUB '34(0)
: IF J$=HEX(F0)THEN 850
: DATA LOAD BA T#D(9),(0)STR(D0$(),1,256)
: ERRORD(20)=ERR
: GOSUB 900
: GOTO 300
0340 DATA SAVE BA T#D(9),(0)STR(D0$(),1,256)
: ERRORD(20)=ERR
: GOSUB 900
: GOTO 300
0360 IF D$(3)="1"THEN 430
: RESTORE LINE2661
: FOR X=1TO 5
: READ Y
: DATA LOAD BA T#D(9),(Y)STR(D0$(),1,256)
: ERRORGOTO 430
0361 NEXT X
0380 GOSUB 2590
: PRINT AT(23,0,);B2$;HEX(07);
: GOSUB '34(1)
: GOTO 850
0430 STR(D0$,1,4)=STR(A0$(),14,4)
: CONVERT STR(A0$(),14,4)TO S7
: S7=S7+1
: IF S7>9999THEN S7=1
: CONVERT S7TO STR(A0$(),14,4),(####)
: IF D$(3)="2"THEN 630
: B2$=" "
: LIMITS T#D(9),D0$,D1,D(2),S0,D(3)
: ERRORGOSUB 2660
: PRINT AT(23,0,);B2$;HEX(07);
: GOSUB '34(1)
: IF B2$<>" "THEN 988
: GOTO 850
0520 IF D(3)<>0THEN 430
: DATA SAVE DC OPEN T#D(9),(1233)D0$
: ERRORGOSUB 2600
: PRINT AT(23,0,);B2$;HEX(07);
: GOSUB '34(1)
: GOTO 850
0550 DBACKSPACE #D(9),BEG
: DSKIP #D(9),1231S
: DATA SAVE DC #D(9),END
: DATA SAVE DC CLOSE#D(9)
: LIMITS T#D(9),D0$,D1,D(2),S0,D(3)
: IF D(3)<>2OR D(2)-D1+1<>1233THEN 430
0630 DATA SAVE DA T#0,(B3+S8-1)A0$()
: GOSUB 2610
: PRINT AT(22,0,);B2$;
: GOSUB '34(0)
: IF J$=HEX(F0)THEN 850
: GOSUB 2620
: PRINT AT(23,0,79);B2$;
: D2$()=ALL(00)
: FOR C=D1+0TO D1+15
: DATA SAVE BA T#D(9),(C)D2$()
: ERRORD(20)=ERR
: GOTO 1000
0740 NEXT C
: CONVERT STR(D0$,1,4)TO S7
: PACK(####)D1$FROMS7
: STR(D1$,3,1)=STR(D0$,5,1)
: D2$()=D1$&D0$&ALL(00)
: DATA SAVE BA T#D(9),(D1+0)D2$()
: ERRORD(20)=ERR
: GOTO 1000
0820 D2$()=HEX(FFFF)&ALL(00)
: DATA SAVE BA T#D(9),(D1+8)D2$()
: ERRORD(20)=ERR
: GOTO 1000
0850 COM CLEAR D1
: LOAD T"609Fmenu"
0870 DEFFN'31
: COM CLEAR C
: LOAD T"609menu"
0900 IF D(20)<>93THEN 940
: GOSUB 2630
: GOTO 960
0940 IF D(20)<>95THEN 980
: GOSUB 2640
0960 PRINT AT(23,0,);B2$;HEX(07);
: GOSUB '34(1)
0980 RETURN
0988 PRINT HEX(03);AT(11,0);"Select another archive location";AT(13,9);"or";AT
(15,0);"Edit the Archive Assignments by using the Manage System Configura
tion menu";
: GOSUB '34(1)
: GOTO 850
1000 B2$=" "
: IF X3=93THEN GOSUB 2630
: IF X3=95THEN GOSUB 2640
: IF B2$=" "THEN GOSUB 2650
: PRINT AT(23,0,);B2$;HEX(07);
: GOSUB '34(1)
: GOTO 850
2500 % LANGUAGE ISOLATION
2520 DATA 4,0,0,"DOCUMENT FILING"
: DATA 4,22,0,"Creation Library is "
: DATA 2,22,20,1," "
: DATA 0
2560 B2$="Invalid Library"
: RETURN
2570 B2$="Library Does Not Exist"
: RETURN
2580 B2$="Mount Formatted Archive"
: RETURN
2590 B2$="Archive Mounted must be a WP diskette"
: RETURN
2600 B2$="Archive Disk is Full"
: RETURN
2610 B2$="Archive : "&D0$
: RETURN
2620 B2$="(In Progress)"
: RETURN
2630 B2$="Archive is not formatted"
: RETURN
2640 B2$="Archive is write protected"
: RETURN
2650 B2$="Error occurred while preparing archive = ##"
: CONVERT D(20)TO STR(B2$,POS(B2$="#"),2),(##)
: RETURN
2660 B2$="Error: 'Type of Archive' is wrong."
: RETURN
2661 DATA 1232,1280,1440,4160,4800