image of READY prompt

Wang2200.org

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"