Listing of file='IDS2PS99' on disk='vmedia/701-2715B.wvd.zip'
# Sector 466, program filename = 'IDS2PS99'
1000 REM "IDS2PS99" - Release 2.1 - SCREEN/REPORT COPY EDITS FOR SCREEN/FIELD
- MODULE #3 OF 4
1010 E6$=F6$(17)AND HEX(02)
: IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1020
: DATA 98,228,326,228,554,228,782,228,1010,228,1238,228,1466,192,1658,192,1
850,192
1020 DIM J4$1,J7$2,J9$(10)1,J8$16,J9$16
: J9$()="ABCDRUVWXY"
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: F8,J4,J5,J6=0
: J0$=J5$
: E$(),F$()=" "
: RESTORE
: FOR J1=1TO 64
: E$()=" "
: F9=0
: STR(J0$,17)=BIN(J1+31)
: IF F8=0OR J9$=STR(J0$,,16)OR J1=1OR STR(E6$(),,16)=STR(J0$,,16)THEN 1250
: J1=64
: GOTO 1460
1250 Y9=3
: GOSUB '60(E1$(2),J0$)
: IF STR(E6$(),,8)<>HEX(FFFFFFFFFFFFFFFF)THEN 1300
: IF J1=1THEN 1280
: J1=64
: GOTO 1460
1280 GOSUB '35("The edit file contains no edits at present")
: GOSUB '34(250)
: GOTO 1820
1300 IF F8=0OR STR(E6$(),,16)=STR(J0$,,16)THEN 1310
: J1=64
: GOTO 1460
1310 J8$=STR(E6$(),,16)
: GOSUB '62(E1$(2),1,0)
: J9$=STR(F$(),7,16)
: IF Q<>0THEN 1330
: J1=64
: GOTO 1460
1330 IF J8$=STR(J0$,,16)THEN 1340
: J1=64
: GOTO 1460
1340 IF F$()=" "THEN 1310
: IF STR(F$(),3,1)=STR(J0$,17,1)THEN 1350
: J1=VAL(STR(F$(),3))-32
: GOTO 1460
1350 F8=1
: J=INT((J1-1)/8)+1
: C2=MOD(J1-1,8)+1
: J4$=STR(J2$,J,1)AND STR(J3$,C2,1)
: IF J6<>J1THEN J5=J5+1
: J6=J1
: IF J4$=HEX(00)THEN 1430
: J4=J4+1
: GOTO 1750
1430 F9=1
: CONVERT F$(2)TO C1
: RESTORE C1*2+1
: READ C3,C4
: STR(E$(),C3,C4)=STR(F$(),23)
: IF STR(E$(),,23)=" "THEN STR(E$(),,23)=F$()
: GOTO 1300
1460 IF F9=0THEN 1750
: RESTORE
: IF STR(J0$,9,8)=STR(J6$,9,8)THEN 1520
: STR(E$(),15,8)=STR(J6$,9,8)
: IF C5$<>"S"THEN 1506
: CONVERT STR(E$(),,1)TO I
: ON I+1GOSUB ,1860,1870,1880,1890,1900,1910,1920
1506 X=536
: FOR L=0TO 49
: IF C5$="R"AND POS("QR"=STR(E$(),L*18+555))=0THEN 1509
: IF STR(E$(),L*18+556,8)=STR(J0$,9,8)THEN STR(E$(),L*18+556,8)=STR(J6$,9,8
)
: IF STR(E$(),L*18+564,8)=STR(J0$,9,8)THEN STR(E$(),L*18+564,8)=STR(J6$,9,8
)
1509 NEXT L
1520 STR(E$(),7,8)=STR(J6$,,8)
: RESTORE
: FOR J2=1TO 9
: READ C3,C4
: IF STR(E$(),4,1)="Y"AND J2=1THEN 1560
: IF STR(E$(),C3,C4)=" "THEN 1740
1560 STR(F$(),,23)=E$()
: STR(F$(),2,1)=BIN(47+J2)
: STR(F$(),23)=STR(E$(),C3,C4)
: J7=0
: CONVERT STR(F$(),2,1)TO X
: ERRORX=0
1586 IF X<2OR X>5THEN 1686
: IF C5$="S"THEN 1680
: FOR I=1TO 10
1620 MAT SEARCHSTR(F$(),24),=J9$(I)TO F9$STEP 18
: IF F9$=HEX(0000)THEN 1670
: STR(F$(),VAL(F9$,2)+22,18)=" "
: J7=J7+1
: GOTO 1620
1670 NEXT I
1680 IF STR(J0$,,8)=STR(J6$,,8)THEN 1686
: I=24
1682 MAT SEARCHSTR(F$(),I),="I"TO F9$STEP 18
: IF F9$=HEX(0000)THEN 1686
: IF STR(F$(),VAL(F9$,2)+I,8)=STR(J0$,,8)THEN STR(F$(),VAL(F9$,2)+I,8)=STR(
J6$,,8)
: IF STR(F$(),VAL(F9$,2)+I+8,8)=STR(J0$,,8)THEN STR(F$(),VAL(F9$,2)+I+8,8)=
STR(J6$,,8)
: I=VAL(F9$,2)+17+I
: GOTO 1682
1686 GOSUB '42(E1$(2),0)
: IF Q>0THEN 1740
: IF Q=0THEN 1740
: F0$="Edit currently being saved is in use by partition # (EXEC. OR CA
NCEL)"
: CONVERT ABS(Q)TO STR(F0$,52),(###)
: GOSUB '53(F0$)
: GOSUB '34(250)
: IF Q<>32THEN 1680
: J2=9
: J1=64
: GOTO 1740
1730 F0$="Edit file is full, please cancel"
: GOSUB '53(F0$)
: GOSUB '34(250)
: IF Q<>32THEN 1730
: J2=9
: J1=64
1740 NEXT J2
1750 NEXT J1
: IF J7=0THEN 1780
: CONVERT J7TO F0$,(####)
: F0$=F0$&" pass/fail's are not allowed for reports and were not copied"
: GOSUB '35(F0$)
: GOSUB '34(250)
1780 IF J4=0THEN 1790
: PRINT AT(23,0,);
: IF J4>1THEN F0$="Edits"
: ELSE F0$="Edit"
: PRINT J4;F0$;" of the total";J5;"conflicted with current edits"
: GOSUB '34(250)
: GOTO 1820
1790 F0$="Edit library specification "&STR(J5$,,8)&"-"&STR(J5$,9,8)
: IF F8=0THEN F0$=F0$&" not"
: F0$=F0$&" found."
: IF F8=0THEN GOSUB '35(F0$)
: ELSE GOSUB '53(F0$)
: GOSUB '34(250)
1820 IF J1$<>"RENAME"THEN 1840
: IF F8=0THEN 1830
: J6$=J5$
: F$()="RENAME"
: STR(F$(),9,1)=BIN(J4)
: LOAD T#2,"IDS2PS95"1000,
1830 MAT REDIM E$(24)83,F$(27)83,E2$(27)83,E3$(24)83
: DATA LOAD DA T#3,(E4+25)E$()
: DATA LOAD DA T#3,(E4+33)F$()
: DATA LOAD DA T#3,(E4+42)E2$()
: DATA LOAD DA T#3,(E4+51)E3$()
: MAT REDIM E$(E8)1,F$(E9)1,E2$(250)9,E3$(249)8
: C=D3
: R=D4
: L=D5
1840 IF J1$="RENAME"THEN COM CLEAR J6$
: LOAD T#2,R3$(1)1000,
1860 X=99
: FOR I=1TO 4
: IF STR(E$(),X,8)=STR(J0$,9,8)THEN STR(E$(),X,8)=STR(J6$,9,8)
: X=X+9
: FOR L=1TO 5
: IF STR(E$(),X,18)=STR(J0$,9,8)AND STR(E$(),X-1,1)="F"THEN STR(E$(),X,18)=
STR(J6$,9,8)
: X=X+21
: NEXT L
: IF X<>326THEN X=X-1
: NEXT I
: RETURN
1870 IF STR(E$(),113,8)=STR(J0$,9,8)THEN STR(E$(),113,8)=STR(J6$,9,8)
: IF STR(E$(),121,8)=STR(J0$,9,8)THEN STR(E$(),121,8)=STR(J6$,9,8)
: FOR L=131TO 287STEP 39
: IF STR(E$(),L,1)="F"AND STR(E$(),L+1,8)=STR(J0$,9,8)THEN STR(E$(),L+1,8)=
STR(J6$,9,8)
: NEXT L
: RETURN
1880 X=99
: FOR I=1TO 8
: IF STR(E$(),X,8)=STR(J0$,9,8)THEN STR(E$(),X,8)=STR(J6$,9,8)
: X=X+11
: IF STR(E$(),X,16)=STR(J0$,9,8)AND STR(E$(),X-1,1)="F"THEN STR(E$(),X,16)=
STR(J6$,9,8)
: X=X+17
: NEXT I
: RETURN
1890 X=142
: FOR I=1TO 8
: IF STR(E$(),X,8)=STR(J0$,9,8)THEN STR(E$(),X,8)=STR(J6$,9,8)
: X=X+11
: FOR L=1TO 4
: IF STR(E$(),X,8)=STR(J0$,9,8)THEN STR(E$(),X,8)=STR(J6$,9,8)
: X=X+9
: NEXT L
: X=X-1
: IF X=326THEN X=370
: NEXT I
: RETURN
1900 X=101
: FOR I=1TO 6
: IF STR(E$(),X,8)=STR(J0$,9,8)THEN STR(E$(),X,8)=STR(J6$,9,8)
: X=X+9
: FOR L=1TO 2
: IF STR(E$(),X,13)=STR(J0$,9,8)AND STR(E$(),X-1,1)="F"THEN STR(E$(),X,13)=
STR(J6$,9,8)
: X=X+14
: NEXT L
: X=X-1
: NEXT I
: RETURN
1910 IF STR(E$(),326,8)=STR(J0$,9,8)THEN STR(E$(),326,8)=STR(J6$,9,8)
: IF STR(E$(),98,8)=STR(J0$,9,8)THEN STR(E$(),98,8)=STR(J6$,9,8)
: RETURN
1920 X=222
: FOR L=1TO 4
: IF STR(E$(),X,8)=STR(J0$,9,8)THEN STR(E$(),X,8)=STR(J6$,9,8)
: IF L<3THEN X=X+33
: ELSE X=X+29
: NEXT L
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS99"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"