Listing of file='IDS2PR32' on disk='vmedia/701-2716B.wvd.zip'
# Sector 424, program filename = 'IDS2PR32'
1000 REM "IDS2PR32" - Release 2.1 - REPORT DOCUMENTATION (FIELDS )
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM J4$(7)8,J0$9,J1$1,J2$19,J3$32
: GOSUB '39(D9$,3)
: J6=P
: LIMITS T#J6,D9$,D1,D2,D2,D2
: IF C5$="B"THEN 1240
: IF D2<>2OR J1<1OR J2<0OR D9<0OR D1<2THEN 1230
: GOTO 1240
1230 F0$="Invalid report control file -- Exec to continue"
: GOSUB '53(F0$)
: GOSUB '34(250)
: PRINT HEX(0C0D)
: $CLOSE#1
: COM CLEAR J3
: LOAD T#2,"IDS2MR01"1000,
1240 D4,D5,J8=0
: MAT REDIM E$(18)83
: DATA LOAD DA T#J6,(D1)E$()
: MAT REDIM E$(E8)1
: J3$=STR(E$(),18,32)
: J4$()=STR(E$(),78,56)
: GOSUB 1740
: CONVERT STR(E$(),152,3)TO J1
: IF J1=0THEN 1700
: J2=MAX(1,ABS(INT(-J1*9/249)))
: D9=MAX(1,ABS(INT(-J1*8/249)))
: J0=6+J2
: MAT REDIM F$(3*J2)83
: DATA LOAD DA T#J6,(D1+6)F$()
: MAT REDIM F$(E9)1
: MAT REDIM E$(3*D9)83
: DATA LOAD DA T#J6,(D1+6+J2)E$()
1380 MAT REDIM E$(E8)1
: FOR J8=1TO J1
: J0$=STR(F$(),(J8-1)*9+1,9)&ALL(00)
: CONVERT J8TO E$,(###)
: STR(E$,5)=STR(E$(),(J8-1)*8+1,8)
1425 KEYIN E6$,1425,1426
: GOTO 1430
1426 IF VAL(E6$)<>31THEN 1430
: $CLOSE#1
: COM CLEAR J3
: LOAD T#2,R3$(1)1000,
1430 I=MOD(VAL(STR(J0$,6)),8)
: IF I=0THEN 1440
: STR(E$,14)=J4$(I)
1440 CONVERT VAL(STR(J0$,8))TO STR(E$,23,2),(##)
: A=23
: B=2
: GOSUB 2000
: CONVERT VAL(STR(J0$,5))TO STR(E$,26,3),(###)
: A=26
: B=3
: GOSUB 2000
: CONVERT VAL(J0$)TO STR(E$,30,3),(###)
: A=30
: B=3
: GOSUB 2000
: CONVERT VAL(STR(J0$,9))TO STR(E$,34,3),(###)
: A=34
: B=3
: GOSUB 2000
: CONVERT INT(VAL(STR(J0$,2),2)/16)TO STR(E$,38,4),(####)
: A=38
: B=4
: GOSUB 2000
1540 CONVERT INT(VAL(STR(J0$,2),2)/16)+VAL(J0$)-1TO STR(E$,43,4),(####)
: A=43
: B=4
: GOSUB 2000
: J1$=STR(J0$,6)AND HEX(50)
: STR(E$,48,1)="2"
: IF J1$=HEX(10)THEN STR(E$,48,1)="1"
: IF J1$=HEX(00)THEN STR(E$,48,1)="0"
: IF MOD(VAL(STR(J0$,3)),4)>1THEN STR(E$,50,1)="Y"
: ELSE STR(E$,50,1)="."
: IF MOD(VAL(STR(J0$,3)),2)=1THEN STR(E$,52,1)="Y"
: ELSE STR(E$,52,1)="."
1590 CONVERT MOD(VAL(STR(J0$,4)),8)TO STR(E$,54,1),(#)
: $TRAN(STR(E$,54,1),HEX(2E30))R
: J2$=".0123456789ABCDEFRP"
: STR(E$,56,1)=STR(J2$,INT(VAL(STR(J0$,7))/8),1)
: ERRORSTR(E$,56,1)="."
1610 IF STR(E$,48,1)<>"2"THEN CONVERT INT(MOD(VAL(STR(J0$,3)),16)/4)TO STR(E$,
58,1),(#)
: $TRAN(STR(E$,58,1),HEX(2E302E20))R
: IF MOD(VAL(STR(J0$,7)),8)>3THEN STR(E$,60,1)="Y"
: ELSE STR(E$,60,1)="."
: IF MOD(VAL(STR(J0$,7)),4)>1THEN STR(E$,62,1)="Y"
: ELSE STR(E$,62,1)="."
: IF MOD(VAL(STR(J0$,7)),2)=1THEN STR(E$,64,1)="Y"
: ELSE STR(E$,64,1)="."
: CONVERT J8TO STR(E$,66,3),(###)
1660 GOSUB '48(0,E$,0)
: D6=D6+1
: GOSUB '49(0)
: IF D6>57THEN GOSUB 1750
: NEXT J8
1700 D0=J1
: COM CLEAR J6
: MAT REDIM E$(18)83
: DATA LOAD DA T#J6,(D1)E$()
: MAT REDIM E$(E8)1
: LOAD T#2,"IDS2PR33"1000,
1740 IF D6<48THEN GOSUB 1860
: D7=2
: IF D6>43THEN 1750
: GOTO 1780
1750 D7=D7+1
: J4=J4+1
: GOSUB '48(0,HEX(0C),0)
: GOSUB '49(0)
: IF C5$="B"THEN Q=8
: ELSE Q=6
: IF Q=8THEN E$="PROGRAM"
: ELSE E$="Report"
: E$=E$&" "&HEX(22)&E9$(Q)&HEX(22)&" - "&J3$
: GOSUB '48(2,E$,0)
: E$=STR(R2$,1,2)&"/"&STR(R2$,3,2)&"/"&STR(R2$,5,2)&" Page ## of ##"
: CONVERT J4TO STR(E$,16,2),(##)
1755 CONVERT J9TO STR(E$,22,2),(##)
: GOSUB '48(57,E$,0)
: D6=1
: GOSUB '49(0)
: IF D7=1THEN GOSUB 1860
1780 GOSUB '48(0," ",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(24,"L",0)
: GOSUB '48(48,"T J Z S C B",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(24,"I C",0)
: GOSUB '48(48,"Y U F D G I M F L",0)
: D6=D6+1
: GOSUB '49(0)
1810 GOSUB '48(0,"FLD",0)
: GOSUB '48(16,"FILE N O LENGTH POSITION P S I E R G M L N FLD",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(1,"# NAME (IF ANY) E L MEM RPT BEG END E T L C P N A
T K #",0)
: D6=D6+1
: GOSUB '49(0)
1830 GOSUB '48(0,"--- -------- -------- -- --- --- --- ---- ---- - - - - - - -
- - ---",0)
: D6=D6+2
: GOSUB '49(0)
: GOSUB '49(0)
: RETURN
1860 D6=D6+1
: GOSUB '49(0)
: GOSUB '48(0,"Field Attribute Key:",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(0,"--------------------",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(0,"FLD# - Field Number",0)
: GOSUB '48(26,"RPT - Length in Report",0)
: GOSUB '48(60,"DEC - Decimal Places",0)
: D6=D6+1
: GOSUB '49(0)
1890 GOSUB '48(0,"NAME - Field Name",0)
: GOSUB '48(26,"BEG - Starting Buffer Pos.",0)
: GOSUB '48(60,"GRP - Grouping Level",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(0,"FILE - Associated File",0)
: GOSUB '48(26,"END - Ending Buffer Pos.",0)
: GOSUB '48(58,"**SIGN - Sign Code",0)
: D6=D6+1
: GOSUB '49(0)
1910 GOSUB '48(0,"LINE - Line on Report",0)
: GOSUB '48(26,"TYPE - Character Type (0-2)",0)
: GOSUB '48(60,"CMMA - Commas",0)
: D6=D6+1
: GOSUB '49(0)
1920 GOSUB '48(0,"COL - Column on Report",0)
: GOSUB '48(26,"JUST - Right Justified",0)
: E$="FLT - Floating "&HEX(22)&"$"&HEX(22)
: GOSUB '48(60,E$,0)
: D6=D6+1
: GOSUB '49(0)
1930 GOSUB '48(0,"MEM - Length in Memory",0)
: GOSUB '48(26,"ZFIL - Zero Fill (Left)",0)
: GOSUB '48(60,"BLNK - Blank After",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(67,"Print",0)
: D6=D6+2
: GOSUB '49(0)
: GOSUB '49(0)
1950 E$="*TYPE 0 = Unsigned Numeric 1 = Signed Numeric 2 = Alphanume
ric"
: GOSUB '48(5,E$,0)
: D6=D6+1
: GOSUB '49(0)
: E$="**SIGN 0 = "&HEX(22)&"-"&HEX(22)&" before 1 = "&HEX(22)
&"-"&HEX(22)&" after"
: GOSUB '48(4,E$,0)
: D6=D6+1
: GOSUB '49(0)
1970 E$="2 = "&HEX(22)&"DB"&HEX(22)&" after (-) 1 = "&HEX(22)&"CR"&HEX(22
)&" after (-)"
: GOSUB '48(16,E$,0)
: D6=D6+1
: GOSUB '49(0)
: RETURN
2000 Z=POS(STR(E$,A,B)<>HEX(30))
: IF Z<>0THEN 2020
: STR(E$,A,B)="."
: GOTO 2030
2020 IF Z<>1THEN $TRAN(STR(E$,A,Z-1),HEX(2030))R
2030 RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR32"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"