Listing of file='B327063' on disk='vmedia/bsc_3271_rel_1.14.04.wvd.zip'
# Sector 1239, program filename = 'B327063'
0010 REM B327063 02/13/84 Remote Off-line List
0015 A$="32WPRECI32WPRECM"
: C1=1
: LOAD T#0,<2>A$4000,9999BEG 2010
: DIM B1$5,D2$3,D2$(4)3,D3$(4)1,B1(4),B2(4),D2$3,D4$5,D5$3,D0$(4)1,D$(1,80)
24,E$(5)80,E0(4),P(4),R0$83,R$18,R1$1
: DIM J$2,R0$(3)83,R3$(30)8,R3$8
0210 DIM D(4),D1(4),D9(4),K$(10)1,N0$(4)1,N1$(150)1,V1$(24)82,V0$(1)1,N,E
0310 SELECT @PART"3270UNIV"
: FOR A=1TO 4
: IF B1(A)=0OR B1(A)<B2(A)THEN 330
: GOSUB '220(A-1,1,1,1,1)
: IF V0<1THEN V0=0
: B2(A)=V0
0330 NEXT A
0340 $BREAK2
: ON SGN(D(D))+1GOSUB 410,690
: $IF OFF #4,340
: ON C1+1GOSUB 430,460
0380 $IF OFF #9,340
: KEYIN C$
: IF C$=HEX(00)THEN 590
0390 PRINT AT(T,0,)
: C1=2
: RETURN
0410 IF B1(D)>B2(D)THEN 418
: IF STR(R3$,8,1)<HEX(80)THEN 415
: GOSUB 920
: RETURN
0415 IF STR(D$(),(D-1)*D9+1,16)=R2$THEN 418
: GOSUB 920
: IF STR(V1$(),1,16)<>R9$THEN RETURN
: IF STR(V1$(),17,18)=STR(E$(D),41,18)THEN RETURN
0418 RETURN CLEAR
: RETURN
0430 C1=1
: PRINT AT(T,0,2*80);HEX(06);TAB(10);"Off-line lister data using Spooler fi
le ";S$;" on disk ";D1$;AT(T+2,0);
: PRINTUSING 530
0440 PRINT HEX(06);AT(22,0);
: GOSUB 555
0460 PRINT AT(T+2+D,0);HEX(8B);
: R0$=E$(D)
: PRINTUSING 550,D,STR(R0$,6,7),STR(R0$,15,3),STR(R0$,24,10),STR(R0$,41,18)
,VAL(F$(6,D),2),STR(R0$,1,1),B1(D)-1,B2(D),D(D),D9(D)
: IF STR(R0$,24,10)<>"Finished"THEN 465
0462 Y=1
: GOTO 590
0465 IF STR(R0$,24,10)=" "THEN 462
: RETURN
: PRINT AT(15+D6,0);HEX(8B);
: R0$=@P$(D6)
: PRINTUSING 550,STR(R0$,1,2),STR(R0$,6,7),STR(R0$,15,3),STR(R0$,24,10),STR
(R0$,47,16)," "," ",D6,VAL(STR(R0$,35),2)
: PRINT HEX(0C20)
: RETURN
0530 % No. Device Status Report name Page Strm <block>
Pointers
0550 %## ####### ### ########## ################## #### # #### #### ##
## ####
0555 PRINT "Key '0 to ABORT Job"
: PRINT "Key any other character to return to prompts";
: RETURN
0590 Y0=80
: GOSUB '0
: IF Y=1THEN 390
: GOSUB 440
: GOTO 380
0600 DEFFN'0
: C$="C"
0610 PRINT HEX(06);AT(12,0,);"Type A=Abort job C=Continue off-line utility";
: LINPUT -C$
: ON POS("AC"=C$)+1GOTO 610,2240
: C1=0
: X=X-1
: PRINT AT(X0,0,Y0)
: Y0=12*80
: RETURN
0690 SELECT #5<D2$>
: IF D2$="005"THEN 705
: $GIOTESTPRINTERREADY#5(010002011212400040004000,K$())
: IF K$(8)<>HEX(10)THEN 710
: ADD(N0$(D),01)
: IF N0$(D)<HEX(A0)THEN RETURN
: STR(E$(D),24,9)="Not Ready"
: RETURN
0705 D8=D8+1
: IF D8>7THEN D8=1
: PRINT AT(D8+13,0,160);
0710 A=D(D)
: B3=0
: B,C=D1(D)
: IF B>0THEN 740
: B=D9(D)-A
: IF B>132THEN B=132
: C=B
: N=POS(STR(D$(),A,B)=15)
: E=POS(STR(D$(),A,B)=19)
: IF N+E=0THEN 730
: C=N
: IF E=0THEN 730
: IF N=0THEN 728
: IF N<ETHEN 730
0728 C=E
: B3=1
0730 B=C-1
: IF B=0AND B3=1THEN 790
0740 INIT(20)N1$()
: MAT COPY D$()<A,B>TO N1$()
: $TRAN(N1$(),C9$())
: IF F$(6,D)<F$(7,D)THEN 820
: A1=POS(N1$()=FF)
: IF D3$(D)="N"THEN 760
: IF A1=0THEN 790
0760 B4=POS(STR(D$(),A+A1,MAX(B-A1,1))>7F)-1
: IF B4<0THEN B4=B-A1
: D3$(D),STR(N1$(),MAX(A1,1),MAX(B4+SGN(A1)*1,1))=" "
: IF B-A1=B4THEN D3$(D)="N"
: A1=POS(N1$()=FF)
: ON SGN(A1)GOTO 760
0790 D(D),A=A+C
: IF B=0AND B3=1THEN 800
: A1=POS(N1$()=HEX(0C))
: IF F$(6,D)=F$(8,D)OR B1(D)>B2(D)+1AND A1<>0THEN 798
0792 IF POS(N1$()=0C)>0THEN GOSUB 840
: IF D4$="PC"THEN Z$=HEX(140000)
: ELSE Z$=HEX(14007F)
: $GIO#5(12124230A000400D,Z$)N1$()<1,LEN(N1$())>
: IF Z=1THEN 900
: IF A1<>0THEN 798
: IF F$(5,D)<=F$(9,D)THEN 800
0798 F$(5,D)=BIN(1,2)
: F$(6,D)=ADDCBIN(1,2)
: IF F$(6,D)>F$(8,D)THEN 815
: GOTO 805
0800 F$(5,D)=ADDCBIN(1,2)
0805 STR(E$(D),24,9)="Printing"
: IF B3=1THEN 810
: IF D9(D)>ATHEN RETURN
0810 D(D)=0
: ON POS("EW"=E0$(D))GOTO 418,830
: STR(E$(D),24,9)="Printed"
: RETURN
0815 D(D)=0
: GOTO 418
0820 A1=POS(N1$()=HEX(0C))
: IF A1<>0THEN 821
: IF F$(5,D)<=F$(9,D)THEN 825
0821 F$(5,D)=BIN(1,2)
: F$(6,D)=ADDCBIN(1,2)
: D(D)=A+C
: IF D(D)>=D9(D)THEN Z=1
: IF F$(6,D)=F$(7,D)THEN 792
: GOTO 827
0825 F$(5,D)=ADDCBIN(1,2)
: D(D)=A+C
: IF D(D)>=D9(D)THEN Z=1
0827 STR(E$(D),24,10)="Reading"
: IF Z=1THEN 900
: IF B3=1THEN 810
: IF D9(D)>ATHEN RETURN
0830 STR(E$(D),24,10)="Waiting"
: RETURN
0840 C=LEN(N1$())
: $TRAN(STR(N1$(),2,C),HEX(3C0C))R
: IF N1$(1)<>HEX(0C)THEN RETURN
: MAT COPY -N1$()<2,C>TO -N1$()<3,C>
: N1$(2)=" "
: RETURN
0900 D(D)=0
: IF B1(D)>B2(D)THEN 418
0920 Z=0
: STR(E$(D),35,2)=BIN(B1(D),2)
: IF E0$(D)=" "THEN 950
: IF E0$(D)="E"THEN 418
: STR(E$(D),24,10)="Waiting"
: CONVERT STR(@P$(D),35,5)TO B1
: ERRORB1=0
0940 IF B1=E0(D)THEN RETURN
: E0(D)=B1
: E0$(D)=" "
0950 GOSUB '220(P(D),1,B1(D),1,1)
: ON POS(HEX(002825)=R1$)+1GOTO ,990,980,960
: PRINT "WP ERROR R1$=(";HEXOF(R1$);")"
: STOP #
0960 IF E0$(5)="A"THEN 970
: GOSUB '99(3,"Specified Starting Block Does not Exist")
: RETURN CLEAR
: GOTO 390
0970 E0$(D)="W"
: RETURN
0980 E0$(D)="E"
: IF E0$(5)="A"AND B1(D)<B2(D)THEN E0$(D)="W"
0990 B1(D)=B1(D)+1
: MAT COPY V1$()<1,D9>TO D$()<(D-1)*D9+1,D9>
: B$,C$,D0$(D)=STR(V1$(),D9+3,1)
: AND (B$,08)
: IF B$=HEX(00)THEN 1010
: D3$(D)=" "
: D(D)=(D-1)*D9+1
: D9(D)=(D-1)*D9+1+D9
: AND (C$,30)
: C=0
: IF C$=HEX(10)THEN C=40
: IF C$=HEX(20)THEN C=64
: IF C$=HEX(30)THEN C=80
: D1(D)=C
: RETURN
1010 PRINT AT(0,1);HEXOF(C$);"=WCC Start Print bit not on"
: RETURN
2010 ON C1GOSUB 2120,2290
: A=0
2020 A=A+1
: IF A=5THEN 2220
: IF P(A)=-1THEN 2020
: P$=HEX(00)
: C1=0
: GOSUB 310
: IF C1=2THEN 2010
: A=1
2070 A=A+1
: IF R8$(1)=R8$(A)THEN 2080
: IF A<RTHEN 2070
: GOSUB 2880
2080 FOR A=1TO R
: R8$(A)=R8$(A+1)
: NEXT A
: C1=1
: IF R8$(1)>HEX(0000)THEN 2010
: PRINT AT(10,0,5*80);"END OF LISTING "
: IF D4$<>"CRT"THEN 2240
: KEYIN C$
: GOTO 2240
2120 SELECT #2<D1$>
: DATA LOAD DC OPEN T#2,S0$
: ERRORPRINT AT(22,0,80);HEX(07);S0$;" Not available on ";D1$
: RETURN
2125 IF D2$="005"THEN D4$="CRT"
: GOSUB '99(0,"R E M O T E L I S T I N G")
: PRINT AT(2,20);
: PRINTUSING "To printer ### Model=##### Form length=###",D2$,D4$,D5$
: GOSUB 2790
: R=0
: PRINT AT(10,0,14*80);
2150 IF VAL(R8$(R+1),2)=0THEN 2160
: R1,R=R+1
: D=1
: GOSUB 2580
: PRINTUSING 2155,R,STR(A$,,18);
: IF R/3=INT(R/3)THEN PRINT
: IF R<30THEN 2150
2155 % ### = ###################
2160 PRINT AT(9,0);R;"Items queued"
: R1,D=1
: GOSUB 2580
: D=1
: S0=0
: Y0=12*80
: A=0
: RETURN
2220 GOSUB '99(10,"There is no data to list queued from this terminal")
2240 $CLOSE
: RETURN CLEAR ALL
: COM CLEAR B$
: LOAD DC T#0,N$(1)
2270 DEFFN'99(A,A$)
: SELECT PRINT 005
: PRINT HEX(03);BOX(3,79);HEX(0A0E);TAB(40-LEN(A$)/2);A$
: IF A=0THEN RETURN
: SELECT P2
: FOR A=ATO 0STEP -1
: PRINT A;HEX(0C)
: NEXT A
: SELECT P
: RETURN
2290 PRINT AT(T,0,20*80)
2310 PRINT AT(T+5,0,);" What do you wish to do?"
: RESTORE
: C=0
: FOR C=1TO 2
: READ R0$
: PRINT R0$
: NEXT C
: DATA "1 = Restart print of current list item","2 = Abort print of current
list item"
: GOSUB 2510
: IF B$=" "THEN RETURN
: C$=B$
: IF A>CTHEN 2310
: C=A
: PRINT AT(T,1,);
: RESTORE C
: READ R0$
: PRINT R0$
: D,A=1
2370 PRINT AT(T+1,0,80);A;"= ";STR(E$(A),1,34);" ";STR(E$(A),41,18);" Page ="
;VAL(F$(6,D),2)
: IF C<>1THEN 2480
: PRINT AT(T+5,0,);" Restart at what Page?"
: PRINT " RETURN = current position"
: PRINT " or PAGE NUMBER"
: PRINT " or + PAGES"
: PRINT " or - PAGES"
2430 B1$=" "
: PRINT AT(T+5,0);
: LINPUT -B1$
: IF B1$=" "THEN RETURN
: CONVERT B1$TO B1
: ERRORGOTO 2430
2440 B1(D)=VAL(F$(2,D),2)
: B2(D)=VAL(F$(4,D),2)
: D(D)=0
: F$(5,D)=BIN(1,2)
: IF STR(B1$,1,1)="-"THEN 2460
: IF STR(B1$,1,1)="+"THEN 2450
: F$(7,D)=BIN(B1,2)
: F$(6,D)=BIN(1,2)
: GOTO 2480
2450 F$(6,D)=ADDCBIN(B1,2)
: F$(7,D)=F$(6,D)
: F$(6,D)=BIN(1,2)
: GOTO 2480
2460 B1=ABS(B1)
: F$(6,D)=SUBCBIN(B1,2)
: F$(7,D)=F$(6,D)
: F$(6,D)=BIN(1,2)
: IF F$(7,D)>HEX(F000)THEN F$(7,D)=BIN(1,2)
2480 ON CGOSUB 2530,2560
: RETURN
2510 B$=" "
: PRINT AT(T+5,0);
: LINPUT ?-B$
: IF B$=" "THEN RETURN
: IF B$<"1"OR B$>"9"THEN 2510
: A=VAL(B$)-48
: RETURN
2530 GOSUB 2960
: D(D)=0
: B1(D)=VAL(F$(2,D),2)
: RETURN
2560 GOSUB 2960
: A=3
: RETURN CLEAR
: GOTO 2010
2580 B=0
: GOSUB 2840
: IF B=0THEN RETURN
: D2$(D)=D2$
: F$(1,1)=R3$
: A$="<< from stream >>"
: C$=STR(R3$,2)
: ADD(C$,30)
: B1=VAL(STR(R3$,3),2)
: B2=VAL(STR(R3$,5),2)
: A=VAL(R3$,2)
: GOSUB 2770
: C$=STR(A$,24)
: F$(7,D)=BIN(B1,2)
: F$(8,D)=BIN(B2,2)
: CONVERT STR(A$,26,3)TO B1
: CONVERT STR(A$,30,3)TO B2
: B2=B1+B2-1
: R9$=STR(A$,34)
: R2$=STR(A$,50)
2700 B1(D)=B1
: B2(D)=B2
: P(D)=D0(VAL(C$)-48)
: STR(E$(D),1,59)=C$&". Printer "&D2$(D)&" Selected "&HEX(2020FF0
00020)&A$
: F$(2,D)=BIN(B1,2)
: F$(4,D)=BIN(B2,2)
: F$(5,D),F$(6,D)=BIN(1,2)
: IF C1=1THEN F$(3,D)=BIN(C)
: RETURN
2770 DBACKSPACE #2,BEG
: DSKIP #2,INT((A+2)/3)+4S
: DATA LOAD DC #2,R0$()
: A$=R0$(MOD(A-1,3)+1)
: RETURN
2790 IF C1>1THEN RETURN
: SELECT #5<D2$>
: CONVERT STR(D5$,1,3)TO A
: F$(9,D)=BIN(A,2)
: IF D4$="2281"THEN GOSUB 2990
: RETURN
2840 R3$=STR(R8$(R1),,2)&HEX(0001009901C0)
: IF STR(R3$,1,2)=HEX(00)THEN RETURN
: B=1
: RETURN
2880 D(D)=0
: F$(6,D),F$(5,D)=BIN(1,2)
: A=VAL(F$(1,D),2)
: GOSUB 2770
: STR(R0$(MOD(A-1,3)+1),20,1)="D"
: DBACKSPACE #2,1S
: F$(5,D),F$(6,D)=BIN(1,2)
: E0$(D)=" "
: RETURN
2960 A$=STR(R0$,5)
: SELECT #5<STR(E$(A),15,3)>
: PRINT AT(20,0,);
: $GIO#5(012002FF1212400DA000400D400C400D,K$())A$
: IF K$(8)<>HEX(10)THEN RETURN
: STR(E$(A),24,9)="Not Ready"
: RETURN
2990 F$=HEX(0D0C020D0C030F)
: IF A=66THEN 3000
: F$=HEX(020C0102)&BIN(A*8,2)&HEX(0F)
3000 $GIO#5(010302801212A000,Z$)F$<1,7>
: RETURN