Listing of file='609PINXA' on disk='vmedia/701-2737G.wvd.zip'
# Sector 684, program filename = '609PINXA'
0010 REM 609PINXA, Release 2mc--550 (-) J$-- 7/30/84 by DGF
0145 DIM T2$2,C8$80,T1$80,C7$6,J$80
: DIM J4$9,J7$80,J8$80,J9$,C9$32
: DIM C0$1,D7$(256)1,U2$(16)
: $PSTAT="609PINXA"
: C9$=HEX(0000040108020C030104050509060D07020806090A0A0E0B030C070D0B0E0F0F)
: LIMITS T#0,"609$TRAN",J0,J8,J8,J8
: DATA LOAD BA T#0,(J0+1)D7$()
: LIMITS T#0,"609@DEVC",J,C0,C0,C0
0195 CONVERT STR(C6$,1,1)TO C0
: DATA LOAD DA T#0,(J+C0)A0$(1)
: SELECT #C0<STR(A0$(1),2,3)>
: GOSUB 665
: CONVERT STR(C6$,2,2)TO J8
: IF J8=0THEN J8=3
: J$=HEX(020D0C030F)
: $GIO#C0,(A200,J9$)J$<,LEN(J$)>
: IF STR(A0$(1),5,1)=HEX(02)THEN STR(C6$,6,1)="1"
: ELSE GOSUB 970
: $GIO#C0,(400C400A400D,J9$)
: IF STR(C6$,6,1)="2"THEN $GIO#C0,(40024007400F,J9$)
: GOSUB 2300
0275 $FORMATJ7$=SKIP 2,A5,SKIP 2,A25,SKIP 3,A20,SKIP 2,A20
: $FORMATJ8$=A9,SKIP 27,A5,SKIP 17,A20
: CONVERT STR(C6$,4,2)TO J9
: J9=INT((J9-13)/3)
: GOSUB 2040
: C2=1
: PRINT AT(9,62);C2
: FOR C6=1TO D4
: UNPACK(####)STR(J9$(C6),1,2)TO D9
: CONVERT D9TO B0$,(####)
: J2$=STR(J9$(C6),5,1)
: $TRAN(J2$,C9$)R
: C7$=B0$&STR(J9$(C6),3,1)
: J0=VAL(STR(J9$(C6),4,1))*16+VAL(J2$)
0365 DATA LOAD BA T#D0,(J0+D1)U2$()
: $TRAN(STR(U2$(),11,100),D7$())
: IF STR(U2$(),245,6)<>HEX(000000000000)THEN STR(C7$,6,1)="*"
: GOSUB 2420
: J$=ALL(" ")
: $PACK(F=J7$)J$FROMC7$,STR(U2$(),14,25),STR(U2$(),82,20),STR(U2$(),61,20)
: GOSUB 945
: $TRAN(J$,HEX(2080))R
: $GIO#C0,(A200400D,J9$)J$<,LEN(J$)>
: PRINT AT(5,2);STR(J$,1,77)
0420 J$=ALL(" ")
: $PACK(F=J8$)J$FROMJ4$,D1$,STR(U2$(),40,20)
: GOSUB 945
: $TRAN(J$,HEX(2080))R
: $GIO#C0,(A200400D,J9$)J$<,LEN(J$)>
: PRINT AT(5,2);STR(J$,1,77)
: GOSUB 945
: $GIO#C0,(A200400D,J9$)C8$<,LEN(C8$)>
: C4=C4+1
: KEYIN C0$,470,470
0470 IF C0$<>HEX(F0)THEN 480
: C6=D4
0480 IF C4<J9AND C6<D4THEN 550
: J$=ALL(" ")
: $GIO#C0,(A200400D,J9$)J$<,LEN(J$)>
: GOSUB 945
: GOSUB 2600
: CONVERT C2TO STR(J$,75,3),(###)
: $GIO#C0,(A200400D,J9$)J$<,LEN(J$)>
: J$=HEX(0C)
: $GIO#C0,(A200,J9$)J$<,LEN(J$)>
: IF C6=D4THEN 550
: IF STR(C6$,6,1)="2"THEN $GIO#C0,(40024007400F,J9$)
0530 C4=0
: C2=C2+1
: PRINT AT(9,62);C2
: GOSUB 2300
0550 NEXT C6
: $CLOSE#C0
: GOTO 600
0585 IF C0$=HEX(F0)THEN 600
: GOTO 530
0600 IF C8=0THEN 650
: GOSUB 800
: GOSUB 830
: IF J3=0THEN 650
: PRINT AT(23,0,80);B5$(2);T1$;B5$(1);HEX(07);
: KEYIN C0$
: GOTO 600
0650 COM CLEAR C
: $PSTAT=" "
: LOAD T"609menu"
0665 $OPEN 760,#C0
: ERRORGOTO 675
0670 GOTO 710
0675 GOSUB 2640
: PRINT AT(23,0);J$;
0685 KEYIN C0$
: IF C0$=HEX(F0)THEN 600
: PRINT HEX(07);
: GOTO 685
0705 C=1
0710 B2$=ALL(00)
0715 $GIO#C0,(010102001212400040004000,B2$)
: IF STR(B2$,8,1)=HEX(00)THEN 785
: C=C+1
: IF C<10THEN 715
: GOSUB 2680
: PRINT AT(23,0);J$;
: KEYIN C0$
: IF C0$=HEX(F0)THEN 600
: GOTO 705
0760 GOSUB 2720
: PRINT AT(23,0);J$;
: KEYIN C0$
: IF C0$=HEX(F0)THEN 600
: GOTO 665
0785 PRINT AT(23,0,80);
: RETURN
0800 $OPEN 810,#B0
: RETURN
0810 $BREAK255
: GOTO 800
0830 J3=1
: C8=0
: DATA LOAD BA T#D0,(D1)U2$()
: ERRORGOTO 915
0850 IF VER(STR(U2$(),4,5),"####A")=5THEN 870
: GOSUB 2840
: GOTO 900
0870 IF STR(U2$(),9,1)=HEX(00)THEN 895
: STR(U2$(),9,1)=HEX(00)
: DATA SAVE BA T#D0,(D1)U2$()
: ERRORGOTO 930
0895 J3=0
0900 $CLOSE#B0
: RETURN
0915 GOSUB 2760
: GOTO 900
0930 GOSUB 2800
: GOTO 900
0945 FOR J=1TO J8
: $GIO#C0,(4020,J9$)
: NEXT J
: RETURN
0970 IF STR(C6$,6,1)="4"THEN $GIO#C0,(400240064001400F,J9$)
: IF STR(C6$,6,1)="3"THEN $GIO#C0,(400240064002400F,J9$)
: RETURN
2040 SELECT PRINT 005(80)
: PRINT HEX(03);
: PRINT AT(1,35);"Print Index";
: PRINT AT(4,1);BOX(3,78)
: PRINT AT(9,19);"Document ID : INDEX";TAB(47);"Current Page : ";
: PRINT AT(14,20);"CANCEL to stop printing this request"
: IF Q2$=" "THEN 2260
: PRINT AT(16,20);"STOP to exit from print task"
2240 PRINT AT(18,20);"MOVE to move print task to background"
2260 RETURN
2300 GOSUB 945
: C8$=" Document Name Comments/Archive ID Author/Ope
rator "
: $GIO#C0,(A200400D,J9$)C8$<,LEN(C8$)>
: GOSUB 945
: C8$=ALL("-")
: $GIO#C0,(A200400D,J9$)C8$<,LEN(C8$)>
: RETURN
2420 C0$=AND HEX(40)
: IF C0$=HEX(00)THEN 2500
: J4$="in use"
: GOTO 2560
2500 C0$=STR(J9$(C9),6,1)
: C0$=AND HEX(80)
: IF C0$<>HEX(00)THEN J4$="damaged"
: ELSE J4$="available"
2560 RETURN
2600 STR(J$,70,4)="Page"
: RETURN
2640 J$="Illegal Printer Device - Press CANCEL"
: RETURN
2680 J$="Select Printer - EXECUTE or CANCEL"
: RETURN
2720 J$="Printer In Use, Press EXECUTE to try again"
: RETURN
2760 T1$="Please mount archive, press EXECUTE or CANCEL"
: RETURN
2800 T1$="Archive not available"
: RETURN
2840 T1$="Platter mounted is not an archive"
: RETURN