Listing of file='IDS2PF01' on disk='vmedia/701-2717B.wvd.zip'
# Sector 330, program filename = 'IDS2PF01'
1000 REM "IDS2PF01" - FILE CREATION MODULE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM C2$1,D5$8,D6$3
: J2,J3=0
: GOSUB '32("IDS2sF01")
: F6$(12)="N"
: IF F6$(18)="R"THEN F6$(11)="N"
: E3$()=" "
: E$()="\E3"&E9$(1)
: STR(E$(),499)=ALL(00)
: E0=0
: STR(E$(),62,1),STR(E$(),74,1),STR(E$(),78,1)="0"
: STR(E$(),11,11)=" "&R2$
: STR(E$(),447,3)=R4$
: F=0
1070 F=F+1
1080 IF F>F0THEN 1330
: IF C2$>"4"AND F>15AND F<20THEN 1070
: IF F<>13AND F<>16AND F<>18THEN 1090
: GOSUB '43(F)
: IF E$=" "THEN GOSUB '45(F,"0")
1090 GOSUB '34(F)
: ON FGOTO 1130,1610,1620,,,,,,,,,,1660,1670,,1660,1670,1660,1670,1680
: GOTO 1070
1130 F7$=E$OR ALL(20)
: IF F7$<>E$THEN 1170
: GOSUB '35("Name must contain at least 1 upper case character")
: GOTO 1090
1170 GOSUB '39(F7$,5)
: J1=Q
: IF Q=0THEN 1070
: ON QGOTO 1230,1260
: F0$="Control file "&F7$&" is scratched"
: GOSUB '35(F0$)
: GOTO 1090
1230 F0$="Control file name "&F7$&" is in use as a program file"
: GOSUB '35(F0$)
: GOTO 1090
1260 IF N=18THEN MAT REDIM E$(24)83,E3$(24)83
: ELSE MAT REDIM E$(6)83
: DATA LOAD DA T#P,(A)E$()
: IF N=18THEN DATA LOAD DA T#P,(A+8)E3$()
: IF N=18THEN J3=A+8
: ELSE J3=0
: J2=P
: MAT REDIM E$(E8)1,E3$(249)8
: C2$=E$(10)
: GOSUB '36
: GOSUB '43(3)
: D6$=E$
: GOSUB '43(20)
: IF E$<>" "THEN 1315
: IF STR(E$(),10,1)>"4"THEN 1320
: GOSUB '43(1)
: GOSUB '45(20,E$)
1315 D5$=E$
: OR (E$,20)
: J5=5
: IF STR(E$,,4)="ids2"THEN J5=2
: DATA LOAD DC OPEN T#J5,E$
: MAT REDIM F$(6)83
: DATA LOAD DC #J5,F$()
: MAT REDIM F$(E9)1
: GOSUB 1720
1320 IF E0=0THEN 1330
: F=1
: E0=0
: GOTO 1070
1330 IF C2$>"4"THEN PRINT AT(22,0,80);AT(22,5);BOX(1,69);HEX(0F);" For an alt
ernate file, FN '09 will detach from primary file";
: F0$=" accept and save control file, EDIT to modify"
: IF F6$(18)<>"R"THEN F0$=F0$&", FN'31 to CANCEL"
: IF C2$>"4"AND Q>-1THEN STR(F0$,8,17)=", FN'09 to detach"
1332 GOSUB '63("Touch EXECUTE to",F0$," ")
1340 F6$(11)="N"
: GOSUB '34(250)
: IF F6$(18)<>"R"AND Q=31THEN LOAD DC T#2,"IDS2MF01"1000,
: IF Q<>31THEN 1360
: GOSUB '35("Cancel prohibited after detaching file from primary")
: GOTO 1340
1360 IF Q<>33THEN 1370
: E0=1
: F=2
: GOTO 1090
1370 IF C2$>"4"AND Q=9THEN 1810
: IF Q<>32THEN PRINT HEX(07);
: IF Q<>32THEN 1330
: IF C2$>"4"AND D5$=" "THEN 1760
: GOSUB '43(2)
: IF Q<5THEN MAT REDIM E$(24)83,E3$(24)83
: ELSE MAT REDIM E$(6)83
: IF Q<5THEN X=18
: ELSE X=4
: OR (E$,20)
: GOSUB '39(F7$,5)
: J0=Q
: J5=P
: GOSUB '43(4)
: IF E$=" "THEN Q=-1
: GOSUB '55(4,Q+1)
: GOSUB '45(5,R4$)
: FOR I=0TO 2
: GOSUB '45(I+6,STR(R2$,2*I+1,2))
: NEXT I
1500 IF J0>0THEN DATA LOAD DC OPEN T#J5,F7$
: ELSE DATA SAVE DC OPEN T#J5,(X)F7$
: STR(E$(),1,1)="\E3"
: DATA SAVE DC #J5,E$()
: IF J3=0THEN 1527
: MAT REDIM E3$(24)83
: DATA LOAD DA T#J2,(J3)E3$()
1527 IF X=18AND J2=0THEN E3$()=" "
: IF X=18THEN DATA SAVE DC #J5,E3$()
: DATA SAVE DC #J5,END
: MAT REDIM E$(E8)1,E3$(249)8
: GOSUB '43(2)
: IF E$>"4"THEN LOAD DC T#2,"IDS2PF10"1000,
: IF J3=0THEN 1580
: MAT REDIM E3$(24)83
: DATA LOAD DA T#J2,(J3)E3$()
: MAT REDIM E3$(249)8
1580 LOAD DC T#2,"IDS2PF02"1000,
1610 IF Q>0AND Q<8THEN 1612
: GOSUB '35("File type must be 1-7. Please re-enter")
: GOTO 1080
1612 IF C2$<"5"AND Q<5OR Q>4OR C2$=" "THEN 1613
: GOSUB '35("You cannot change from an alternate to a primary file type")
: GOTO 1080
1613 IF Q=2OR Q=3OR STR(E$(),217,1)<"2"THEN 1615
: GOSUB '35("Multi-volume files must be Type 2 or Type 3")
: GOTO 1080
1615 GOSUB '43(3)
: IF E$<>" "THEN 1070
: MAT REDIM F$(9)83
: DIM J$8
: J$="IDS2fs "
: B=(R0-#PART)/16+1
: IF B>0THEN CONVERT BTO STR(J$,7,2),(##)
: DATA LOAD DC OPEN T#2,J$
: DATA LOAD DC #2,F$()
: MAT REDIM F$(E9)1
: GOSUB '45(3,STR(F$(),#PART*45+1,3))
: GOTO 1070
1620 IF STR(E$(),404,1)=HEX(01)OR E$=D6$OR E0<>1OR J1<>2THEN 1623
: GOSUB '35("You cannot change the volume-one address of a multi-volume fil
e.")
: GOTO 1090
1623 MAT REDIM F$(9)83
: DIM J$8
: J$="IDS2fs "
: B=(R0-#PART)/16+1
: IF B>0THEN CONVERT BTO STR(J$,7,2),(##)
: DATA LOAD DC OPEN T#2,J$
: DATA LOAD DC #2,F$()
: MAT REDIM F$(E9)1
: MAT SEARCHF$()<#PART*45-17,45>,=STR(E$,1,3)TO F9$STEP 3
: IF F9$=HEX(0000)OR F9$=HEX(0010)THEN 1630
1625 Q=(VAL(F9$,2)+2)/3
: LIMITS T#Q,E9$(1),Q,Q,Q,Q
: ERRORGOSUB '35("Disk error on specified device -- check device or re-ente
r")
: GOTO 1090
1627 IF Q=0OR J1>0THEN 1070
: F0$="File '"&E9$(1)&"'alreadyexistsondevice"&E$
: GOSUB '35(F0$)
: GOTO 1080
1630 E$=E$&"notselected"
: F0$=". Must be"
: FOR I=1TO 14
: IF I=5THEN 1650
: E8$=STR(F$(),#PART*45-17+3*I,3)
: MAT SEARCHF0$,=STR(E8$,1,3)TO F9$
: IF F9$=HEX(0000)THEN STR(F0$,LEN(F0$)+2)=E8$
1650 NEXT I
: GOSUB '63(E$,F0$,"!")
: GOTO 1080
1660 IF E$>="0"AND E$<="9"THEN 1070
: IF E$>="A"AND E$<="F"THEN 1070
: GOSUB '35("Must be 0 - 9 or A - F")
: GOSUB '45(F,"0")
: GOTO 1080
1670 E7$=E$
: GOSUB '43(F-1)
: IF E7$=R4$AND R8$<E$THEN GOSUB '35("You won't be able to edit this datafi
le again !")
: E$=E7$
: F6$(14)="N"
: GOSUB '41("IDS2f005",E$,0)
: F6$(14)="Y"
: IF F<19THEN 1070
: GOSUB '43(2)
: IF Q>4THEN 1070
: GOSUB '45(20,E9$(1))
: GOSUB '43(9)
: GOSUB '45(21,E$)
: F=20
1680 C2$=STR(E$(),10,1)
: IF C2$>"0"AND C2$<"5"THEN 1070
: IF D5$<>" "AND E$<>D5$THEN 1750
: IF E$<>" "THEN 1690
: GOSUB '38(0," ")
: GOTO 1090
1690 OR (E$,20)
: GOSUB '39(E$,5)
: IF Q=2AND N=18THEN 1700
1695 GOSUB '35("Invalid primary file name")
: GOTO 1090
1700 MAT REDIM F$(24)83
: DATA LOAD DA T#P,(A)F$()
: MAT REDIM F$(E9)1
: E6$=STR(F$(),10,1)
: IF E6$="2"OR E6$="3"THEN 1710
: GOTO 1695
1710 GOSUB 1720
: STR(E$(),201,8)=STR(F$(),201)
: GOSUB '43(20)
: D5$=E$
: GOTO 1070
1720 GOSUB '45(21,STR(F$(),22,32))
: GOSUB '45(16,STR(F$(),74,1))
: GOSUB '45(17,STR(F$(),75,3))
: GOSUB '45(18,STR(F$(),78,1))
: GOSUB '45(19,STR(F$(),79,3))
: RETURN
1750 F0$="File is attached to primary file "&D5$&" - must detach first"
: GOSUB '35(F0$)
: GOSUB '45(20,D5$)
: GOTO 1090
1760 MAT REDIM E$(6)83
: GOSUB '43(1)
: OR (E$,20)
: GOSUB '39(E$,5)
: IF Q=2AND A>0THEN DATA SAVE DA T#P,(A)E$()
: MAT REDIM E$(E8)1
: LOAD DC T#2,"IDS2MF01"1000,
1810 GOSUB '43(20)
: IF E$<>" "THEN 1850
: GOSUB '35("Primary file name is required - please enter a value")
: F=20
: GOTO 1090
1850 OR (E$,20)
: GOSUB '39(E$,5)
: IF A=0THEN 1880
: MAT REDIM E3$(24)83
: DATA LOAD DA T#P,(A)E3$()
: MAT SEARCHE3$()<275,128>,=STR(E$(),2,8)TO F9$STEP 8
: T=VAL(F9$,2)
: E$=" "
: IF T=0THEN 1855
: STR(E3$(),T+274,129-T)=STR(E3$(),T+282,121-T)&STR(E$,,8)
: IF A>0THEN DATA SAVE DA T#P,(A)E3$()
: MAT REDIM E3$(249)8
1855 D5$=" "
: GOSUB '45(20," ")
: GOSUB '45(21," ")
: F6$(18)="R"
: Q=-1
: GOTO 1330
1880 GOSUB '35("Invalid primary file name, Key '31 to CANCEL")
: F6$(11)="N"
: GOSUB '34(250)
: IF Q<>31THEN 1880
: GOTO 1330
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PF01"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"