Listing of file='IDS2PF17' on disk='vmedia/701-2717B.wvd.zip'
# Sector 759, program filename = 'IDS2PF17'
1000 REM "IDS2PF17" - DATA FILE EDITOR - PRINT DATA FILE FIELD DOCUMENTATION
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: SELECT PRINT 005
: DIM F8$(249)2,F9$(249)2
: MAT REDIM F$(249)8,E2$(249)8,E0$(249)1
: C2=Q-1
: MAT SORTF$()TO F8$(),F9$()
: MAT MOVE F$(),F9$(1)TO E3$(1)
: GOSUB '71(" F = Fill character for right-justified numerics (zero o
r blank)")
: GOSUB '49(0)
1033 GOSUB '71(" D = Number of decimal specified decimal places (for num
eric fields)")
: GOSUB '49(0)
: GOSUB '71(" U = User code - specifies the minimum user level for ac
cess to the field")
: GOSUB '49(0)
1035 GOSUB '71(" SUB OF = If a sub-field, the name of the parent field")
: GOSUB '49(0)
: GOSUB '71(" POS = If a sub-field, the starting position within the pa
rent field")
: GOSUB '49(0)
: GOSUB '49(0)
: CONVERT STR(E$(),480,3)TO C3
: E2$()=ALL(FF)
: FOR I=1TO C3
: E2$(I)=STR(E$(),493+I*6,6)XOR HEX(0000FF000000)
: NEXT I
1050 MAT SORTE2$()TO F8$(),F9$()
: MAT REDIM E2$(250)9
: MAT MOVE F$(),F9$(1)TO E2$(1)
: MAT REDIM F$(E9)1
: J5=1
: FOR I=1TO C3
: IF I=1THEN 1090
: IF MOD(I+C2+27,50)>0THEN 1130
: J5=J5+1
1080 GOSUB '71(HEX(0C))
: GOSUB '49(0)
: GOSUB '71(HEX(22))
: GOSUB '48(0,STR(E$(),2,8),0)
: GOSUB '48(0,HEX(22),0)
: GOSUB '48(-1,"DATA FILE DOCUMENTATION",0)
: E$=STR(R2$,1,2)&"/"&STR(R2$,3,2)&"/"&STR(R2$,5)&" PAGE 1 OF X"
: GOSUB '48(60,E$,0)
: CONVERT INT((C3+32)/47)+1TO E0$(81),(#)
: CONVERT J5TO STR(E0$(),76,1),(#)
: GOSUB '49(0)
: GOSUB '49(0)
1090 GOSUB '71(" Field attributes in alphabetic order")
: GOSUB '48(-5,"Field attributes by position in record",0)
: GOSUB '49(0)
: GOSUB '71(" ========================================")
: GOSUB '48(-2,"========================================",0)
: GOSUB '49(0)
1110 GOSUB '71(" FIELD POS LEN T J F D U SUB OF POS")
: GOSUB '48(-2,"FIELD POS LEN T J F D U SUB OF POS",0)
: GOSUB '49(0)
: GOSUB '71(" -------- ---- --- - - - - - -------- ---")
: GOSUB '48(-2,"-------- ---- --- - - - - - -------- ---",0)
: GOSUB '49(0)
1130 FOR J=1TO 2
: IF J=1THEN E$=E3$(I)
: ELSE E$=E2$(I)
: MAT SEARCHF$(),=STR(E$,1,8)TO F9$STEP 8
: Q=INT(VAL(F9$,2)/8)
: D4$=STR(E$(),499+Q*6,6)
: CONVERT INT(VAL(D4$,2)/16)TO STR(E$,9,5),(#####)
: STR(E$,9,POS(STR(E$,9)>30)-1)=" "
: CONVERT VAL(STR(D4$,3))TO STR(E$,14,4),(####)
: STR(E$,14,POS(STR(E$,14)>30)-1)=" "
1170 CONVERT INT(MOD(VAL(STR(D4$,2)),16)/2)TO STR(E$,19,1),(#)
: CONVERT STR(E$,19,1)TO C0
: IF MOD(VAL(D4$,2),2)=1THEN STR(E$,21)="R"
: IF INT(MOD(VAL(STR(D4$,6)),16)/8)=1AND STR(E$,21)="R"THEN STR(E$,23)="0"
: E6$=STR(D4$,6)
: AND (E6$,F0)
: HEXUNPACKE6$TO STR(E$,27,2)
: STR(E$,28)=" "
: IF STR(E$,19,1)="2"OR STR(E$,19,1)="3"THEN CONVERT MOD(VAL(STR(D4$,6)),8)
TO STR(E$,25,1),(#)
1210 X=VAL(STR(D4$,4))*8-7
: IF X<1THEN 1990
: STR(E$,29)=STR(F$(),X,8)
: CONVERT VAL(STR(D4$,5))TO STR(E$,37,4),(####)
: STR(E$,37,POS(STR(E$,37)>30)-1)=" "
1990 IF J=1THEN GOSUB '48(2,E$,0)
: ELSE GOSUB '48(44,E$,0)
: NEXT J
: GOSUB '49(0)
: NEXT I
: $CLOSE#1
: LOAD DC T#2,R3$(1)1000,
1995 DEFFN'71(E4$())
: GOSUB '48(0,E4$(),0)
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PF17"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"