Listing of file='IDS2PU14' on disk='vmedia/701-2715B.wvd.zip'
# Sector 666, program filename = 'IDS2PU14'
1000 REM "IDS2PU14" - SETS UP E1$() - SEE PU05 FOR COMPLETE DOC
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM D$(6)83,D1$2,D2$8,D3$(16)8
: GOSUB '32("IDS2sU07")
: IF F6$(20)<>"X"THEN 1020
: PRINT HEX(0E);AT(0,15);"EXPAND IDEAS2 FILE - STEP 2: MOVE DATA BACK FROM
TC FILE";HEX(0F)
: GOSUB '45(1,E9$(1))
1020 D3=0
: D1$=F6$(53)
: F6$(53)="Y"
: E3$=HEX(1F)
: GOSUB '34(1)
: F6$(53)=D1$
: IF E6$=HEX(1F)THEN 1070
: GOSUB 2000
: IF F=0THEN 1020
: IF D3=0OR F6$(53)="Y"OR F6$(20)="Z"THEN 1060
: F6$(21)="C"
: GOSUB 3000
: COM CLEAR E1$()
: IF F6$(17)=HEX(60)THEN 1040
: LOAD T#2,"IDS2P001"1000,1001BEG 1060
1040 LOAD T#2,"IDS2P001"0,1001BEG 1050
1050 F0$="IDS2SUB1IDS2SUB2IDS2SUB3IDS2SUB4IDS2SUB5IDS2SUB6IDS2LOCL"
: LOAD T#2,<7>F0$0,999BEG 1060
1060 LOAD T#2,"IDS2PU07"1000,
1070 P=4
: IF STR(R3$(),,4)="IDS2"THEN P=2
: LOAD T#P,R3$(1)1000,
2000 D2$=E$OR ALL(20)
: GOSUB '39(D2$,5)
: IF Q<2THEN 2020
: DATA LOAD DA T#P,(A)D$()
: ERRORGOTO 2020
2010 IF STR(D$(),,1)<>"\E3"THEN 2020
: IF STR(D$(),403,1)<HEX(05)THEN 2030
: E$="File must be a primary: type 1-4."
: GOTO 2080
2020 E$="File is not an IDEAS2 data file."
: GOTO 2080
2030 IF STR(D$(),75,3)<>" "THEN IF R4$<>STR(D$(),75,3)THEN 2040
: IF STR(D$(),74,1)<>" "THEN IF R8$<STR(D$(),74,1)THEN 2050
: GOTO 2060
2040 E$="Another user has exclusive rights to read this file."
: GOTO 2080
2050 E$="Your user class is to small to read this file."
: GOTO 2080
2060 MAT SEARCHE1$(),=E$TO D1$STEP 56
: IF D1$=HEX(0000)THEN 2070
: RETURN
2070 IF F6$(53)<>"Y"THEN 2090
: E$="File is not open. Add it to your 'START' program."
2080 GOSUB '35(E$)
: F=F-1
: RETURN
2090 D3=1
: RETURN
3000 MAT SEARCHSTR(D$(),275,128),=HEX(2020202020202020)TO D1$STEP 56
: D4=-1+(VAL(D1$,2)+55)/56
: IF D4=-1THEN D4=16
: CONVERT STR(D$(),217,1)TO H
: H=H+D4
: G=1+VAL(STR(D$(),435),2)
: E=VAL(STR(D$(),416))+VAL(STR(D$(),417))
: IF D4>0THEN GOSUB 3010
: E=E+4
: G=G*E
: RETURN
3010 D3$()=STR(D$(),275)OR ALL(20)
: FOR J=1TO D4
: GOSUB '39(D3$(J),5)
: IF Q<2THEN 3020
: DATA LOAD DA T#P,(A)D$()
: E=MAX(E,VAL(STR(D$(),416))+VAL(STR(D$(),417)))
: NEXT J
: RETURN
3020 E$="Alternate control file "&D3$(J)&" doesn't exist. Please correct."
: GOSUB '35(E$)
: END
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PU14"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"