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"