Listing of file='IDS2PS06' on disk='vmedia/701-2716B.wvd.zip'
# Sector 687, program filename = 'IDS2PS06'
1000 REM "IDS2PS06" - Release 2.1 - SCREEN MASK DEFAULT VALUES FOR FIELD ATTRI
BUTES
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: COM F1,F1$8
: DIM J1$69
: Y=R
: X=C
: S=VAL(F$(Y*80+X+1))
: IF S>0THEN 1050
: IF Z=249THEN 1062
: IF E2$(Z+1)>HEX(000000000000000000)THEN 1062
1050 IF S>0THEN E$=E2$(S)
: ELSE E$=HEX(00)&BIN(J4*16,2)&BIN(Y*8)&BIN(X*2+1)&HEX(70801400)
: F$()=E2$()
: GOSUB '32("IDS2sS01")
: E2$(99)=E$
: J1$=E$()
: GOSUB '45(33,E9$(2))
: IF S=0THEN S=Z+1
: GOTO 1065
1062 PRINT AT(23,0,80);BOX(-1,-3);AT(23,4);BOX(-1,-3);AT(23,8);BOX(-1,-20);BOX
(-1,-39);BOX(-1,-56);BOX(-1,-70);
: GOSUB '35("You may not specify any more fields - EXEC to cancel")
: F6$(11)="N"
: GOSUB '34(250)
: R=Y
: C=X
: GOSUB 2040
: LOAD T#2,"IDS2PS04"1000,
1065 F1=MOD(VAL(STR(E2$(99),6)),8)
: GOSUB '55(1,F1)
: FOR I=25TO 31
: GOSUB '37(I)
: NEXT I
: I=99
: IF F1=0THEN E$=" "
: ELSE E$=STR(E$(),70+8*MOD(VAL(STR(E2$(I),6)),8),8)
: GOSUB '45(32,E$)
: IF E$=" "THEN F1=0
: GOSUB '55(34,S)
: OR (E4$(),10)
: E$="FIELD"&E4$()
: IF S<=ZTHEN E$=E3$(S)
: GOSUB '45(2,E$)
: C3$=STR(E$(),61,8)&STR(E$,,8)
1091 IF F1=0THEN 1100
: E7$=E$
: GOSUB '43(32)
: OR (E$,20)
: GOSUB '39(E$,5)
: MAT REDIM E2$(27)83,E3$(24)83
: DATA SAVE DA T#3,(E4+25)E2$(),E3$()
: MAT REDIM E2$(6)83
: DATA LOAD DA T#P,(A)E2$()
: E$=STR(E2$(),82,8)OR ALL(20)
: GOSUB '39(E$,5)
: MAT REDIM E2$(24)83
: DATA LOAD DA T#P,(A)E2$(),E3$()
: MAT SEARCHE3$(),=STR(E7$,1,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN 1093
: F1=0
: GOTO 1099
1093 E$=E7$
: E7$=STR(E2$(),493+(INT(VAL(F9$,2)/8)+1)*6,6)
1099 MAT REDIM E2$(27)83,E3$(24)83
: DATA LOAD DA T#3,(E4+25)E2$(),E3$()
: MAT REDIM E2$(250)9,E3$(249)8
1100 GOSUB '55(3,INT(VAL(STR(E2$(I),4))*.125)+1)
: GOSUB '55(4,INT(VAL(STR(E2$(I),5))*.5)+1)
: IF F1>0THEN GOSUB '55(5,VAL(STR(E7$,3)))
: ELSE IF Y<23THEN GOSUB '55(5,VAL(E2$(I)))
: ELSE GOSUB '55(5,1)
: IF F1>0THEN GOSUB '55(6,F1(F1)-1+INT(VAL(E7$,2)/16))
: ELSE GOSUB '55(6,INT(VAL(STR(E2$(I),2),2)*.0625))
1140 IF F1>0THEN GOSUB '55(7,INT(MOD(VAL(STR(E7$,2)),16)/2))
: ELSE IF Y<23THEN GOSUB '55(7,INT(VAL(STR(E2$(I),6))*.0625))
: ELSE GOSUB '55(7,9)
: IF F1>0THEN GOSUB '71(8,MOD(VAL(STR(E7$,2)),2))
: ELSE GOSUB '71(8,INT(MOD(VAL(STR(E2$(I),3)),4)*.5))
: IF F1>0THEN GOSUB '71(9,INT(MOD(VAL(STR(E7$,6)),16)/8))
: ELSE GOSUB '71(9,MOD(VAL(STR(E2$(I),3)),2))
1170 IF F1>0THEN GOSUB '55(10,MOD(VAL(STR(E7$,6)),8))
: ELSE GOSUB '55(10,MOD(VAL(STR(E2$(I),4)),8))
: IF Y<23THEN GOSUB '55(11,INT(VAL(STR(E2$(I),7))*.015625))
: ELSE GOSUB '55(11,0)
: GOSUB '71(12,MOD(VAL(STR(E2$(I),5)),2))
: GOSUB '71(13,INT(MOD(VAL(STR(E2$(I),3)),16)*.125))
: GOSUB '71(14,INT(MOD(VAL(STR(E2$(I),3)),8)*.25))
: GOSUB '71(15,INT(MOD(VAL(STR(E2$(I),8)),4)*.5))
1230 IF Y<23THEN GOSUB '71(16,INT(MOD(VAL(STR(E2$(I),8)),64)*.03125))
: ELSE GOSUB '45(16,"Y")
: GOSUB '71(23,MOD(INT(VAL(STR(E2$(99),6))/8),2))
: IF E$="Y"THEN STR(C3$,25,1)=BIN(MOD(VAL(STR(E2$(99),7)),64)+1)
: ELSE STR(C3$,25,1)=BIN(0)
: IF E$="Y"THEN GOSUB '55(24,MOD(VAL(STR(E2$(99),7)),64)+1)
: ELSE GOSUB '55(24,0)
: R=Y
: C=X
: E$="IDS2PS07"
: LOAD T#2,E$1000,
2010 STOP #
2020 DEFFN'71(A,Q)
: IF Q=1THEN GOSUB '45(A,"Y")
: ELSE GOSUB '45(A,"N")
: RETURN
2030 STOP #
2040 PRINT HEX(060F);AT(23,0);BOX(1,3);AT(23,4);BOX(1,3);AT(23,0);
: PRINTUSING " ## ## FN'0 = Edit Field FN'16 = Edit Box FN'31 = Canc
el EXEC = Save";R+1,C+1;
: PRINT AT(23,8);BOX(1,20);BOX(1,39);BOX(1,56);BOX(1,70);
: PRINT HEX(01)
: RETURN
2050 DEFFN'127"Q$=";HEX(22);"IDS2PS06";HEX(22);":SCRATCH T Q$:SAVE DC T()Q$ ";
HEX(0D)
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS06"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"