Listing of file='IDS2PR21' on disk='vmedia/701-2716B.wvd.zip'
# Sector 294, program filename = 'IDS2PR21'
1000 REM "IDS2PR21" - Release 2.1 - REPORT GENERATOR - GENERATE SELECTION CODE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: MAT REDIM F$(256)1
: DIM D$(256)1
: MAT REDIM E$(E8)1
: F9$="I:"
: E$=STR(E$(),1486,5)
: E$(1600)=BIN(LEN(E$))
: F$()=HEX(00FFFFFF)&"E6=0:"
: D$()="E$="
: MAT REDIM E$(E8)1
: IF E$(1468)=" "THEN 1260
: Q=1468
: F$()=" "
: D$()=HEX(00FFFFFF)&"E6=0:"&HEX(9F)
1160 GOSUB '71(Q)
: D$()=D$()&E$
: D$()=D$()&STR(E$(),Q+1,2)
: GOSUB '71(Q+3)
: D$()=D$()&E$
: IF STR(E$(),Q+1,3)=" "OR Q>1483THEN 1250
: IF STR(E$(),Q+1,3)="OR"THEN D$()=D$()&HEX(8B)
: ELSE D$()=D$()&HEX(8A)
: Q=Q+4
: GOTO 1160
1250 D$()=D$()&HEX(B1)&"E$="
1260 V=LEN(STR(E1$(),1))/56
: FOR J=28TO 40STEP 3
: IF STR(E1$(V),J,3)>HEX(0000)THEN GOSUB '77(MOD(VAL(STR(E1$(V),J),2),32768
),VAL(STR(E1$(V),J+2)))
: NEXT J
: D$()=STR(D$(),,LEN(D$())-1)
: IF E$(1468)<>" "THEN D$()=D$()&":"&HEX(F2)&"E6=1"
: IF LEN(F$())+LEN(D$())>250THEN 1340
1310 IF E$(1468)<>" "AND F$()=" "THEN F$()=D$()
: ELSE IF E$(1468)<>" "THEN F$()=F$()&HEX(0D)&STR(D$(),2)
: ELSE F$()=F$()&D$()
: D$()=" "
1340 MAT SEARCHF$(),=HEX(FFFFFF)TO F9$
: IF F9$=HEX(0000)THEN 1390
: U=U+1
: PACK(####)STR(F$(),VAL(F9$,2)+1,2)FROMU
: GOTO 1340
1390 MAT SEARCHD$(),=HEX(FFFFFF)TO F9$
: IF F9$=HEX(0000)THEN 1450
: U=U+1
: PACK(####)STR(F$(),VAL(F9$,2)+1,2)FROMU
: GOTO 1390
1450 IF LEN(F$())<256THEN F$()=F$()&HEX(0D0000FD)&ALL(00)
: DATA SAVE BA T#2,(X,X)F$()
: IF D$()=" "THEN 1510
: D$()=D$()&HEX(0D0000FD)&ALL(00)
: DATA SAVE BA T#2,(X,X)D$()
1510 DATA LOAD BA T#2,(X-1)F$()
: STR(F$(),,1)=HEX(20)
: $TRAN(F$(),HEX(FEFD))R
: DATA SAVE BA T#2,(X-1)F$()
: E8$="IDS2PBX4"
: F5$="IDS2PX"
: CONVERT R0TO STR(F5$,7),(##)
: IF X>ZTHEN E8$=E8$&F5$
: CONVERT STR(E$(),1746,5)TO Q
: STR(E$(),1741,2)=BIN(Q,2)
: MAT REDIM E2$(250)9
: LOAD T#2,<LEN(E8$)/8>E8$1000,1994
1630 DEFFN'71(Q)
: IF E$(Q)="V"THEN 1780
: M=POS("ABCDEFGHIJKLMNO"=E$(Q))
: CONVERT E(POS("01234567"=E$(871+M)))-1+INT(VAL(STR(E$(),1596+M*6),2)/16)T
O E8$,(#####)
: CONVERT VAL(STR(E$(),1598+M*6))TO F5$,(####)
1700 E$=HEX(D3)&"E$(),"&STR(E8$,POS(E8$<>"0"),POS(-E8$<>20)-POS(E8$<>"0")+1)&"
,"&STR(F5$,POS(F5$<>"0"),POS(-F5$<>20)-POS(F5$<>"0")+1)&")"
: IF MOD(INT(VAL(E$(1597+M*6))/2),8)>3THEN RETURN
: F$()=F$()&HEX(0DFFFFFF)&HEX(AE)&E$&HEX(B2)&F9$&HEX(EB)&STR(F9$,,1)&"=0"
: IF STR(F$(),2,1)=HEX(0D)THEN STR(F$(),2)=STR(F$(),3)
: E$=STR(F9$,,1)
1760 STR(F9$,,1)=ADDHEX(01)
: IF E$=" "THEN E$="0"
: RETURN
1780 M=POS("ABCDEFGHIJKLMNO"=E$(Q-3))
: Y=INT((Q-1468)/6)
: IF MOD(INT(VAL(E$(1597+M*6))/2),8)>3THEN 1806
: E$=" "
: GOSUB 1814
: IF E$=" "THEN E$="0"
: E$=STR(E$,POS(E$>20))
: RETURN
1806 E$=HEX(22)
: GOSUB 1814
: STR(E$,MAX(3,LEN(E$)+1))=HEX(22)
: RETURN
1814 STR(E$,2)=STR(E$(),777+Y*20,VAL(E$(1598+M*6)))
: RETURN
1830 DEFFN'77(P,L)
: D$()=D$()&HEX(D3)&"E$()"
: GOSUB 1890
: GOSUB 1890
: D$()=D$()&")&"
: RETURN
1890 F5$=" "
: $PACK(F=HEX(1006))F5$FROMP
: STR(F5$,,1)=","
: D$()=D$()&F5$
: P=L
: RETURN
1990 % Used to Protect Report Execution
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR21"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"