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"