image of READY prompt

Wang2200.org

Listing of file='IDS2PBX2' on disk='vmedia/701-2717B.wvd.zip'

# Sector 606, program filename = 'IDS2PBX2'
1000 REM "IDS2PBX2" - Release 2.1 - REPORT/BATCH EXECUTION - SELECT/SORT PART
     1
1005 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM C1$(14)7
   : C1$()=ALL(FF)
   : UNPACK(########)STR(E$(),1729,12)TO C0,C1,C5
   : GOSUB '39(STR(F4$,4),4)
   : DATA LOAD BA T#P,(A+2)STR(F$(),,256)
   : E0$()=STR(F$(),95,42)
   : MAT REDIM E0$(14)3,E3$(14)2,F$(14)2
   : MAT SORTE0$()TO F$(),E3$()
   : MAT REDIM F$(14)8
   : MAT MOVE E0$(),E3$()TO F$()
1060 MAT REDIM F$(E9)1,E0$(249)1,E3$(24)83
   : STR(F$(),113)=" "
   : CONVERT R0TO F9$,(##)
   : F5$="@SORT"&F9$&"@"
   : I=1
1080 IF VER(STR(F$(),I),"3##")=3OR VER(STR(F$(),I),"B##")=3OR VER(STR(F$(),I),
     "D##")=3THEN 1090
   : IF STR(F$(),I)=" "THEN 1165
1085 STR(F$(),I)=STR(F$(),I+8)
   : GOTO 1080
1090 MAT SEARCHF$(),=STR(F$(),I,3)TO F9$STEP 8
   : IF VAL(F9$,2)<IAND F9$>HEX(0000)THEN 1085
   : MAT SEARCHE0$(),=STR(F$(),I,3)TO F9$STEP 3
   : D=(VAL(F9$,2)+5)/3
   : J5=0
   : IF D=2THEN 1110
1100 $OPEN 1120,#D
   : ERRORGOTO 1122
1105 $CLOSE#D
1110 $GIO#D,(0101020112124400,D2$)
   : ERRORGOTO 1122
1115 IF STR(D2$,8,1)<>HEX(10)THEN 1125
   : STR(F$(),I+3,5)="(off)"
   : GOTO 1155
1120 J5=J5+1
   : IF J5<20THEN 1100
1122 STR(F$(),I+3,5)="(off)"
   : GOTO 1155
1125 LIMITS T#D,F5$,A,B,C,Q
   : ERRORSTR(F$(),I+3,5)="(err)"
   : GOTO 1155
1130 C2=D
   : IF Q=0THEN 1140
   : X=B-A+1
   : E6$="1"
   : GOTO 1145
1140 DATA LOAD BA T#D,(0)E4$()
   : X=VAL(STR(E4$(),5),2)-VAL(STR(E4$(),3),2)
   : E6$="2"
1145 CONVERT XTO E$,(#####)
   : Q=X
   : STR(F$(),I+3,5)=E$
   : C1$(I/8+1)=E6$&BIN(65535-Q,2)&STR(F$(),I,3)&BIN(C2)
   : GOTO 1155
1155 I=I+8
   : GOTO 1080
1165 C2,C3,C4=0
   : IF E$(1492)<>" "THEN 1195
   : FOR I=1TO VAL(E$(1600))
   : E$(1485+I)=BIN(I+64)
   : NEXT I
1195 Z=LEN(STR(E1$(),1))/56
   : E1$(Z)=STR(F5$,,8)&" "&STR(E1$(VAL(STR(E1$(C1),10),2)),10,2)&HEX(08)&STR(
     E1$(C1),13)
   : STR(E1$(Z),28,15)=ALL(00)
   : FOR I=1TO 5
   : IF E$(1485+I)=" "THEN 1260
   : E$=STR(E$(),1602+(VAL(E$(1485+I))-65)*6,6)
   : L=VAL(STR(E$,3))
   : T=INT(MOD(VAL(E$,2),16)/2)
   : IF C3>0AND T<4THEN T=4
   : IF C4>0THEN T=7
   : IF T<4THEN C2=C2+L
1245 IF T>3AND T<7THEN C3=C3+L
   : IF T>6THEN C4=C4+L
   : STR(E1$(Z),I*3+25,3)=BIN(INT(VAL(E$,2)/16)+E(VAL(E$(VAL(E$(1485+I))+807))
     -47)-1,2)&STR(E$,3)
1260 NEXT I
   : STR(E1$(Z),21,3)=BIN(C2+C3+C4)&BIN(C2)&BIN(C3)
   : C3=C3+MOD(C2,2)
   : C4=C4+MOD(C3,4)
   : T=VAL(STR(E1$(C1),12))
   : C2=INT(C2/2)+3*INT(C3/4)+C4
   : E$=STR(E$(),1486,5)
   : P=VAL(STR(E1$(C1),25))
   : E8$="ABCDE"
   : E8$=STR(E8$,,VAL(STR(E$(),151))-48)
   : IF T>1AND T<>4THEN 1325
   : P=VAL(STR(E1$(C1),24))
   : ADD(STR(E1$(Z),12,1),01)
   : IF E$=STR(E8$,,LEN(E$))THEN C2=0
1325 X=C2+P+1
   : STR(E1$(Z),24,4)=BIN(C2)&BIN(P)&BIN(X,2)
   : Y=INT(1991/X)
   : X=ABS(INT(-C0/Y))
   : C6=X
   : C7=1
   : IF E$<>STR(E8$,,LEN(E$))THEN 1380
   : C6=VAL(STR(E1$(C1),43),2)
   : C7=ABS(INT(-C5/Y))
   : IF C7=1THEN C6=X
1380 C8=C6*C7*8+2
   : STR(E1$(Z),43,7)=BIN(C6,2)&BIN(C7*8)&BIN(C7*8,2)&BIN(Y*C7,2)
   : CONVERT C8TO STR(E$(),1741,5),(#####)
   : MAT REDIM E0$(14)2,F$(14)2
   : MAT SORTC1$()TO F$(),E0$()
   : FOR I=1TO 14
   : STR(C1$(I),2,2)=XOR ALL(FF)
   : NEXT I
   : MAT REDIM F$(14)7
   : MAT MOVE C1$(),E0$()TO F$()
   : MAT REDIM E0$(249)1,F$(E9)1
   : IF STR(E$(),857,3)=" "THEN STR(E$(),857,3)=STR(F$(),4)
1435 E$=STR(E$(),857,3)
   : J0=0
1440 MAT SEARCHF$()<4>,=STR(E$,,3)TO F9$STEP 7
   : IF F9$>HEX(0000)AND STR(E$,,3)<HEX(FFFFFF)THEN 1540
   : IF J0=0THEN GOSUB 1470
   : GOSUB '43(2)
   : IF STR(E$,,3)<HEX(FFFFFF)THEN 1457
1456 GOSUB '35("No disks are available. EXEC to re-try, FN '31 to cancel")
   : F6$(11)="N"
   : GOSUB '34(250)
   : IF Q=32THEN 1005
   : IF Q<>31THEN 1456
   : COM CLEAR F()
   : GOSUB '40(R3$(1))
1457 GOSUB '35("Invalid disk address.  Please choose only from those listed.")
   : F=1
   : GOTO 1590
1470 IF J0=1THEN RETURN
   : J0=1
   : GOSUB '32("IDS2sR13")
   : PRINT AT(14,13);"Disk device address for select/sort work file is:";
   : GOSUB '37(2)
   : FOR I=17TO 53STEP 18
   : PRINT AT(16,I);"Dev Space";
   : NEXT I
   : I=1
   : J=4
1490 IF STR(F$(),J,3)=" "OR STR(F$(),J,3)=HEX(FFFFFF)THEN 1510
   : GOSUB '45(I/4+5,STR(F$(),J,3))
   : PRINT AT(R,C+3);
   : X=VAL(STR(F$(),J-2),2)
   : GOSUB '55(I/4+6,X)
   : I=I+8
   : J=J+7
   : GOTO 1490
1510 GOSUB '55(3,C8)
   : E$=E$&" sectors"
   : IF STR(E$(),1468,18)=" "THEN E$=E$&" are"
   : ELSE E$=E$&" may be"
   : E$=E$&" required."
   : PRINT AT(R,C);E$
   : RETURN
1540 Y=VAL(STR(F$(),VAL(F9$,2)+1),2)
   : IF F$(VAL(F9$,2))="2"OR J0=1THEN 1550
   : X,C9=Y
   : CONVERT XTO STR(E$(),1746,5),(#####)
   : IF X>=C8THEN 1665
1550 IF J0=0THEN GOSUB 1470
   : IF F$(VAL(F9$,2))="2"THEN GOSUB '55(4,0)
   : ELSE IF F$(VAL(F9$,2))="1"THEN GOSUB '55(4,Y)
   : IF F$(VAL(F9$,2))="2"THEN STR(E2$(4),5,1)=OR HEX(01)
   : ELSE IF F$(VAL(F9$,2))="1"THEN STR(E2$(4),5,1)=AND HEX(FE)
   : PRINT AT(R,C+LEN(E$));HEX(0F);" are allocated."
   : C9=Q
   : IF Q>0THEN 1600
   : F=3
1585 F=F+1
1590 GOSUB '34(F)
   : ON FGOTO 1585,1440,1585
1600 GOSUB '43(4)
   : X=Q
   : IF X<=YTHEN 1610
   : E$=" "
   : $PACK(F=HEX(1006))E$FROMY
   : F0$="Too many sectors.  Only"&E$&" are available on disk "&STR(E$(),857,3
     )&"."
   : GOSUB '35(F0$)
   : GOTO 1590
1610 IF X>=C8THEN 1665
   : IF X>9AND STR(E$(),1468,18)<>" "THEN 1650
   : GOSUB '43(3)
   : IF STR(E$(),1468,18)<>" "THEN E4$()="10"
   : E$="At least "&E4$()&" sectors must be allocated."
   : IF C9>0THEN E$=E$&"  Select disk or cancel."
   : IF C9>0THEN F=2
   : GOSUB '35(E$)
   : GOTO 1590
1650 E$="May not be enough space depending on record selection. EXEC=Accept ED
     IT=Modify"
   : GOSUB '63(STR(E$,,16),STR(E$,17),"!")
   : GOSUB '34(250)
   : IF Q=32THEN 1665
   : IF Q<>33THEN 1650
   : F=2
   : GOTO 1590
1665 STR(E1$(Z),9,1)=STR(F$(),VAL(F9$,2)+6)
   : D=VAL(STR(E1$(Z),9))
   : F5$="@SORTxx@"
   : CONVERT R0TO STR(F5$,6,2),(##)
   : IF C9=0THEN DATA SAVE DC OPEN T#D,(X)F5$
   : ELSE DATA LOAD DC OPEN T#D,F5$
   : DSKIP #D,X-2S
   : DATA SAVE DC #D,END
   : LIMITS T#D,F5$,A,B,C,D
   : STR(E1$(Z),55)=BIN(A,2)
   : B=VAL(STR(E1$(Z),43),2)+1
   : E=VAL(STR(E1$(Z),27))+4
1715 IF E$(1)="\F2"THEN LOAD T#2,"IDS2PRX0"1000,1994
   : LOAD T#2,"IDS2PBX3"1000,1994
1990 LOAD T#2,"IDS2PRX2"1000,1994
   : GOTO 1990
1992 DEFFN'68
   : RETURN
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PBX2"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"