Listing of file='IDS2PU24' on disk='vmedia/701-2724B.wvd.zip'
# Sector 858, program filename = 'IDS2PU24' 1000 REM - IDS2PU24 - Data Record File Dump Part 5 - Print Functions 1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : DIM J5$90 : PRINT AT(23,0,80);AT(8,29);BOX(-16,0) : E3$()=E$() : GOSUB '32("IDS2sU14") : F6$(11)="N" : GOSUB '55(1,J3) : GOSUB '55(2,C3) : GOSUB '55(3,J4) : GOSUB '55(4,C4) : GOSUB '55(5,0) : GOSUB '55(6,D0) : GOSUB '55(7,D1) : GOSUB '55(8,D0) 1080 GOSUB '63("Touch EDIT to Ch","ange Parameters, EXEC to Accept, '31 to Can cel"," ") : GOSUB '34(250) : ON Q-30GOTO 1110,1215,1125 : PRINT HEX(07); : GOTO 1080 1110 PRINT HEX(060F);AT(11,6);BOX(-4,-32);AT(18,6);BOX(-2,-66);AT(11,43);BOX(- 4,-29);AT(8,29);BOX(16,0);AT(8,1);"KIE # Byte Pointer V Record#";AT(9,0,8 0);" ----- ---- ------- - -------";AT(11,0,80);" ----- ---- ------- - --- ----" : LOAD T#2,"IDS2PU20"1000, 1125 FOR F=1TO 3STEP 2 1130 GOSUB '34(F) : IF F=1AND Q<C3THEN 1150 : ELSE IF F=3AND Q<C4THEN 1150 : GOSUB '35("Value must be less then maximum. Please Re-enter") : GOTO 1130 1150 NEXT F 1155 GOSUB '34(5) : IF Q<D0THEN 1175 : GOSUB '35("1st print byte must be less then maximum. Please Re-enter.") : GOTO 1155 1175 C5=Q : GOSUB '34(6) : IF Q>=C5AND Q<=D0THEN 1200 : GOSUB '35("Last print byte must be >= 1st print byte, <= maximum.") : GOTO 1155 1200 D5=Q : GOTO 1080 1215 GOSUB 2110 : GOSUB '43(1) : A,B=Q : IF Q<>0THEN 1240 : A=1 : B=C3 1240 GOSUB '43(3) : J8=Q : C7=0 : D7=1 : J0=J3 : J1=J4 : J2=J5 : GOSUB '43(5) : C5=Q : GOSUB '43(6) : D5=Q : IF C5<>0THEN 1290 : C5=1 : D5=D0 1290 FOR J3=ATO B : IF J8=0THEN FOR J4=1TO C4 : ELSE FOR J4=J8TO J8 : GOSUB '76(J4) : C9=(VAL(STR(E3$(),4),2)-10)/C1+1 : GOSUB 3180 : FOR J5=1TO C9 : IF D7>60OR D7+3+INT(J5-C5)/80>63THEN GOSUB 3180 : GOSUB 2200 : J5$=ALL("-") : STR(J5$,18,MIN(65,D5))=F$() : GOSUB '77(J5) : PRINT AT(19,7);HEX(0F);"KIE Element ";STR(D1$,2) : IF POS(STR(E4$(),,C0)<FF)<>0THEN 1340 1330 GOSUB '48(1,STR(D1$,2),0) : GOSUB '49(0) : D7=D7+1 : J9=0 : GOTO 1445 1340 IF J9=1THEN 1360 : GOSUB '48(0,J5$,0) : GOSUB '49(0) : D7=D7+1 1360 J9=1 : GOSUB '48(1,STR(D1$,2),0) : GOSUB '49(0) : D7=D7+1 : GOSUB '48(1,"KEY",0) : GOSUB '48(5,STR(E2$(),,D1),0) : GOSUB '49(0) : D7=D7+1 : FOR X=C5TO D5STEP 65 : KEYIN E6$,1405,1390 1390 IF E6$<>HEX(1F)THEN 1405 : X,J5,J4,J3=10^99 : GOTO 1425 1405 D1$="Bytes ####-####"&ALL(".") : CONVERT XTO STR(D1$,7,4),(####) : CONVERT -(MIN(X+MIN(65,D0-X),D5))TO STR(D1$,12,4),(####) : GOSUB '48(1,D1$,0) : GOSUB '48(18,STR(E2$(),D1+X),MIN(D5-C5+1,65,D0-X)) : GOSUB '49(0) : D7=D7+1 1425 NEXT X : GOSUB '48(0,J5$,0) : GOSUB '49(0) : D7=D7+1 1445 NEXT J5,J4,J3 : $CLOSE#1 : J3=J0 : J4=J1 : J5=J2 : J0,J1,J2=0 : GOTO 1110 1460 DEFFN'76(Z) : P=VAL(STR(E1$(D4),9)) : MAT REDIM E3$(24)83 : DATA LOAD DA T#P,(VAL(STR(E1$(D4),55),2)+C2*(J3-1)+8*(Z-1))E3$() : MAT REDIM E3$(249)8 : RETURN 1480 DEFFN'77(D6) : E4$()=STR(E3$(),(D6-1)*C1+10,C0+C6) : D1$=" " : IF VAL(E3$())=C4-1AND D6<VAL(E3$())+2THEN V=D6 : ELSE V=D6-VAL(E3$())+INT(1983/C1)*(J4-1)-J4 : CONVERT VTO STR(D1$,3,5),(#####) : GOSUB 2150 : CONVERT (D6-1)*C1+10TO STR(D1$,9,4),(####) : GOSUB 2150 : V=1 : IF C6=0THEN 1610 : D0$=STR(E4$(),C0+1,C6) : HEXUNPACKSTR(E4$(),C0+1,C6)TO STR(D1$,15) 1580 C=VAL(D0$,2) : IF C6=2THEN 1600 : E6$=STR(D0$,3) : C=C+MOD(VAL(E6$),32)*65536 : V=INT(VAL(E6$)/32)+1 1600 CONVERT VTO STR(D1$,22),(#) : CONVERT CTO STR(D1$,24),(#######) : GOSUB 2150 : IF STR(D1$,24,7)="0000000"THEN STR(D1$,24,6)=" " 1610 IF POS(STR(E4$(),,C0)<FF)>0THEN 1630 : STR(D1$,32)="(available KIE element)" : GOTO 1980 1630 STR(E4$(),C0+1)=ALL(00) : IF J6=0THEN 1680 : MAT COPY -E4$()<,C0>TO -E4$()<1+J6,C0> : HEXUNPACKSTR(E4$(),1+J6,J6)TO STR(E4$(),,J6*2) : $TRAN(E4$()<,J6*2>,@F$<33,>)R 1680 IF J7=0THEN 1700 : FOR P=J6*2+1TO J6*2+J7 : ROTATEC(STR(E4$(),P,J6*2+J7+1-P),-2) : NEXT P 1700 W=1 : FOR P=1TO 5 : IF STR(D4$,P,1)>HEX(7F)THEN XOR (STR(E4$(),W,VAL(D1$(P))),FF) : W=W+VAL(D1$(P)) : NEXT P : IF J6+J7>0THEN AND (STR(E4$(),,J6+J6+J7),3F) : IF J6>0THEN OR (STR(E4$(),,J6*2),30) : IF J6>0THEN $TRAN(E4$()<,J6*2>,@F$<53,>)R : IF J7>0THEN ADD(STR(E4$(),J6*2+1,J7),20) : IF STR(E1$(D4),12,1)=HEX(01)OR STR(E1$(D4),12,1)=HEX(04)THEN 1860 1800 GOSUB '67(D4,STR(D0$,,C6),-1) : MAT REDIM E2$(3*B)83 : DATA LOAD DA T#D,(U)E2$() : GOTO 1870 1860 C=(D6-1)*C1+10+C0 1870 MAT REDIM F$(E9)1,E2$(249)8,E3$(249)8 : UNPACK(####)STR(E1$(D4),15,2)TO X : IF POS(HEX(0104)=STR(E1$(D4),12,1))=0THEN STR(F$(),X+1)=STR(E2$(),C+1) : ELSE STR(F$(),X+1)=STR(E3$(),C+1) : T=VAL(STR(E1$(D4),12)) : GOSUB '66(D4,0) : E2$()=STR(E4$(),,POS(-E4$()<>00))&F$() 1920 $TRAN(E2$(),HEX(8020400240034004400540064007400840094001400A4000400B400C4 00D400E400F))R : IF J0=0THEN 1970 : $TRAN(E2$(),HEX(2080))R : STR(E2$(),D0+D1+1)=" " : GOTO 1980 1970 GOSUB 2010 1980 IF (D6-1)*C1+10<VAL(STR(E3$(),3))THEN STR(D1$,3,3)="(C)" : RETURN 2010 A=0 : FOR B=1TO D3+4 : IF D1$(B)=HEX(00)THEN 2070 : A=A+VAL(D1$(B))+1 : MAT COPY -E2$()<A,D0+D1+D2+D3-A>TO -E2$()<A+1,D0+D1+D2+D3-A> : STR(E2$(),A,1)=" " 2070 NEXT B : STR(E2$(),D0+D1+D2+D3)=" " : RETURN 2110 E4$()=ALL(00) : I=0 : $OPEN 2130,#1 : ERRORGOTO 2130 2120 $OPEN #1 : RETURN 2130 $CLOSE#1 : GOSUB '63("Printer is not a","vailable. Touch EXECUTE to continue, or CA NCEL","!") : GOSUB '34(250) : IF Q=31THEN 1110 : IF Q=32THEN 2110 : GOTO 2130 2150 Y=LEN(D1$) : Z=POS(-STR(D1$,,Y)=20) : IF POS(STR(D1$,Z,Y-Z)=30)<POS(STR(D1$,Z,Y-Z+1)>30)THEN STR(D1$,Z,POS(STR( D1$,Z)>30)-1)=" " : RETURN 2200 INIT("=")STR(F$(),,MAX(D1,D0)) : IF D1<10AND D0<10THEN 2250 : FOR I=1TO MAX(INT(D1/10),INT(D0/10)) : CONVERT MOD(I,10)TO STR(F$(),I*10,1),(#) : NEXT I 2250 IF J0<>0THEN RETURN : E2$()=STR(F$(),,D1) : $TRAN(F$(),"-=")R : E2$()=E2$()&STR(F$(),,D0) : GOSUB 2010 : RETURN 3180 C7=C7+1 : J5$=HEX(0C0A0A)&"Key Dump of "&D3$&" - "&D2$&" Date :"&STR(R2$,,2)&"/" &STR(R2$,3,2)&"/"&STR(R2$,5,2) : GOSUB '48(0,J5$,0) : GOSUB '49(0) : J5$=HEX(0000) : PRINTUSING TO J5$,"Bucket##### of##### Block#### of#### Record Bytes ## ## - #### Page ###",J3,C3,J4,C4,C5,D5,C7; 3240 PRINT AT(19,7,70);AT(18,7,70);HEX(0F06); : PRINTUSING "Now Printing Bucket ##### Block #### Page ###",J3,J4 ,C7 : GOSUB '48(0,STR(J5$,3),0) : GOSUB '49(0) : INIT("-")J5$ : GOSUB '48(0,J5$,0) : GOSUB '49(0) : GOSUB '48(0," KIE # Byte Pointer V Record#",0) : GOSUB '49(0) : D7=7 : RETURN 3699 ON ERRORE1$,E2$GOTO 3700 3700 DEFFN'31 : E$="IDS2PU24" : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000, : STOP "ERROR"