Listing of file='IDS2PU01' on disk='vmedia/701-2715B.wvd.zip'
# Sector 497, program filename = 'IDS2PU01'
1000 REM "IDS2PU01" - Release 2.1 - PROTECT/RELEASE RECORDS -- UTILITIES
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM C5$8,C6$8
: MAT REDIM E4$(64)4
: E3$()=ALL(00)
: IF G<>2THEN G=1
1040 GOSUB '32("IDS2sSC0")
: E$()=E9$(1)
: PRINT AT(0,7);HEX(020402000E);"Supplementary Utilities/";
: IF G=1THEN PRINT "Protect Every Record";
: IF G=2THEN PRINT "Release Every Record";
: PRINT HEX(0F);AT(11,42);"file to be"
: IF G=1THEN E$=" protected"
: IF G=2THEN E$=" released"
: PRINT AT(11,53);E$
: IF G=2THEN G1=2
: IF G=1THEN G1=1
: G=0
1070 GOSUB '34(1)
: E9$(1)=E$
: C6$=E$
: C5$=C6$OR ALL(20)
: GOSUB '39(C5$,5)
: IF Q=2THEN 1130
: GOSUB '38(92," ")
: GOTO 1070
1130 MAT SEARCHE1$(),=STR(C6$,,8)TO F9$STEP 8
: D4=INT((VAL(F9$,2)+55)/56)
: MAT REDIM E2$(6)83
: DATA LOAD DA T#P,(A)E2$()
: STR(E2$(),251,3)=STR(E2$(),105)
: CONVERT STR(E2$(),10,1)TO D2
: IF D2>1THEN 1160
: GOSUB '38(93," ")
: E$=" "
: GOTO 1040
1160 IF D2<5THEN 1170
: GOSUB '38(94," ")
: C6$=STR(E2$(),82,8)
: F=1
: GOSUB '45(1,C6$)
: E$=" "
: GOTO 1040
1170 IF D4>0THEN 1180
: MAT REDIM E3$(9)83
: F2$="IDS2fs "
: IF R0<#PARTTHEN STOP #
: A=(R0-#PART)/16+1
: IF A>0THEN CONVERT ATO STR(F2$,7,2),(##)
: DATA LOAD DC OPEN T#2,F2$
: DATA LOAD DC #2,E3$()
: F$()=STR(E3$(),#PART*45-17,45)
1180 CONVERT STR(E2$(),217,1)TO C9
: J7=0
: CONVERT STR(E2$(),209,8)TO J6
: PRINT AT(20,22);BOX(1,34);" Processing is % complete."
: FOR J=0TO C9-1
: IF D4=0THEN 1220
: J9=VAL(STR(E1$(D4+J),9))
: GOTO 1230
1220 MAT SEARCHF$(),=STR(E2$(),251+J*3,3)TO F9$STEP 3
: J9=INT((VAL(F9$,2)+2)/3)
1230 C2=VAL(STR(E2$(),442,1))
: GOSUB '39(C6$,J9)
: J9=P
: IF N<=M-A+1THEN 1250
: GOSUB '38(95," ")
: END
1250 C4=VAL(STR(E2$(),437,1))
: IF J>0THEN C4=0
: CONVERT STR(E2$(),218,4)TO C7
: C6=VAL(STR(E2$(),435,2),2)
: IF D2=4THEN 1340
: D6=((N-2)/C6)-C4
: IF D6<1THEN 1490
: C8=D6/C2
: C8=INT(C8)+SGN(C8-INT(C8))
: CONVERT STR(E2$(),224,3)TO D7
: D9=1
: GOTO 1360
1340 D6=VAL(STR(E2$(),438,2),2)
: C2=8
: C8=D6/C2
: D7=VAL(STR(E2$(),234),2)/C8
: C7=VAL(STR(E2$(),419))
: C4=0
: C8=C8+1
1360 DATA LOAD BA T#J9,(0)E4$()
: D5=VAL(STR(E4$(),2))
: FOR J1=1TO C6
: IF C8=1AND D2<>4THEN 1420
: MAT REDIM E3$(3*C2)83
: FOR J2=1TO C8-1
: Y=A+(J1-1)*D6+J1*C4+(J2-1)*C2
: DATA LOAD DA T#J9,(Y)E3$()
: C3=INT((249*C2-D7*C7)/D7)
: IF D2=4THEN C3=0
: IF D2=4THEN D9=VAL(STR(E3$(),3,1))+VAL(STR(E2$(),416))
1390 FOR J3=1TO D7
: STR(E3$(),D9+(J3-1)*(C7+C3),1)=BIN(R0)
: IF G1=2THEN STR(E3$(),D9+(J3-1)*(C7+C3),1)=HEX(FF)
: J7=J7+1
: PRINT AT(20,38);INT(100*J7/J6);
: NEXT J3
: IF Y>D5THEN 1395
: GOSUB '38(96," ")
: END
1395 DATA SAVE DA T#J9,(Y)E3$()
: NEXT J2
: IF D2=4THEN 1470
1420 D1=MOD((D6-C4),C2)
: IF D1=0THEN D1=C2
: MAT REDIM E3$(3*D1)83
: Y=A+(J1-1)*D6+J1*C4+J2*C2
: DATA LOAD DA T#J9,(Y)E3$()
: D8=D7
: D7=LEN(E3$())/C7
: FOR J3=1TO D7
: STR(E3$(),1+(J3-1)*(C7+C3),1)=BIN(R0)
: IF G1=2THEN STR(E3$(),1+(J3-1)*(C7+C3),1)=HEX(FF)
: J7=J7+1
: PRINT AT(20,38);INT(100*J7/J6);
: NEXT J3
: IF Y>D5THEN 1455
: GOSUB '38(96," ")
: END
1455 DATA SAVE DA T#J9,(Y)E3$()
: D7=D8
1470 NEXT J1
1490 NEXT J
: G1=0
: GOSUB '39(R3$(1),4)
: LOAD T#P,R3$(1)1000,
3010 DEFFN'0"LIST S HEX(03) D 10,";HEX(0D)
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PU01"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"