Listing of file='IDS2PF15' on disk='vmedia/701-2717B.wvd.zip'
# Sector 636, program filename = 'IDS2PF15'
1000 REM "IDS2PF15" - DATA FILE EDITOR - FILE DOCUMENTATION DISPLAY MODULE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB '32("IDS2sF15")
: DIM F8$(250)2,F9$(250)2,J(2)
: F=1
: F1$=E9$(1)OR ALL(20)
: MAT REDIM E$(6)83
: GOSUB '39(F1$,5)
: DATA LOAD DA T#P,(A)E$()
: F1$=STR(E$(),82,8)OR ALL(20)
: MAT REDIM E$(24)83,F$(24)83
: J5=5
: IF STR(F1$,,4)="ids2"THEN J5=2
: GOSUB '39(F1$,J5)
: IF Q=2THEN 1065
1062 GOSUB '35("Primary data file does not exist - FN '31 to CANCEL")
: GOSUB '34(250)
: IF Q<>31THEN 1062
: LOAD T#2,"IDS2MF01"1000,
1065 DATA LOAD DC OPEN T#J5,F1$
: DATA LOAD DC #J5,F$()
: STR(E$(),458)=" "
: STR(E$(),499)=STR(F$(),499)
: STR(E$(),93,12)=STR(F$(),93)
: STR(E$(),218,4)=STR(F$(),218)
: DATA LOAD DC #J5,F$()
: MAT REDIM E$(1992)1,F$(250)9
: GOSUB '36
: F1$=" "
: MAT SEARCHF$(),=STR(F1$,1,8)TO F9$STEP 8
: Z=MIN(249,(VAL(F9$,2)+7)/8-1)
: GOSUB '55(71,Z)
1090 MAT REDIM E3$(9)83
: DIM J$8
: J$="IDS2fs "
: A=(R0-#PART)/16+1
: IF A>0THEN CONVERT ATO STR(J$,7,2),(##)
: DATA LOAD DC OPEN T#2,J$
: DATA LOAD DC #2,E3$()
: MAT REDIM E3$(249)8
: MAT SEARCHE3$()<#PART*45-17,45>,=STR(E$(),105,3)TO F9$
: D1=INT((VAL(F9$,2)+2)/3)
: GOSUB '63(" ","Counting records currently on file - Please stand by"," ")
1110 FOR J=18TO 19
: GOSUB '43(J)
: J(J-17)=Q
: NEXT J
: GOSUB '43(1)
: LIMITS T#D1,E$,F8,B,E3,Q
: F4=VAL(STR(E$(),419))
: C2=VAL(STR(E$(),416))
: J7=VAL(STR(E$(),435),2)
: E3=(E3-2)/J7
: C1=0
: E3$()=F$()
: FOR J=0TO J7-1
: DATA LOAD BA T#D1,(J*E3+F8)STR(F$(),1,256)
: C1=C1+VAL(STR(F$(),9),2)
1150 GOSUB '55(66,C1)
: FOR Y=1TO 2
: IF J(Y)>0THEN GOSUB '55(66+Y,C1*100/J(Y))
: NEXT Y,J
: F$()=E3$()
: GOSUB '63(" "," "," ")
: MAT REDIM E3$(249)8,F$(250)8
: GOSUB '43(71)
: STR(F$(),Q*8+1)=ALL(FF)
: MAT SORTF$()TO F8$(),F9$()
: E3$()=ALL(20)
: MAT MOVE F$(),F9$(1),QTO E3$(1)
: X=Q
: GOSUB '45(69,"1")
: GOSUB '55(70,INT((X-1)/84)+1)
: MAT REDIM F$(E9)1,E$(E8)1
1190 GOSUB '43(69)
: FOR I=1TO 21
: PRINT HEX(060F);AT(I+1,43);
: FOR J=0TO 3
: X=(Q-1)*84+I+J*21
: IF X<1OR X>249THEN PRINT " ";
: ELSE PRINT " ";STR(E3$(X),1,8);
: NEXT J,I
: Q=32
: IF R3$(1)<>"IDS2MF01"THEN 1210
1200 GOSUB '63("Touch EXECUTE to"," document, FN'1-FN'3 to display field name
pages, or CANCEL"," ")
: GOSUB '34(250)
1210 ON QGOTO 1310,1320,1330
: IF Q<>32AND Q<>130THEN 1290
1220 $OPEN 1250,#1
: ERRORGOTO 1250
1230 GOTO 1270
1250 KEYIN E6$,1250,1260
: GOSUB '63("Printer not avail","able. Wait or CANCEL."," ")
: GOTO 1220
1260 IF E6$=HEX(1F)THEN 1290
: GOTO 1250
1270 $OPEN #1
: GOSUB 1340
: LOAD DC T#2,"IDS2PF16"1000,
1290 IF Q<>31THEN GOSUB 1340
: $CLOSE#1
: LOAD DC T#2,"IDS2MF01"1000,
1300 PRINT HEX(07);
: GOTO 1200
1310 GOSUB '45(69,"1")
: GOTO 1190
1320 GOSUB '43(70)
: IF Q<2THEN 1300
: GOSUB '45(69,"2")
: GOTO 1190
1330 GOSUB '43(70)
: IF Q<3THEN 1300
: GOSUB '45(69,"3")
: GOTO 1190
1340 F1$=STR(E$(),2,8)OR ALL(20)
: GOSUB '43(2)
: IF Q>4THEN MAT REDIM E$(6)83
: ELSE MAT REDIM E$(24)83
: GOSUB '39(F1$,5)
: DATA SAVE DA T#P,(A)E$()
: MAT REDIM E$(E8)1
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PF15"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"