image of READY prompt

Wang2200.org

Listing of file='IDS2PC22' on disk='vmedia/701-2725B.wvd.zip'

# Sector 819, program filename = 'IDS2PC22'
1000 REM 'IDS2PC22'--REPORT CONVERSION----CONVERT FIELD NAMES AND PARAMETERS
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : COM D2$10,C(14),E1(4)
   : COM F1(8)
   : MAT REDIM E3$(249)8
   : DIM J1$(128)8,J2$(128)8,F5$(128)8
   : X,Y=1
   : X1,Y1=1
   : C8=0
   : GOSUB '39(J3$,D1)
   : MAT REDIM F$(128)8
   : A=A+4
   : FOR I=1TO 769STEP 256
   : DATA LOAD BA T#D1,(A,A)F$()
   : MAT COPY F$()<1,256>TO J1$()<I,256>
   : NEXT I
1110 FOR I=1TO 769STEP 256
   : DATA LOAD BA T#D1,(A,A)F$()
   : MAT COPY F$()<1,256>TO F5$()<I,256>
   : NEXT I
   : MAT REDIM F$(E9)1
   : INIT(20)E8$
   : MAT SEARCHJ1$(),=E8$TO F9$STEP 8
   : J8=128
   : IF F9$=HEX(0000)THEN 1130
   : J8=(VAL(F9$,2)-1)/8
1130 FOR I=1TO 8
   : E$=STR(E$(),70+I*8,8)
   : IF E$=" "THEN 1142
   : F5$=E$OR ALL(20)
1131 GOSUB '39(F5$,D4)
   : IF Q=2THEN 1135
1133 GOSUB '35("Specified file is not an IDEAS data file-key EXEC to cancel")
   : F6$(11)="N"
   : GOSUB '34(250)
   : GOTO 2810
1135 DATA LOAD BA T#P,(A)STR(E3$(),1,256)
   : IF STR(E3$(),1,4)<>HEX(8201D3E3)THEN 1133
   : MAT REDIM E3$(6)83
   : DATA LOAD DA T#P,(A)E3$()
   : IF STR(E3$(),10,1)<"5"THEN 1139
   : F5$=STR(E3$(),82)OR ALL(20)
   : GOTO 1131
1139 CONVERT STR(E3$(),93,4)TO F1(I)
   : F1(I)=MAX(F1(I),VAL(STR(E3$(),418)))
1142 NEXT I
   : FOR I=8TO 2STEP -1
   : F1(I)=F1(I-1)
   : NEXT I
   : F1(1)=1
   : FOR I=2TO 8
   : F1(I)=F1(I)+F1(I-1)
   : NEXT I
   : C8=F1(8)
   : GOTO 2610
