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"