Listing of file='IDS2PU25' on disk='vmedia/701-2725B.wvd.zip'
# Sector 318, program filename = 'IDS2PU25'
1000 REM "IDS2PU25" - FIELD/OPERATION X-REFERENCE UTILITY (-REPORT TYPE 1-)
1120 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM D0$4,D1$8,D2$8,D3$1,D4$1,D5$80,D6$8,J1$(7)8
: D0,C8,D2=0
: D2$=" "
: MAT REDIM E3$(24)83,F$(24)83
: IF STR(J0$,,4)<>"IDS2"THEN F8=5
: ELSE F8=2
: DATA LOAD DA T#F8,(VAL(J8$,2))E3$(),F$()
: MAT REDIM E3$(1992)1,F$(E9)1
: GOSUB 2180
: PRINT AT(22,15,);BOX(-1,-49);AT(21,27);BOX(-1,-20)
1237 PRINT AT(21,11);BOX(1,58);" Printing References to Field ";HEX(22);"
";HEX(22);", Field Of"
: GOTO 1310
1270 IF J3$=J4$AND D2$=J3$THEN 2160
: MAT REDIM F$(24)83
: IF STR(J0$,,4)<>"IDS2"THEN F8=5
: ELSE F8=2
: DATA LOAD DA T#F8,(VAL(J8$,2)+8)F$()
: MAT REDIM F$(E9)1
1310 IF D2>249THEN 2160
: D2$=STR(F$(),8*(D2)+1,8)
: IF D2$=" "THEN 2160
: D2=D2+1
: IF D2$<J3$OR D2$>J4$THEN 1270
: CONVERT D2TO E$,(###)
: PRINT AT(21,42,8);D2$;AT(21,59,3);E$;AT(21,66,3);J9$
: D4,C8=0
: D4$,D5$=" "
1400 C8=C8+1
1406 KEYIN E6$,1406,1407
: GOTO 1420
1407 IF VAL(E6$)<>31THEN 1420
: E$="Cross Reference Cancelled"
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
: GOTO 2160
1420 IF E$(C8)<>HEX(0000000000000000)THEN 1480
: IF D4<>0THEN 1440
: CONVERT D2TO E$,(###)
: E$=E$&" "&STR(D2$,,8)&" - No References"
: GOSUB '48(0,E$,0)
: GOTO 1460
1440 IF D5$<>" "THEN GOSUB '48(0,STR(D5$,,LEN(D5$)-1),0)
: D5$=" "
1460 IF D1+1>58THEN GOSUB 2180
: GOSUB '49(0)
: GOSUB '49(0)
: D1=D1+2
: GOTO 1270
1480 D1$=E$(C8)
: STR(D1$,,1)=HEX(00)
: ROTATEC(D1$,8)
: FOR L=1TO 8
: ROTATEC(STR(D1$,L),-1)
: NEXT L
: D6$=D1$
: IF STR(E$(C8),,1)<>HEX(00)THEN D1$=OR ALL(20)
: D3$=E$(C8)
: D5=POS(HEX(0080C0)=D3$)
: ON D5GOTO ,1710,1710
: E$=STR(E2$(C8),3,1)AND HEX(0F)
: A=VAL(E$)
: E$=STR(E2$(C8),3,1)AND HEX(F0)
: ROTATEC(STR(E$,,1),-4)
: B=VAL(E$)
: C=VAL(E2$(C8),2)+8
: D=8
: GOTO 1760
1710 A=MAX(1,ABS(INT(-A*9/249)))
: B=MAX(1,ABS(INT(-A*8/249)))
: C=VAL(E2$(C8),2)+6
: D=6
1760 MAT REDIM F$(D)83
: P=VAL(STR(E2$(C8),4))
: DATA LOAD DA T#P,(VAL(E2$(C8),2))F$()
: J1$()=STR(F$(),78,55)
: MAT REDIM F$(A*3)83,E3$(B*3)83
: DATA LOAD DA T#P,(C)F$(),E3$()
: MAT REDIM F$(E9)1,E3$(249)8
: MAT SEARCHE3$(),=D2$TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1400
: Q=INT(VAL(F9$,2)/8)+1
1870 J1$=STR(F$(),(Q-1)*9+1,9)&ALL(00)
: D6=MOD(VAL(STR(J1$,6)),8)
: IF D6=0THEN 1400
: IF F9$=HEX(0000)AND J1$(D6)<>J1$THEN 1400
: IF D4<>0THEN 2010
: IF D1+2>58THEN GOSUB 2180
: CONVERT D2TO STR(E$),(###)
: STR(E$,5)=D2$
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
: D4=1
: D5$=" "
2010 IF STR(E$(C8),,1)=D4$THEN 2080
: D4$=STR(E$(C8),,1)
: IF D5$=" "THEN 2040
: IF D1+1>58THEN GOSUB 2180
: GOSUB '48(0,STR(D5$,,LEN(D5$)-1),0)
: GOSUB '49(0)
: GOSUB '49(0)
: D1=D1+2
: D5$=" "
2040 D5=POS(HEX(0080C0)=D4$)
: ON D5GOTO ,2060,2070
: D5$=" Screens -"
: GOTO 2080
2060 D5$=" Reports -"
: GOTO 2080
2070 D5$=" Batch Programs -"
2080 IF LEN(D5$)+LEN(D6$)+2<81THEN 2140
: IF D1+1>58THEN GOSUB 2180
: GOSUB '48(0,STR(D5$,,LEN(D5$)-1),0)
: GOSUB '49(0)
: D1=D1+1
: D5$=" "
: STR(D5$,21)=D6$&","
: GOTO 1400
2140 D5$=D5$&" "&D6$&","
: GOTO 1400
2160 GOSUB '48(0,HEX(0C0D),0)
: GOSUB '49(0)
: LOAD T#2,R3$(1)1000,
2180 D0=D0+1
: CONVERT D0TO D0$,(####)
: E0$()=HEX(01)
: GOSUB '48(0,HEX(0C0D),0)
: GOSUB '49(0)
: D1=0
: GOSUB '48(25,"DATA FILE FIELD CROSS-REFERENCE",0)
: GOSUB '49(0)
: GOSUB '49(0)
: D1=D1+2
: E$="Data File "&STR(J0$,,8)&" - "&STR(J0$,9,32)&" "&STR(R2$,,2)&"/"&
STR(R2$,3,2)&"/"&STR(R2$,5,2)&" Page "&D0$
2280 GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
: IF C8+D2<>0THEN 2510
: E0$()=HEX(01)
: GOSUB '49(0)
: D1=D1+1
: E$="File Types:"
: IF J0(1)=1THEN E$=E$&" "&"SCREENS -"
: IF J0(2)=1THEN E$=E$&" "&"REPORTS -"
: IF J0(3)=1THEN E$=E$&" "&"BATCH PROGRAMS -"
: E$=STR(E$,,LEN(E$)-2)
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
2390 IF POS(J1$<>HEX(00))+POS(J2$<>HEX(FF))=0THEN 2420
: E$="File Ranges: minimum -"
: IF POS(J1$<>HEX(00))=0THEN E$=E$&"**none**"
: ELSE E$=E$&" "&STR(J1$)&" maximum"
: IF POS(J2$<>HEX(FF))=0THEN E$=E$&"**none**"
: ELSE E$=E$&" "&J2$
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
2420 IF POS(J3$<>HEX(00))+POS(J4$<>HEX(FF))=0THEN 2450
: E$="Field Ranges: minimum -"
: IF POS(J3$<>HEX(00))=0THEN E$=E$&"**none**"&" maximum"
: ELSE E$=E$&" "&STR(J3$)&" maximum"
: IF POS(J4$<>HEX(FF))=0THEN E$=E$&"**none**"
: ELSE E$=E$&" "&J4$
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
2450 E$=J5$&J6$&J7$
: IF E$=" "THEN 2480
: E$="Version: "&STR(J5$)&" Application: "&STR(J6$)&" Function: "&STR(J7$)
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
2480 E$="Total Number Of Data File Fields: "&J9$
: GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
2510 GOSUB '49(0)
: D1=D1+1
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PU25"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"