Listing of file='IDS2PU20' on disk='vmedia/701-2724B.wvd.zip'
# Sector 828, program filename = 'IDS2PU20'
1000 REM - IDS2PU20 - Data Record File Dump Part 4 - Display Records
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM D0$3,D1$55,D2$32
1040 PRINT AT(8,30,49)
: IF D8=0THEN PRINT AT(8,30);"Key"
: ELSE IF D8=1AND D1+D2>=50THEN PRINT AT(8,30);"Key"
: IF D8=0AND D1+D2<50THEN PRINT AT(8,30+D1+D2);
: ELSE IF D8=1THEN PRINT AT(8,30+MOD(D1+D2+1,40));
: ELSE IF D8>1THEN PRINT AT(8,30);
: PRINT "Record"
: GOSUB 2160
: PRINT AT(9,30);STR(E2$(),MAX(D8*45-5,1),50)
1090 GOSUB '76(1)
: PRINT HEX(0F)
: GOSUB '77(J4)
: PRINT AT(10,0,80);STR(D1$,2)
: IF POS(STR(E4$(),,C0)<FF)>0THEN PRINT AT(10,30);HEX(0202020E);STR(E2$(),M
AX(1,D8*45-5),50)
: PRINT AT(4,11);
: PRINTUSING "##### of #####",J3,C3
: PRINT AT(5,14);
: PRINTUSING "## of ##",J4,C4
: PRINT AT(6,19);
: PRINTUSING "######",VAL(STR(E3$(),6),2)
: GOSUB '76(J4)
: C9=(VAL(STR(E3$(),4),2)-10)/C1+1
1220 FOR D7=0TO 11
: IF D7+J5<=C9THEN GOSUB '77(D7+J5)
: ELSE D1$,E2$()=" "
: D1$=STR(D1$,2)
: PRINT AT(D7+12,0,80);D1$;
: IF POS(STR(E4$(),,C0)<FF)>0THEN PRINT AT(D7+12,30);HEX(0202020E);STR(E2$(
),MAX(1,D8*45-5),50)
: NEXT D7
: PRINT HEX(0106)
: GOTO 1310
1300 PRINT HEX(07);
1310 KEYIN E6$,,1330
: GOTO 1310
1330 ON VAL(E6$)-3GOTO 1350,1360,1370,1380,,,1430,1410,1390,1400,1440,1420,228
0
: IF E6$=HEX(1F)THEN 2291
: GOTO 1300
1350 J5=1+10*INT((C9-2)/10)
: GOTO 1220
1360 IF J5>C9-10THEN 1300
: J5=J5+10
: GOTO 1220
1370 IF J5=1THEN 1220
: J5=J5-10
: GOTO 1220
1380 J5=1
: GOTO 1220
1390 IF J4=C4THEN 1300
: J4=J4+1
: GOTO 1090
1400 IF J4=1THEN 1300
: J4=J4-1
: GOTO 1090
1410 IF J3=C3THEN 1300
: J3=J3+1
: J4=1
: GOTO 1090
1420 IF D8=0THEN 1300
: D8=D8-1
: GOTO 1040
1430 IF D8=D9THEN 1300
: D8=D8+1
: GOTO 1040
1440 IF J3=1THEN 1300
: J3=J3-1
: J4=1
: GOTO 1090
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 2110
: CONVERT (D6-1)*C1+10TO STR(D1$,9,4),(####)
: GOSUB 2110
: 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 2110
: 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$<65,>)R
1680 IF J7=0THEN 1700
: FOR P=J6*2+1TO J6*2+J7
: ROTATEC(STR(E4$(),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$<33,>)R
: IF J7>0THEN ADD(STR(E4$(),J6*2+1,J7),20)
1775 IF STR(E1$(D4),12,1)>HEX(01)THEN 1790
: E2$()=STR(E4$(),,VAL(STR(E1$(D4),13),2))&E4$()
: GOTO 2010
1790 IF STR(E1$(D4),12,1)=HEX(01)OR STR(E1$(D4),12,1)=HEX(04)THEN 1860
: 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$(VAL(STR(E1$(D4),10),2)),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 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
2160 INIT("=")STR(F$(),,MAX(D1,D0))
: IF D1<10AND D0<10THEN 2210
: FOR I=1TO MAX(INT(D1/10),INT(D0/10))
: CONVERT MOD(I,10)TO STR(F$(),I*10,1),(#)
: NEXT I
2210 IF J0<>0THEN RETURN
: E2$()=STR(F$(),,D1)
: $TRAN(F$(),"-=")R
: E2$()=E2$()&STR(F$(),,D0)
: GOSUB 2010
: RETURN
2280 LOAD T#2,"IDS2PU24"1000,
2291 IF F6$(53)="N"THEN 2300
: COM CLEAR D0
: GOSUB '40(STR(R3$(),,8))
2300 COM CLEAR Y
: E8=2075
: E9=2250
: G=500
: H=2
: E=21
: X=LEN(STR(R3$()))-9
: MAT COPY -R3$()<1,X>TO -R3$()<10,X>
: STR(R3$(),,9)="IDS2P002"
: PRINT AT(0,0);HEX(020402000F)
: F6$(17)=" "
: E$="IDS2P001IDS2P004"
: LOAD T#2,<2>E$