Listing of file='IDS2PR23' on disk='vmedia/701-2716B.wvd.zip'
# Sector 308, program filename = 'IDS2PR23'
1000 REM "IDS2PR23" - Release 2.1 - REPORT MASK COPY MODULE
1005 COM C9$19,C5$1
: DIM J0,J7,J8,J9,C0$7
: C5$=STR(R3$(1),6,1)
: ON POS("RB"=C5$)GOTO 1006,1007
: GOTO 1500
1006 C0$="report"
: J0=6
: GOTO 1010
1007 C0$="program"
: J0=8
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: C9$=E9$(J0)
: PRINT HEX(0F);AT(15,6);BOX(1,67);" Please enter the new file name for the
copied ";
: IF C5$="R"THEN PRINT "report mask"
: ELSE PRINT "program"
: STR(E2$(2),7,1)=HEX(80)
1050 GOSUB '34(2)
: IF E$<>" "THEN 1070
: GOSUB '35("Required field - You must enter a value")
: GOTO 1050
1070 E3$=E$
: GOSUB '39(E$,3)
: J8=P
: ON Q+1GOTO 1110,1105,1090
: GOSUB '35("File specified for copy is scratched")
: GOTO 1050
1090 GOSUB '63("File specified f","or copy is a data file. Touch EXEC to over
write, EDIT to modify"," ")
: GOSUB '34(250)
: IF Q=32THEN 1120
: IF Q=33THEN 1050
: GOTO 1090
1105 GOSUB '63("File specified f","or copy already exists. Touch EXEC to conti
nue, EDIT to modify"," ")
: GOSUB '34(250)
: IF Q=32THEN 1120
: IF Q=33THEN 1050
: GOTO 1105
1110 GOSUB '39(E9$(J0),3)
: J9=M-A+1
: SAVE DC T#J8,(J9-3)E3$1000,1000
: ERRORGOTO 1600
1120 GOSUB '39(E9$(J0),3)
: J9=M-A+1
: GOSUB '39(E3$,3)
: J7=A
: IF M-A+1>=J9THEN 1145
: GOSUB '35("Insufficient space in file specified for copy")
: GOTO 1050
1145 E2$=E9$(J0)OR ALL(20)
: GOSUB '39(E2$,3)
: X=N
: E2$=E3$OR ALL(20)
: GOSUB '39(E2$,3)
: IF M-A+1>=XTHEN 1150
: IF Q=0THEN 1147
: E4$()="Insufficient space in control file for specified "&C0$
: GOSUB '35(E4$())
: GOTO 1050
1147 DATA SAVE DC OPEN T#P,(X)E2$
: ERRORGOTO 1600
1148 DSKIP #P,X-2S
: DATA SAVE DC #P,END
: GOTO 1145
1150 PRINT HEX(060F);AT(20,14);BOX(1,52);AT(20,25);"Copying ";C0$;" file";
: DATA LOAD DC OPEN T#P,E2$
: DSKIP #P,X-2S
: DATA SAVE DC #P,END
: SCRATCH T#J8,E3$
: SAVE DC T#J8,(E3$)E3$1000,1000
: GOSUB '39(E9$(J0),3)
: IF J7>0THEN COPY T#P,(A+1,M)TO T#J8,(J7+1)
: LIMITS T#J8,E3$,A,B,C,D
: MAT REDIM E$(256)1
: E$()=HEX(2000)&BIN(N)&ALL(00)
: IF B>0THEN DATA SAVE BA T#J8,(B)E$()
1180 MAT REDIM E$(256)1
: DATA LOAD BA T#J8,(J7+1)E$()
: MAT SEARCHE$(),=STR(E9$(J0),,8)TO F9$
: IF F9$>HEX(0000)THEN STR(E$(),VAL(F9$,2),8)=E3$
: STR(E$(),67,12)=R4$&STR(R2$,,2)&"/"&STR(R2$,3,2)&"/"&STR(R2$,5,2)
: STR(E$(),96,3)=" 1"
: DATA SAVE BA T#J8,(J7+1)E$()
: DATA LOAD BA T#J8,(J7+2)E$()
1230 MAT SEARCHE$(),=STR(E9$(J0),,8)TO F9$
: IF F9$>HEX(0000)THEN STR(E$(),VAL(F9$,2),8)=E3$
: E2$=E9$(J0)OR ALL(20)
: MAT SEARCHE$(),=STR(E2$,,8)TO F9$
: IF F9$>HEX(0000)THEN STR(E$(),VAL(F9$,2),8)=E3$OR ALL(20)
: DATA SAVE BA T#J8,(J7+2)E$()
: MAT REDIM E$(E8)1
: PRINT HEX(060F);
: IF C5$="R"THEN PRINT AT(20,40,20);
: ELSE PRINT AT(20,41,19);
: PRINT "control file";
1280 E2$=E3$OR ALL(20)
: GOSUB '39(E2$,3)
: X=A
: J8=P
: E2$=E9$(J0)OR ALL(20)
: GOSUB '39(E2$,3)
: IF X>0THEN COPY T#P,(A,A+N-1)TO T#J8,(X)
: MAT REDIM E$(18)83
: DATA LOAD DA T#J8,(X)E$()
: STR(E$(),2,8)=E3$
: STR(E$(),10,8)=E3$OR ALL(20)
: STR(E$(),50,12)=" 1"&R2$&R4$
: DATA SAVE DA T#J8,(X)E$()
: MAT REDIM E$(E8)1
: E9$(J0)=E3$
1500 IF J3=2THEN LOAD T#2,"IDS2PS94"1000,
1510 COM CLEAR C9$
: LOAD T#2,R3$(1)1000,
1600 GOSUB '35("Not enough room on disk for new file - Press FN '31 to CANCEL"
)
: F6$(11)="N"
: GOSUB '34(250)
: GOTO 1510
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR23"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"