Listing of file='IDS2PP21' on disk='vmedia/701-2724B.wvd.zip'
# Sector 655, program filename = 'IDS2PP21'
1000 REM "IDS2PP21" - INTERACTIVE PROGRAM GENERATOR - P/F SPECS U&V DISPLAY FI
ELDS
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: F5$=F1$
: GOSUB 3050
: IF C9>21THEN 2000
: IF Q>249THEN J5$="1"
: ELSE J5$=E8$
: F5$=F2$
: GOSUB 3050
: IF Q>249THEN E8$="F0"
: CONVERT J5$TO Q
: IF E8$<>"F0"THEN CONVERT E8$TO A
: ELSE A=0
: IF Q=ATHEN 1100
: IF Q+1=ATHEN 1130
: E4$()=E4$()&HEX(9E)&"I="&J5$&HEX(B2)&E8$&HEX(BA9A)&"'37(I)"&HEX(BA9D49BA)
1080 CONVERT J5$TO Q
: IF E8$<>"F0"THEN CONVERT E8$TO A
: ELSE A=0
: E0$()="Display from "
: IF F1$=" "THEN E0$()=E0$()&" the first field"
: ELSE E0$()=E0$()&" field "&HEX(22)&E3$(Q)&HEX(22)
: E0$()=E0$()&" to"
: IF A=0THEN E0$()=E0$()&" the last field"
: ELSE E0$()=E0$()&" FIELD "&HEX(22)&E3$(A)&HEX(22)
: GOTO 3000
1100 E4$()=E4$()&HEX(9A)&"'37("&E8$&")"&HEX(BA)
: E0$()="Display Field "&HEX(22)&E3$(Q)&HEX(22)
: GOTO 3000
1130 E4$()=E4$()&HEX(9A)&"'37("&J5$&")"&HEX(BA9A)&"'37("&E8$&")"&HEX(BA)
: E0$()="Display Field "&HEX(22)&E3$(Q)&HEX(22)&" and Field "&HEX(22)&E3$(A
)&HEX(22)
: GOTO 3000
2000 IF F1$<>F2$OR F1$=" "THEN 2009
: E4$()=E4$()&HEX(9A)&"'43("&E8$&HEX(29BA9A)&"'54(K$)"&HEX(BA9A)&"'37("&HEX
(F8)&"Q,F0))"&HEX(BA)
: E0$()="Display contents of field named in "&F1$
: GOTO 3000
2009 E4$()=E4$()&HEX(9A)&"'43("&E8$&HEX(29BA9A)&"'54(E$)"&HEX(BA)&"J=Q"&HEX(BA
9F)&"J>249"&HEX(B1)&"J=1"&HEX(BA)
: F5$=F2$
: GOSUB 3050
: E4$()=E4$()&HEX(9A)&"'43("&E8$&HEX(29BA9A)&"'54(E$)"&HEX(BA)&"K="&HEX(F8)
&"Q,F0)"&HEX(BA)
: E4$()=E4$()&HEX(9E)&"I=J"&HEX(B2)&"K"&HEX(BA9A)&"'37(I)"&HEX(BA9D49BA)
2040 E0$()="Display fields indirect using "&HEX(22)&F1$&HEX(22)&" and "&HEX(22
)&F2$&HEX(22)
3000 IF E2(2)>0THEN E4$()=E4$()&HEX(A2)&E0$()&HEX(BA)
: IF STR(E4$(),LEN(E4$()))=HEX(BA)THEN STR(E4$(),LEN(E4$()))=HEX(1B)
: IF POS(E4$()=BA)>0THEN E$=F0$
: IF E$<>" "THEN STR(F$(),LEN(F$())+1)=E$
: IF E4$()<>" "THEN STR(F$(),LEN(F$())+1)=STR(E4$(),POS(E4$()>20))
: LOAD DA T#2,(D$(13))1000,
3020 STOP #
: PRINT HEX(06020402000E);AT(23,16);"Compiling BASIC program - Now processi
ng sector";E4-E3+1;
: RETURN
3040 STOP "END IT"
3050 Q=250
: IF F5$=" "THEN 3070
: MAT SEARCHE3$(),=STR(F5$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)
: IF Q<250THEN 3070
: IF VER(F5$,"@TSTFLD#")=8THEN Q=VAL(STR(F5$,8))+203
: MAT SEARCHC8$,=STR(F5$,,8)TO F9$
: IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)+260
: IF F5$="@SYSBUF0"THEN Q=269
: IF F5$<"FILE # 1"OR F5$>"FILE # 7"THEN 3070
3060 F5$=STR(C8$,(VAL(STR(F5$,8))-48)*8+1)
: GOTO 3050
3070 DEFFN'71(Q)
: E8$=" "
: $PACK(F=HEX(1006))E8$FROMQ
: E8$=STR(E8$,POS(E8$>20))
: RETURN
3080 IF STR(F5$,,2)="IF"THEN F9$=HEX(8A)
: IF STR(F5$,,2)="OR"THEN F9$=HEX(8B)
: IF LEN(E$)>1THEN E$=E$&F9$
: $TRAN(F9$,HEX(8A8B8B8A))R
: IF LEN(F0$)>1THEN F0$=F0$&F9$
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PP21"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"