1160 DEFFN'71(J9)
   : Q2=J9
   : GOSUB '45(19,J1$(Q2))
   : UNPACK(##)F5$(Q2)TO C0,J5,J2,F4
   : GOSUB '55(22,F4)
   : GOSUB '55(23,F4)
   : GOSUB '55(28,10*(C0/10-INT(C0/10)))
   : V=VAL(STR(F5$(Q2),5))
   : F4=V
   : GOSUB '55(20,F4)
   : V=VAL(STR(F5$(Q2),6))
   : C1=V
   : GOSUB '55(21,C1)
   : RETURN
1200 FOR I=1TO 4
   : GOSUB '43(19)
   : E7$=E$
   : E$=STR(E$(),70+I*8,8)
   : IF E$=" "THEN 1365
   : F5$=E$OR ALL(20)
1220 GOSUB '39(F5$,D4)
   : J5=P
   : E6=A
   : MAT REDIM E3$(6)83
   : DATA LOAD DA T#J5,(E6)E3$()
   : IF STR(E3$(),10,1)<"5"THEN 1230
   : F5$=STR(E3$(),82)OR ALL(20)
   : GOTO 1220
1230 MAT REDIM E3$(24)83
   : DATA LOAD DA T#J5,(E6+8)E3$()
   : MAT REDIM E3$(249)8
   : MAT SEARCHE3$(),=STR(E7$,1,8)TO F9$STEP 8
   : IF F9$>HEX(0000)THEN 1240
   : GOTO 1365
1240 GOSUB '55(17,I)
   : GOSUB '45(18,STR(E$(),70+I*8,8))
   : MAT REDIM E3$(24)83
   : DATA LOAD DA T#J5,(E6)E3$()
   : X=INT(VAL(F9$,2)/8)
   : E7$=STR(E3$(),499+X*6)
   : GOSUB '55(22,VAL(STR(E7$,3)))
   : GOSUB '55(23,Q)
   : GOSUB '55(24,(F1(I)-1+INT(VAL(E7$,2)/16)))
   : X=INT(MOD(VAL(STR(E7$,2)),16)/2)
   : IF X=0OR X=2THEN GOSUB '55(25,0)
   : IF X=1OR X=3THEN GOSUB '55(25,1)
   : IF X>3THEN GOSUB '55(25,2)
   : D7=Q
1330 IF MOD(VAL(E7$,2),2)=1THEN GOSUB '45(26,"Y")
   : ELSE GOSUB '45(26,"N")
   : IF INT(MOD(VAL(STR(E7$,6)),16)/8)=1THEN GOSUB '45(27,"Y")
   : ELSE GOSUB '45(27,"N")
   : GOSUB '55(28,MOD(VAL(STR(E7$,6)),8))
   : GOSUB 1400
   : GOSUB 1410
   : FOR J=31TO 33
   : GOSUB '45(J,"N")
   : NEXT J
   : MAT REDIM E3$(249)8
   : I=4
1365 NEXT I
   : GOSUB '43(17)
   : IF Q>0THEN 1370
   : GOSUB '45(17,"0")
   : GOSUB '55(24,C8)
   : GOSUB '43(22)
   : C8=C8+Q
1370 RETURN
1400 IF D7<>1THEN GOSUB '45(30," ")
   : GOSUB '43(30)
   : IF D7=1AND E$=" "THEN GOSUB '55(30,0)
   : RETURN
1410 GOSUB '43(22)
   : X,Y=Q
   : IF D7=2THEN 1500
   : IF E$(814)="Y"THEN Y=Y+1
   : IF E$(812)>"1"THEN Y=Y+1
   : IF E$(813)="N"THEN 1500
   : X=X-D7
   : GOSUB '43(28)
   : X=X-Q-SGN(Q)
   : Y=Y+INT((X-1)/3)
1500 IF Y<1THEN Y=1
   : GOSUB '55(23,Y)
   : RETURN
2120 E8$=ALL(00)
   : F2=F2+1
   : PRINT AT(23,1,10);"Packing ";
   : GOSUB '43(22)
   : E8$=BIN(Q)&ALL(00)
   : GOSUB '43(23)
   : E0$()=" "
   : STR(E0$(),,Q)=ALL(A3)
   : STR(E8$,9)=BIN(Q)
   : GOSUB '43(25)
   : D7=Q
   : IF Q=0OR Q=1THEN D5=D5+1
   : ELSE D6=D6+1
   : GOSUB '43(17)
   : F1=Q
   : STR(E8$,6,1)=BIN(D7*D7*16+F1+32)
   : GOSUB '43(24)
   : J5=Q
   : GOSUB '43(30)
   : C9=Q
   : IF E$(808)="Y"THEN Q=2
   : ELSE Q=0
2220 IF E$(809)="Y"THEN Q=Q+1
   : STR(E8$,2,2)=BIN(J5*16+C9*4+Q,2)
   : GOSUB '43(28)
   : STR(E8$,4,1)=BIN(128+Q)
   : D9=Q
   : STR(E8$,5,1)=BIN(C1)
   : STR(E8$,7,1)=BIN(POS(" 0123456789ABCDEFRP"=E$(811))*8)
   : IF E$(813)="Y"THEN OR (STR(E8$,7,1),04)
   : IF E$(814)="Y"THEN OR (STR(E8$,7,1),02)
   : IF E$(815)="Y"THEN OR (STR(E8$,7,1),01)
   : STR(E8$,8,1)=BIN(F4)
2320 IF D7=2THEN 2490
   : IF D7=0THEN 2390
   : ON C9GOTO 2360,2370,2380
   : E0$(1)=HEX(AD)
   : GOTO 2390
2360 E0$(LEN(E0$()))=HEX(AD)
   : GOTO 2390
2370 STR(E0$(),LEN(E0$())-1)=HEX(ADAD)
   : GOTO 2390
2380 STR(E0$(),LEN(E0$())-1)=HEX(ABAB)
2390 IF E$(814)="Y"THEN E0$(POS(E0$()=A3))=HEX(A4)
   : X=POS(-E0$()=A3)
   : IF D9=0THEN 2450
   : E0$(X-D9)=HEX(AE)
   : X=X-D9-1
2450 IF E$(813)="N"THEN 2490
   : FOR I=X-3TO POS(E0$()=A3)+1STEP -4
   : IF I>POS(E0$()=A3)THEN E0$(I)=HEX(AC)
   : NEXT I
2490 F6=F2
   : J2$(F6)=STR(E$(),784)
   : F$(F6)=E8$
   : DATA LOAD BA T#3,(E4+33+F4)E4$()
   : STR(E4$(),8+C1,VAL(STR(E8$,9)))=E0$()
   : E0$()=HEX(01)
   : DATA SAVE BA T#3,(E4+33+F4)E4$()
   : RETURN
2610 GOSUB '32("IDS2sR01")
   : MAT REDIM F$(INT(E9/9))9
   : F$()=ALL(00)
   : F5$="IDS2wS"
   : CONVERT R0TO STR(F5$,7),(##)
   : LIMITS T#3,F5$,A,B,C,D
   : IF D=0THEN GOTO 2630
   : E4=A
   : GOTO 2640
2630 GOSUB '35("Work file does not exist-Key EXEC to cancel")
   : F6$(11)="N"
   : GOSUB '34(250)
   : GOTO 2810
2640 PRINT HEX(020402000E)
   : F2,D5,D6=0
   : FOR J9=1TO J8
   : IF J1$(J9)<>" "THEN PRINT AT(23,0,44);BOX(1,42);AT(23,1);"Converting para
     meters for Field- ";AT(23,34);J1$(J9);
   : PRINT HEX(020400000F)
   : GOSUB 1160
   : IF F4=0AND C1=0THEN 2680
   : GOSUB 1200
   : GOSUB '36
   : GOSUB '43(20)
   : F4=Q
   : GOSUB '43(21)
   : C1=Q
   : IF F4>0AND C1>0THEN GOSUB 2120
   : STR(E$(),775,42)=" "
   : GOSUB '36
2680 NEXT J9
   : GOTO 2710
2710 PRINT HEX(03);AT(11,20);BOX(1,43);AT(11,22);"Saving report specifications
      to work file ";TAB(80)
   : F5$="IDS2wS"
   : CONVERT R0TO STR(F5$,7),(##)
   : LIMITS T#3,F5$,E4,B,C,D
   : IF D=0THEN GOTO 2630
   : CONVERT F2TO STR(E$(),152,3),(###)
   : STR(E$(),150,1)=BIN(F2)
   : CONVERT D5TO STR(E$(),842,3),(###)
   : CONVERT D6TO STR(E$(),839,3),(###)
   : STR(E$(),157,3)="000"
2760 E3$()=J2$()
   : MAT REDIM E$(24)83,F$(27)83,E3$(24)83,E2$(27)83
   : E2$()=ALL(00)
   : IF E4=0THEN 2630
   : DATA SAVE DA T#3,(E4)E$()
   : DATA SAVE DA T#3,(E4+8)F$()
   : DATA SAVE DA T#3,(E4+17)E3$()
   : DATA SAVE DA T#3,(E4+25)E2$()
   : MAT REDIM E$(E8)1,F$(E9)1
   : MAT REDIM E0$(249)1
   : LOAD T#2,"IDS2PC23"1000,
2810 COM CLEAR E3
   : SELECT #3<D9$(3)>
   : LOAD T#2,"IDS2PCMN"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PC22"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"