Listing of file='IDS2PR39' on disk='vmedia/701-2716B.wvd.zip'
# Sector 552, program filename = 'IDS2PR39'
1000 REM "IDS2PR39" - Release 2.1 - BATCH PROGRAM DOCUMENTATION (FIELDS )
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM J4$(7)8,J0$9,J1$1,J2$18,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<1OR D9<1OR D1<3THEN 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)
: CONVERT STR(E$(),152,3)TO J1
: IF J1=0THEN 1700
: GOSUB 1740
: 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$,8)=STR(E$(),(J8-1)*8+1,8)
1425 KEYIN X$,1425,1426
: GOTO 1430
1426 IF VAL(X$)<>31THEN 1430
: $CLOSE#1
: COM CLEAR J3
: LOAD T#2,R3$(1)1000,
1430 I=MOD(VAL(STR(J0$,6)),8)
: IF I=0THEN 1480
: STR(E$,17)=J4$(I)
1480 CONVERT VAL(J0$)TO STR(E$,32,3),(###)
: A=32
: B=3
: GOSUB 2000
: CONVERT INT(VAL(STR(J0$,2),2)/16)TO STR(E$,38,4),(####)
: A=38
: B=4
: GOSUB 2000
: 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)
: IF VAL(J1$)>3THEN STR(E$,48,1)="2"
: ELSE IF J1$=HEX(10)THEN STR(E$,48,1)="1"
: ELSE IF J1$=HEX(00)THEN STR(E$,48,1)="0"
1570 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)="."
: 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)
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)),2)=1THEN STR(E$,60,1)="Y"
: ELSE STR(E$,60,1)="."
: CONVERT J8TO STR(E$,62,3),(###)
: 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)
: E$="PROGRAM "&HEX(22)&E9$(8)&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),(##)
: 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(48,"T J Z S B",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(48,"Y U F D G I L",0)
: D6=D6+1
: GOSUB '49(0)
: GOSUB '48(0,"FLD",0)
: GOSUB '48(16,"FILE LENGTH POSITION P S I E R G N FLD",0)
: D6=D6+1
: GOSUB '49(0)
1820 GOSUB '48(1,"# NAME (IF ANY) BEG END E T L C P N K
#",0)
: D6=D6+1
: GOSUB '49(0)
: 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$="IDS2PR39"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"