image of READY prompt

Wang2200.org

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"