image of READY prompt

Wang2200.org

Listing of file='IDS2PF20' on disk='vmedia/701-2717B.wvd.zip'

# Sector 62, program filename = 'IDS2PF20'
1000 REM "IDS2PF20" - COPY A DATA FILE CONTROL FILE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : GOSUB '32("IDS2sSC0")
   : PRINT HEX(0E);AT(0,7);"Data File Editor - Copy A Data File's Control File
     ";HEX(0F);AT(11,42);"data file to be copied"
   : GOSUB '45(1,E9$(1))
   : F6$(12)="N"
1020 GOSUB '34(1)
   : E9$(1)=E$
   : F0$=E$OR ALL(20)
   : GOSUB '39(F0$,5)
   : IF Q=2THEN 1030
   : GOSUB '35("Control file doesn't exist for this file")
   : GOTO 1020
1030 D1=M
   : D3=A
   : D4=P
   : MAT REDIM E3$(6)83
   : DATA LOAD DA T#P,(A)E3$()
   : CONVERT STR(E3$(),10,1)TO D2
   : IF D2>4THEN 1040
   : MAT REDIM E3$(24)83
   : DATA LOAD DA T#P,(A)E3$()
1040 STR(E2$(2),7,1)=OR HEX(80)
   : PRINT HEX(0F);AT(15,6);BOX(1,67);AT(15,7);"Enter desired new name for the
      copy of this control file"
   : GOSUB '34(2)
   : E9$(1)=E$
   : F0$=E$OR ALL(20)
   : IF F0$=E9$(1)THEN 1100
1050 IF D2<5THEN S=18
   : ELSE S=4
   : IF STR(F0$,,4)="ids2"THEN P=2
   : ELSE P=5
   : DATA SAVE DC OPEN T#P,(S)F0$
   : ERRORX=ERR
   : IF X<>83THEN 1080
   : GOSUB '35("The control file for this file already exists!")
   : GOTO 1040
1060 GOSUB '39(F0$,5)
   : STR(E3$(),2,8)=E9$(1)
   : STR(E3$(),11,5)=ALL(00)
   : STR(E3$(),16,6)=R2$
   : STR(E3$(),447,3)=R4$
   : IF D2>4THEN STR(E3$(),82,8)=" "
   : IF D2>4THEN 1070
   : STR(E3$(),82,8)=E9$(1)
   : STR(E3$(),275,128)=" "
1070 DATA SAVE DC #P,E3$()
   : IF D2<5THEN GOSUB 1090
   : DATA SAVE DC #P,END
   : DATA LOAD BA T#D4,(D1)STR(E3$(),,256)
   : DATA SAVE BA T#P,(M)STR(E3$(),,256)
   : MAT REDIM E3$(249)8
   : LOAD T#2,R3$(1)1000,
1080 PRINT "UNEXPECTED ERROR ";X
   : END
1090 DATA LOAD DA T#D4,(D3+8)E3$()
   : DATA SAVE DC #P,E3$()
   : RETURN
1100 GOSUB '35("File name must contain at least one upper case character")
   : GOTO 1040
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PF20"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"