Listing of file='IDS2PS61' on disk='vmedia/701-2715B.wvd.zip'
# Sector 291, program filename = 'IDS2PS61'
1000 REM "IDS2PS61" Batch Screen Update
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM J$1,J1$3,J2$4,J3$8,J4$8,F2$(32)8,C1$(256)1,C2$6,D$1,D1$1,D3$8,D6$8,D7
$8,D8$9,D9$8,F5$8
: GOSUB '32("IDS2sS54")
1040 GOSUB '34(1)
: J3$=E$
: GOSUB '34(2)
: J4$=E$
: GOSUB '34(3)
: J$=E$
: GOSUB '34(4)
: J1$=E$
: GOSUB '34(5)
: J2$=E$
: IF J3$<>" "THEN 1060
: J3$=ALL(00)
: IF J4$=" "THEN J4$=ALL(FF)
: GOTO 1070
1060 IF J4$<>" "THEN 1070
: J4$=J3$
: F3=9
1070 GOSUB '34(6)
: IF E$=R4$OR E$=" "THEN 1080
: GOSUB '38(124," ")
: GOTO 1070
1080 GOSUB '34(11)
: IF E$="Y"OR E$="y"OR E$="1"THEN D9=1
: ELSE D9=0
: GOSUB '38(125," ")
: GOSUB '34(250)
: IF Q=32THEN 1100
: IF Q=31THEN 1600
: IF Q<31OR Q>32THEN 1040
1100 DATA LOAD BA T#3,(0)F2$()
: C1=VAL(STR(F2$(),2,1))
: PRINT AT(5,53);C1-1;
: F8=0
: FOR I=0TO C1-1
: PRINT AT(5,35);I;
: DATA LOAD BA T#3,(I,J)F2$()
: FOR J=2TO 32STEP 2
: IF VAL(F2$(J))=0OR STR(F2$(J),1,4)="IDS2"OR STR(F2$(J-1),,2)<>HEX(1000)OR
VER(F2$(J),"IDS2wS##")=8THEN 1590
1120 LIMITS T#3,STR(F2$(J),1,8),A,C,C,D
: IF C>27OR D<>2OR F2$(J)<J3$OR F2$(J)>J4$THEN 1590
: MAT REDIM C1$(256)1
: DATA LOAD BA T#3,(A)C1$()
: IF STR(C1$(),,4)<>HEX(8201D3F3)THEN 1590
: MAT REDIM C1$(3)83
: DATA LOAD DA T#3,(A)C1$()
1150 IF J$<>" "AND J$<>STR(C1$(),42,1)THEN 1590
: IF J1$<>" "AND J1$<>STR(C1$(),43,3)THEN 1590
: IF J2$<>" "AND J2$<>STR(C1$(),46,4)THEN 1590
: IF STR(C1$(),51,3)<>" "AND R4$<>STR(C1$(),51,3)THEN 1590
: F8=F8+1
: PRINT AT(7,52);" ";AT(7,52);F2$(J)
: PRINT AT(8,52);F8
: F6,J6,F4,D7,L=0
: J4=5000
1190 GOSUB '33(F2$(J))
: IF F0<1THEN 1590
: D2=VAL(STR(C1$(),138,1))
: E3$()=ALL(00)
: MAT REDIM E3$(D2)83
: D2=VAL(STR(C1$(),137,1))
: DATA LOAD DA T#3,(A+8+D2/3)E3$()
: ERRORGOSUB '38(103,F2$(J))
: GOSUB 1800
: F6=0
: GOTO 1590
1200 MAT REDIM E3$(249)8
: C9=1
1210 F5$=STR(C1$(),78+(C9-1)*8,8)
: IF F5$=" "THEN 1530
1230 D6$=F5$OR ALL(20)
: LIMITS T#5,D6$,A7,D,D,D
: IF D<>2THEN 1260
: MAT REDIM E$(24)83
: DATA LOAD DA T#5,(A7)E$()
: ERRORGOTO 1260
1250 GOTO 1270
1260 GOSUB '38(126,D6$)
: GOSUB 1800
: F6=0
: GOTO 1590
1270 CONVERT STR(E$(),10,1)TO X
: IF X<5THEN 1290
: F5$=STR(E$(),82,8)
: GOTO 1230
1290 CONVERT STR(E$(),93,4)TO F7
: E$()=STR(E$(),499)
: MAT REDIM E$(249)6
: F4=F4+L
: L=F7
: MAT REDIM F$(24)83
: DATA LOAD DA T#5,(A7+8)F$()
: ERRORGOSUB '38(127,D5$)
: GOSUB 1800
: F6=0
: GOTO 1590
1320 MAT REDIM F$(249)8
: FOR C2=1TO F0
: D7$=STR(E3$(),1+8*(C2-1),8)
: D8$=STR(E2$(),1+9*(C2-1),9)
: D$=STR(D8$,6,1)
: D$=AND HEX(07)
: Y=VAL(D$)
: IF Y<>C9THEN 1520
: FOR C3=1TO 1+INT(LEN(F$())/8)
: D3$=STR(F$(),1+8*(C3-1),8)
: IF D3$<>D7$THEN 1510
: C2$=STR(E$(),1+6*(C3-1),6)
1420 D$=STR(D8$,3,1)
: D$=AND HEX(FE)
: D1$=STR(C2$,6,1)
: ROTATE(D1$,-3)
: D1$=AND HEX(01)
: D$=OR D1$
: STR(D8$,3,1)=D$
: D$=STR(D8$,3,1)
: ROTATE(D$,-1)
: D$=AND HEX(FE)
: D1$=STR(C2$,2,1)
: D1$=AND HEX(01)
: D$=OR D1$
: ROTATE(D$,1)
: STR(D8$,3,1)=D$
: D$=STR(D8$,4,1)
: D$=AND HEX(F8)
: D1$=STR(C2$,6,1)
: D1$=AND HEX(07)
: D$=OR D1$
: STR(D8$,4,1)=D$
1450 D$=STR(D8$,6,1)
: ROTATE(D$,-4)
: D$=AND HEX(F8)
: D1$=STR(C2$,2,1)
: ROTATE(D1$,-1)
: D1$=AND HEX(07)
: D$=OR D1$
: ROTATE(D$,4)
: STR(D8$,6,1)=D$
: STR(D8$,1,1)=STR(C2$,3,1)
: D1$=STR(C2$,2,1)
: ROTATE(D1$,-4)
: D1$=AND HEX(0F)
: J1=VAL(D1$)+16*VAL(STR(C2$,1,1))
: Y=F4+J1
: J9=INT(Y/16)
: J8=Y-16*J9
1490 STR(D8$,2,1)=BIN(J9)
: D$=STR(D8$,3,1)
: ROTATE(D$,-4)
: D$=AND HEX(F0)
: D$=OR BIN(J8)
: ROTATE(D$,4)
: STR(D8$,3,1)=D$
: STR(E2$(),1+9*(C2-1),9)=D8$
: C3=1+INT(LEN(F$())/8)
1510 NEXT C3
1520 NEXT C2
1530 C9=C9+1
: IF C9=8THEN 1540
: GOTO 1210
1540 F4=F4+L
: GOSUB 1630
: IF D9=0THEN 1570
: F5=F4-J4+1
: D7,F6=0
: IF F5+J7<=4096THEN 1560
: F0$="The work fields for this screen cannot be moved"
: GOSUB 1790
: D7=9
: GOSUB 1630
: GOTO 1570
1560 F6=1
: GOSUB 1630
1570 IF A<=C1THEN GOSUB '38(104," ")
: IF A<=C1THEN END
: F6=0
: LIMITS T#3,F2$(J),C7,D,D,D
: IF A<>C7THEN GOSUB '38(104," ")
: IF A<>C7THEN END
: MAT REDIM E2$(D2)83
: DATA SAVE DA T#3,(A+8)E2$()
: IF F3<>9THEN 1590
: I=C1-1
: F3=0
1590 NEXT J
: NEXT I
1600 LOAD T#2,R3$(1)1000,
1610 END
1630 FOR C2=1TO F0
: D7$=STR(E3$(),1+8*(C2-1),8)
: D8$=STR(E2$(),1+9*(C2-1),9)
: D$=STR(D8$,6,1)
: D$=AND HEX(07)
: Y=VAL(D$)
: IF Y=0THEN GOSUB 1670
: NEXT C2
: RETURN
1670 IF D9=0OR D7=9THEN 1730
: D$=STR(D8$,3,1)
: ROTATE(D$,-4)
: D$=AND HEX(0F)
: Y=VAL(D$)+16*VAL(STR(D8$,2,1))
: IF F6<>1THEN 1700
: Y=Y+F5
: J9=INT(Y/16)
: J8=Y-16*J9
: STR(D8$,2,1)=BIN(J9)
: D$=STR(D8$,3,1)
: ROTATE(D$,-4)
: D$=AND HEX(F0)
: D$=OR BIN(J8)
: ROTATE(D$,4)
: STR(D8$,3,1)=D$
: STR(E2$(),1+9*(C2-1),9)=D8$
: RETURN
1700 IF Y<J4THEN J4=Y
: IF Y<J6THEN RETURN
: J6=Y
: J7=J6+VAL(STR(D8$,1,1))
: RETURN
1730 IF J5=9THEN 1760
: F0$=HEX(0C)
: GOSUB 1790
: F0$=" BATCH SCREEN UPDATE"
: GOSUB 1790
: F0$=HEX(0A)
: GOSUB 1790
: F0$="The following screen fields are unassociated with any data file:"
: GOSUB 1790
: F0$=HEX(0A)
: J5=9
: GOSUB 1790
: F0$="Screen Field"
: GOSUB 1790
: F0$=ALL(20)
: GOSUB 1790
1760 F0$=F2$(J)
: IF F2$(J)=D9$THEN 1770
: D9$=F2$(J)
: GOSUB 1790
1770 F0$=" "&D7$
: GOSUB 1790
: RETURN
1790 E0$()=BIN(LEN(F0$)+1)&F0$
: GOSUB '49(0)
: RETURN
1800 GOSUB '34(250)
: GOSUB '38(128," ")
1810 GOSUB '34(250)
: IF Q=0THEN RETURN
: IF Q<>31THEN 1810
: GOSUB '39(R3$(1),4)
: LOAD T#P,R3$(1)1000,
1850 END
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS61"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"