image of READY prompt

Wang2200.org

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"