Listing of file='IDS2PS07' on disk='vmedia/701-2716B.wvd.zip'
# Sector 702, program filename = 'IDS2PS07'
1000 REM "IDS2PS07" - Release 2.1 - SCREEN MASK FIELD EDITOR - ELT - 101981
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: STR(F6$(),11,4)="NNNN"
: Y=R
: X=C
: GOTO 1040
1030 PRINT HEX(07);
1040 GOSUB '63("Touch the FN key"," corresponding to the desired operation or
EXECUTE to accept"," ")
1050 GOSUB '34(250)
: IF Y<23OR Q=5OR Q=1OR Q=16THEN 1060
: IF Q<20OR Q=28THEN 1030
: IF Q>32THEN 1030
1060 IF Q=32THEN 2050
: IF Q=34THEN 2000
: ON Q+1GOTO 1090,1170,1240,1250,1260,1270,1280,1290,1300,1320,1350,1360,13
80,1390,1400,1410,1470,,,,,,,,2030,2020,2010,,,,,2040
: GOTO 1030
1090 GOSUB '34(1)
1095 F1=Q
: IF Q=0THEN 1100
: IF Q<8AND STR(E$(),Q*8+70,8)<>" "THEN 1100
: GOSUB '38(60," ")
: GOTO 1090
1100 IF Q>0THEN GOSUB '43(Q+24)
: ELSE E$=" "
: GOSUB '45(32,E$)
: IF E$=" "THEN 1040
1110 F6$(13)="Y"
: GOSUB '34(2)
: F6$(13)="N"
: IF F=1THEN 1095
: GOSUB 2080
: MAT SEARCHE3$(),=STR(E$,,8)TO F9$
: IF F9$=HEX(0000)THEN 1115
: GOSUB '43(34)
: IF INT(VAL(F9$,2)/8)+1=QTHEN 1115
: GOSUB '38(32," ")
: GOTO 1165
1115 F6$(13)="N"
: IF F=1THEN 1100
: MAT REDIM F$(27)83,E3$(24)83
: DATA SAVE DA T#3,(E4+8)F$()
: DATA SAVE DA T#3,(E4+17)E3$()
: GOSUB '43(1)
: GOSUB '43(Q+24)
: OR (E$,20)
: GOSUB '39(E$,5)
: MAT REDIM F$(6)83
: DATA LOAD DA T#P,(A)F$()
: E$=STR(F$(),82,8)OR ALL(20)
: GOSUB '39(E$,5)
: MAT REDIM F$(24)83
: DATA LOAD DA T#P,(A)F$(),E3$()
1120 GOSUB '43(2)
: MAT SEARCHE3$(),=STR(E$,1,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN 1130
: GOSUB '38(34,E$)
: GOSUB 1160
: GOTO 1110
1130 F2=INT(VAL(F9$,2)/8)+1
: GOSUB '55(5,VAL(STR(F$(),495+F2*6)))
: I=Q
: GOSUB '55(6,F1(F1)-1+INT(VAL(STR(F$(),493+F2*6),2)/16))
: GOSUB '55(7,INT(MOD(VAL(STR(F$(),494+F2*6)),16)/2))
: IF MOD(VAL(STR(F$(),494+F2*6)),2)=1THEN GOSUB '45(8,"Y")
: ELSE GOSUB '45(8,"N")
1150 IF INT(MOD(VAL(STR(F$(),498+F2*6)),16)/8)=1THEN GOSUB '45(9,"Y")
: ELSE GOSUB '45(9,"N")
: GOSUB '55(10,MOD(VAL(STR(F$(),498+F2*6)),8))
: GOSUB 1160
: GOTO 1040
1160 MAT REDIM F$(27)83
: DATA LOAD DA T#3,(E4+8)F$(),E3$()
: MAT REDIM F$(E9)1,E3$(249)8
: RETURN
1165 GOSUB '45(2," ")
1170 GOSUB '43(1)
: IF E$=" "THEN 1090
: F1=Q
: IF Q>0THEN 1100
: GOSUB '34(2)
: GOSUB 2080
: IF VAL(E$(135))=0THEN 1040
: MAT SEARCHE3$(),=STR(E$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1224
: GOSUB '43(34)
: IF INT(VAL(F9$,2)/8)+1=QTHEN 1224
: GOSUB '38(32," ")
: GOTO 1165
1224 MAT SEARCH"BLANKFLDCPU ID #STATION#TERMINALPARTIT'NOPERATORUSERCLASNEWTRA
N#NEXTSEQ#",=STR(E$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)OR VER(E$,"@TSTFLD#")=8OR E$="@SYSBUF0"THEN 1230
: IF E$>"FILE # 0"AND E$<"FILE # 8"THEN 1230
: GOTO 1040
1230 GOSUB '38(33," ")
: GOTO 1165
1240 GOSUB '34(3)
: IF Q>0AND Q<24THEN 1040
: GOSUB '35("Row must be from 1 to 23")
: GOTO 1240
1250 GOSUB '34(4)
: J0=Q
: GOSUB '43(5)
: IF J0>0AND J0+Q<82THEN 1040
: GOSUB '38(61,"Column")
: GOTO 1250
1260 IF F1>0THEN 1030
: GOSUB '34(5)
: J0=Q
: GOSUB '43(4)
: IF J0>0AND Q+J0<82THEN 1040
: GOSUB '43(11)
: A=Q
: GOSUB '43(12)
: IF A=0AND Q=0AND J0<256AND J0>0THEN 1040
: IF A=0AND Q=0THEN GOSUB '35("Length must be from 1 to 255")
: ELSE GOSUB '38(61,"Length")
: GOTO 1260
1270 IF F1>0THEN 1030
: GOSUB '34(6)
: IF Q<4096THEN 1040
: GOSUB '35("Position must be less than 4096")
: GOTO 1270
1280 IF F1>0THEN 1030
: GOSUB '34(7)
: IF Q<10THEN 1040
: GOSUB '38(38,"9")
: GOTO 1280
1290 IF F1>0THEN 1030
: GOSUB '71(8)
: IF E$="N"THEN GOSUB '45(9,E$)
: GOTO 1040
1300 IF F1>0THEN 1030
: GOSUB '43(8)
: IF E$="N"THEN 1310
: GOSUB '43(7)
: IF Q>3THEN 1310
: GOSUB '71(9)
: GOTO 1040
1310 GOSUB '35("Zero fill only applies to right justified numeric fields")
: GOTO 1050
1320 IF F1>0THEN 1030
: GOSUB '43(7)
: IF Q>3OR Q<2THEN 1330
: A=MOD(Q,2)
: GOSUB '43(5)
: IF A+Q<3THEN 1330
: GOSUB '34(10)
: IF Q>7THEN 1340
: J0=Q
: GOSUB '43(5)
: A=Q
: GOSUB '43(7)
: Q=MOD(Q,2)
: IF J0=0OR J0<A-QTHEN 1040
: GOSUB '38(39," ")
: GOTO 1320
1330 GOSUB '35("Decimals do not apply to field type or length is too small")
: GOTO 1050
1340 GOSUB '38(40," ")
: GOTO 1320
1350 GOSUB '43(5)
: IF Q>80THEN 1370
: GOSUB '34(11)
: IF Q<4THEN 1040
: GOSUB '35("Display option must be one of those listed (0-3)")
: GOTO 1350
1360 GOSUB '43(5)
: IF Q>80THEN 1370
: GOSUB '71(12)
: IF E$="N"THEN GOSUB '45(15,"N")
: IF E$="N"THEN GOSUB '45(16,"N")
: GOTO 1040
1370 GOSUB '45(11,"0")
: GOSUB '45(12,"N")
: GOSUB '35("Fields longer than 80 bytes are not keyable nor displayable")
: GOTO 1050
1380 GOSUB '71(13)
: GOTO 1040
1390 GOSUB '71(14)
: GOTO 1040
1400 GOSUB '43(12)
: IF E$="Y"THEN GOSUB '71(15)
: ELSE PRINT HEX(07);
: GOTO 1040
1410 GOSUB '43(12)
: IF E$="Y"THEN GOSUB '71(16)
: ELSE PRINT HEX(07);
: GOTO 1040
1470 GOSUB '43(5)
: IF Q=0THEN 2050
: LIMITS T#2,"IDS2fs00",A,B,C,D
: IF D<2THEN 1480
: MAT REDIM E$(24)83,F$(27)83,E2$(27)83,E3$(24)83
: DATA SAVE DA T#3,(E4+25)E$()
: DATA SAVE DA T#3,(E4+33)F$()
: DATA SAVE DA T#3,(E4+42)E2$()
: DATA SAVE DA T#3,(E4+51)E3$()
: MAT REDIM E$(E8)1,F$(E9)1,E2$(250)9,E3$(249)8
: LOAD T#2,"IDS2PS18"1000,
1480 GOSUB '35("System edit file has not been allocated -- cannot access edits
")
: GOTO 1040
2000 R=Y
: C=X
: LOAD T#2,"IDS2PS17"1000,
2010 GOSUB '43(5)
: IF Q=0THEN 2050
: GOSUB '43(34)
: IF E3$(Q)<>" "THEN 2068
: LOAD T#2,"IDS2PS16"1000,
2020 LOAD T#2,"IDS2PS15"1000,
2030 GOSUB '43(5)
: IF Q=0THEN 2050
: MAT REDIM E$(24)83,F$(27)83,E2$(27)83,E3$(24)83
: DATA SAVE DA T#3,(E4+25)E$()
: DATA SAVE DA T#3,(E4+33)F$()
: DATA SAVE DA T#3,(E4+42)E2$()
: DATA SAVE DA T#3,(E4+51)E3$()
: MAT REDIM E$(E8)1,F$(E9)1,E2$(250)9,E3$(249)8
: LOAD T#2,"IDS2PS98"1000,
2040 GOSUB '43(3)
: Y=Q-1
: GOSUB '43(4)
: C=Q-1
: R=Y
: STR(E$(),1,69)=STR(E2$(),401)
: E2$()=F$()
: LOAD T#2,"IDS2PS03"1000,
2050 GOSUB '43(5)
: I=Q
: GOSUB '43(3)
: Y=Q-1
: GOSUB '43(4)
: C=Q-1
: R=Y
: IF I>0AND I<81AND C+I<=81THEN 2055
: IF I>0THEN 2052
: GOSUB '35("Field length cannot be zero")
: GOTO 1050
2052 IF STR(E$(),32,2)="0N"THEN LOAD T#2,"IDS2PS08"1000,
: GOSUB '35("Column plus length must be less than 80")
: GOTO 1050
2055 IF STR(E$(),32,2)="0N"THEN LOAD T#2,"IDS2PS08"1000,
: L=I
: N=INT((LEN(E3$())-1)/8)+1
: CONVERT STR(E$(),58,3)TO J
: MAT REDIM F$(250)9
: FOR K=1TO N
: IF K=JTHEN 2060
: IF INT(VAL(STR(F$(K),4))*.125)<>RTHEN 2060
: IF INT(VAL(STR(F$(K),5))*.5)+VAL(F$(K))<=COR C+L<=INT(VAL(STR(F$(K),5))*.
5)THEN 2060
2058 MAT REDIM F$(E9)1
: GOSUB '35("Field will overwrite an existing field, EXEC to change")
: F6$(11)="N"
: GOSUB '34(250)
: IF Q=32THEN 1040
: GOTO 2058
2060 NEXT K
: MAT REDIM F$(E9)1
: LOAD T#2,"IDS2PS08"1000,
2068 GOSUB '35("Field already exists - Delete before attempting to insert")
: GOTO 1050
2070 DEFFN'71(F)
: GOSUB '43(F)
: IF E$<>"Y"THEN GOSUB '45(F,"Y")
: ELSE GOSUB '45(F,"N")
: RETURN
2080 IF VAL(STR(C3$,25))>0AND STR(E$(),9,8)<>STR(C3$,9,8)THEN STR(C3$,,16)=AND
ALL(7F)
: ELSE STR(C3$,,16)=OR ALL(80)
: STR(F0$,,8)=STR(E$(),9,8)XOR STR(C3$,9,8)AND ALL(7F)
: IF VAL(STR(C3$,25))=0AND STR(E$(),52,3)<>" 0"AND POS(STR(F0$,,8)<>HEX(00
))=0THEN CONVERT STR(E$(),52,3)TO I
: ELSE GOTO 2100
: STR(C3$,25)=BIN(I)
2100 RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS07"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"