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"