Listing of file='IDS2PU26' on disk='vmedia/701-2725B.wvd.zip'
# Sector 338, program filename = 'IDS2PU26'
1000 REM "IDS2PU26" - FIELD/OPERATION X-REFERENCE UTILITY (-REPORT TYPE 2-)
1150 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM D0$4,D1$8,D2$8,D3$1,D4$80,D6$8,D7$9,D8$6,D9$19,J1$(7)8
: C8,D2=0
1250 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
1280 IF D2>249THEN 2760
: D2$=STR(F$(),8*(D2)+1,8)
: IF D2$=" "THEN 2760
: D8$=STR(E3$(),499+D2*6)
: D2=D2+1
: IF D2$<J3$OR D2$>J4$THEN 1280
: IF D2$>J4$OR D2$<J3$THEN 1250
: CONVERT D2TO E$,(###)
: PRINT AT(21,42,8);D2$;AT(21,59,3);E$;AT(21,66,3);J9$
: D4,C8=0
1420 C8=C8+1
1440 KEYIN E6$,1440,1450
: GOTO 1490
1450 IF VAL(E6$)<>31THEN 1490
: E$="Cross Reference Cancelled"
: GOSUB 3330
: GOTO 2760
1490 IF C8<250AND E$(C8)<>HEX(0000000000000000)THEN 1530
: IF D4<>0THEN 1510
: IF D1+1>57THEN GOSUB 2780
: E$=" "
: CONVERT D2TO E$,(###)
: E$=E$&" "&STR(D2$,,8)&" "&STR(J0$,,8)&" - No References"
: GOSUB 3330
1510 GOSUB 3330
: GOTO 1250
1530 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 ,1760,1760
: 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 1820
1760 A=MAX(1,ABS(INT(-A*9/249)))
: B=MAX(1,ABS(INT(-A*8/249)))
: C=VAL(E2$(C8),2)+6
: D=6
1820 P=VAL(STR(E2$(C8),4))
: MAT REDIM F$(D)83
: 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 1420
: Q=INT(VAL(F9$,2)/8)+1
: D7$=STR(F$(),(Q-1)*9+1,9)
: D6=MOD(VAL(STR(D7$,6)),8)
: IF D6=0THEN 1420
1950 IF F9$=HEX(0000)AND J1$(D6)<>D7$THEN 1420
: IF D4<>0THEN 2290
: E$=" "
: STR(E$,57)="(--------- N/A --------)"
: CONVERT D2TO STR(E$,,3),(###)
: STR(E$,5,26)=STR(D2$,,8)&" "&STR(J0$,,8)&" D (N/A) "
: CONVERT VAL(STR(D8$,3))TO STR(E$,31,3),(###)
: Q=POS(STR(E$,31,3)<>"0")
: $TRAN(STR(E$,31,MIN(Q,2)),HEX(2030))R
: STR(E$,35,3)="N/A"
2120 F9$=STR(D8$,,2)
: F9$=AND HEX(FFF0)
: ROTATEC(F9$,-4)
: CONVERT VAL(F9$,2)TO STR(E$,39,4),(####)
: Q=POS(STR(E$,39,4)<>"0")
: $TRAN(STR(E$,39,MIN(Q,3)),HEX(2030))R
: CONVERT VAL(F9$,2)+VAL(STR(D8$,3))-1TO STR(E$,44,4),(####)
: Q=POS(STR(E$,44,4)<>"0")
: $TRAN(STR(E$,44,MIN(Q,3)),HEX(2030))R
2160 F9$=STR(D8$,2,1)AND HEX(0E)
: ROTATEC(STR(F9$,,1),-1)
: CONVERT VAL(F9$)TO STR(E$,49,1),(#)
: F9$=STR(D8$,2,1)AND HEX(01)
: IF VAL(F9$)=0THEN STR(E$,51,1)="."
: ELSE CONVERT VAL(F9$)TO STR(E$,51,1),(#)
: F9$=STR(D8$,6,1)AND HEX(04)
: IF VAL(F9$)=0THEN STR(E$,53,1)="."
: ELSE CONVERT VAL(F9$)TO STR(E$,53,1),(#)
: F9$=STR(D8$,6,1)AND HEX(07)
: IF VAL(F9$)=0THEN STR(E$,55,1)="."
: ELSE CONVERT VAL(F9$)TO STR(E$,55,1),(#)
2240 D4$=E$
: IF D1+2>57THEN GOSUB 2780
: GOSUB 3330
: D4=1
2290 E$=" "
: D5=POS(HEX(0080C0)=STR(E$(C8),,1))
: ON D5GOTO ,2310,2320
: STR(E$,23,1)="S"
: GOTO 2340
2310 STR(E$,23,1)="R"
: GOTO 2340
2320 STR(E$,23,1)="B"
: GOTO 2340
2340 STR(E$,14,8)=D6$
: IF STR(E$,23,1)<>"S"THEN 2360
: F9$=STR(D7$,5,1)AND HEX(FE)
: ROTATEC(STR(F9$,,1),-1)
: STR(D7$,5,1)=ADDHEX(01)
: GOTO 2370
2360 F9$=STR(D7$,5,1)
2370 IF VAL(F9$)<>0THEN CONVERT VAL(F9$)TO STR(E$,28,2),(##)
: ELSE STR(E$,28,2)="."
: $TRAN(STR(E$,28,1),HEX(2030))R
: CONVERT VAL(D7$)TO STR(E$,31,3),(###)
: Q=POS(STR(E$,31,3)<>"0")
: $TRAN(STR(E$,31,MIN(Q,2)),HEX(2030))R
: F9$=STR(D7$,2,2)AND HEX(FFF0)
: ROTATEC(F9$,-4)
: CONVERT VAL(F9$,2)TO STR(E$,39,4),(####)
: Q=POS(STR(E$,39,4)<>"0")
: $TRAN(STR(E$,39,MIN(Q,3)),HEX(2030))R
2400 CONVERT VAL(F9$,2)+VAL(D7$)-1TO STR(E$,44,4),(####)
: Q=POS(STR(E$,44,4)<>"0")
: $TRAN(STR(E$,44,MIN(Q,3)),HEX(2030))R
: F9$=STR(D7$,3,1)AND HEX(02)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,51,1)="."
: ELSE STR(E$,51,1)="Y"
: F9$=STR(D7$,3,1)AND HEX(01)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,53,1)="."
: ELSE STR(E$,53,1)="Y"
2440 F9$=STR(D7$,4,1)AND HEX(07)
: IF VAL(F9$)<>0THEN CONVERT VAL(F9$)TO STR(E$,55,1),(#)
: ELSE STR(E$,55,1)="."
: ON POS("SRB"=STR(E$,23,1))GOTO ,2590,2660
: F9$=STR(D7$,6,1)AND HEX(F0)
: ROTATEC(STR(F9$,,1),-4)
: CONVERT VAL(F9$)TO STR(E$,49,1),(#)
: STR(E$,72)="(- N/A -)"
: STR(E$,35,3)="N/A"
2490 F9$=STR(D7$,4,1)AND HEX(F8)
: ROTATEC(STR(F9$,,1),-3)
: CONVERT VAL(STR(F9$))+1TO STR(E$,25,2),(##)
: $TRAN(STR(E$,25,1),HEX(2030))R
: F9$=STR(D7$,7,1)AND HEX(C0)
: ROTATEC(STR(F9$,,1),-6)
: CONVERT VAL(F9$)TO STR(E$,57,1),(#)
: $TRAN(STR(E$,57,1),HEX(2E30))R
: F9$=STR(D7$,5,1)AND HEX(01)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,59,1)="."
: ELSE STR(E$,59,1)="Y"
2520 F9$=STR(D7$,3,1)AND HEX(08)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,61,1)="."
: ELSE STR(E$,61,1)="Y"
: F9$=STR(D7$,3,1)AND HEX(04)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,63,1)="."
: ELSE STR(E$,63,1)="Y"
: F9$=STR(D7$,8,1)AND HEX(02)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,65,1)="."
: ELSE STR(E$,65,1)="Y"
2550 F9$=STR(D7$,8,1)AND HEX(20)
: IF STR(F9$,,1)=HEX(00)THEN STR(E$,67,1)="."
: ELSE STR(E$,67,1)="Y"
: F9$=STR(D7$,7,1)AND HEX(3F)
: IF VAL(F9$)=0THEN STR(E$,69,1)="."
: ELSE CONVERT VAL(STR(F9$))TO STR(E$,69,2),(##)
: $TRAN(STR(E$,69,1),HEX(2030))R
: GOTO 2720
2590 STR(E$,57)="(--- N/A ----)"
: F9$=STR(D7$,6,1)AND HEX(50)
: STR(E$,49,1)="2"
: IF F9$=HEX(10)THEN STR(E$,49,1)="1"
: ELSE IF F9$=HEX(00)THEN STR(E$,49,1)="."
: CONVERT VAL(STR(D7$,8,1))TO STR(E$,25,2),(##)
: $TRAN(STR(E$,25,1),HEX(2030))R
: CONVERT VAL(STR(D7$,9,1))TO STR(E$,35,3),(###)
: Q=POS(STR(E$,35,3)<>"0")
: $TRAN(STR(E$,35,MIN(Q,2)),HEX(2030))R
2620 IF MOD(VAL(STR(D7$,7)),8)>3THEN STR(E$,76,1)="Y"
: ELSE STR(E$,76,1)="."
: IF MOD(VAL(STR(D7$,7)),4)>1THEN STR(E$,78,1)="Y"
: ELSE STR(E$,78,1)="."
: GOTO 2680
2660 STR(E$,25,5)="(N/A)"
: STR(E$,35,3)="N/A"
: STR(E$,57)="(--- N/A ----) (N/A)"
: F9$=STR(D7$,6,1)AND HEX(50)
: STR(E$,49,1)="2"
: IF F9$=HEX(10)THEN STR(E$,49,1)="1"
: ELSE IF F9$=HEX(00)THEN STR(E$,49,1)="."
2680 D9$=".0123456789ABCDEFRP"
: STR(E$,72,1)=STR(D9$,INT(VAL(STR(D7$,7))/8),1)
: ERRORSTR(E$,72,1)="."
2690 IF STR(E$,48,1)<>"2"THEN CONVERT INT(MOD(VAL(STR(D7$,3)),16)/4)TO STR(E$,
74,1),(#)
: $TRAN(STR(E$,74,1),HEX(2E302E20))R
: IF MOD(VAL(STR(D7$,7)),2)=1THEN STR(E$,80,1)="Y"
: ELSE STR(E$,80,1)="."
2720 D4$=E$
: IF D1+1>57THEN GOSUB 2780
: GOSUB 3330
: GOTO 1420
2760 E$=HEX(0C0D)
: GOSUB 3330
: LOAD T#2,R3$(1)1000,
2780 D0=D0+1
: CONVERT D0TO D0$,(####)
: E0$()=HEX(01)
: E$=HEX(0C0D)
: GOSUB 3330
: D1=0
: E$=" "
: STR(E$,25)="DATA FILE FIELD CROSS-REFERENCE"
: GOSUB 3330
: GOSUB 3330
: E$="Data File "&STR(J0$,,8)&" - "&STR(J0$,9,32)&" "&STR(R2$,,2)&"/"&
STR(R2$,3,2)&"/"&STR(R2$,5,2)&" Page "&D0$
: GOSUB 3330
: E$=" "
: STR(E$,23,1)="T"
3013 STR(E$,49)="T J Z D F E N # S C B"
: GOSUB 3330
: STR(E$,16)="FILE Y R C"
: STR(E$,49)="Y U F D I K R U X B E G I M F L"
: GOSUB 3330
: E$="FLD"
: STR(E$,16)="WHERE P O O LENGTH POSITION P S I E S B Q L E P D R G M
L N"
: GOSUB 3330
3021 E$=" # FIELD USED E W L MEM RPT BEG END E T L C P D D L C S
T P N A T K"
: GOSUB 3330
: E$="--- -------- -------- - -- -- --- --- ---- ---- - - - - - - - - - - -
- - - - - -"
3330 GOSUB '48(0,E$,0)
: GOSUB '49(0)
: D1=D1+1
: E$=" "
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PU26"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"