Listing of file='IDS2PR10' on disk='vmedia/701-2716B.wvd.zip'
# Sector 157, program filename = 'IDS2PR10'
1000 REM "IDS2PR10" - Release 2.1 - REPORT GENERATOR FIELD EDITOR
1005 COM J9,J8
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: R3$(1)="IDS2PR03"
: IF E$(1)="\E2"THEN R3$(1)="IDS2PB01"
: IF E0$="IDS2sR01"OR E0$="IDS2sB01"THEN 1025
: IF E$(1)="\E2"THEN GOSUB '32("IDS2sB01")
: ELSE GOSUB '32("IDS2sR01")
: GOSUB '36
1025 STR(F6$(),11,3)="NNN"
: GOSUB 2520
: IF J8>0THEN 1030
: GOSUB '43(23)
: J9=Q
: J8=1
1030 E$="Attribute FNs shown above, EXEC=Accept, 16=Field names,"
: IF E$(1)="\F2"THEN E$=E$&" 25=Delete,"
: E$=E$&" 31=Cancel"
: GOSUB '63(STR(E$,,16),STR(E$,17)," ")
1040 GOSUB '34(250)
: ON Q+1GOTO 1090,1130,,1060,1210,1220,1230,,1250,1260,1310,1270,1290,1300,
1320,,1070,,,,,,,,,1990,,,,,,1080,2000
1060 PRINT HEX(07);
: GOTO 1030
1070 R3$(1)="IDS2PR10"
: LOAD T#2,"IDS2PS17"1000,
1080 F5=0
: FOR Y=1TO 12
: DATA LOAD BA T#3,(E4+33+F4-F5+Y)E4$()
: STR(E$(),Y*166-85,166)=E4$()
: NEXT Y
: COM CLEAR J9
: LOAD T#2,R3$(1)1000,
1090 IF F6>2THEN 1060
1100 GOSUB '34(17)
: IF Q>0AND Q<8THEN 1120
: IF Q=0THEN 1110
1105 GOSUB '35("Must be blank or one of the associated files")
: GOTO 1100
1110 GOSUB '45(17," ")
: GOSUB '45(18," ")
: GOTO 1025
1120 IF STR(E$(),Q*8+70,8)=" "THEN 1105
: X=Q
: GOSUB '45(18,STR(E$(),70+X*8))
: GOSUB 2520
1130 GOSUB '34(19)
: GOSUB 2520
: ON F6GOTO 1135,1160,1150,1140,1140,1140
1135 GOSUB '43(19)
: 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 1136
: IF E$>"FILE # 0"AND E$<"FILE # 8"THEN 1136
: GOTO 1030
1136 GOSUB '35("Field name is a reserved field. Please enter new field name.")
: GOSUB '45(19," ")
: GOTO 1130
1140 STR(E$(),775,9)=" "
: STR(E$(),797,6)=" 2 2"
: STR(E$(),807,9)="2NN NNN"
: GOTO 1145
1145 FOR I=17TO 33
: GOSUB '37(I)
: NEXT I
: GOTO 1030
1150 STR(E$(),775,9)=" "
: STR(E$(),797,6)=" 4 4"
: STR(E$(),807,9)="0YN0 NNN"
: GOTO 1145
1160 GOSUB '43(19)
: E7$=E$
: GOSUB '43(18)
: F5$=E$OR ALL(20)
1162 GOSUB '39(F5$,5)
: MAT REDIM E3$(6)83
: DATA LOAD DA T#P,(A)E3$()
: IF STR(E3$(),10,1)<"5"THEN 1164
: F5$=STR(E3$(),82)OR ALL(20)
: GOTO 1162
1164 MAT REDIM E3$(24)83
: DATA LOAD DA T#P,(A+8)E3$()
: MAT REDIM E3$(249)8
: MAT SEARCHE3$(),=STR(E7$,1,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN 1166
: GOSUB '35("Field not in data file")
: GOTO 1090
1166 MAT REDIM E3$(24)83
: DATA LOAD DA T#P,(A)E3$()
: X=INT(VAL(F9$,2)/8)
: E7$=STR(E3$(),499+X*6)
: GOSUB '55(22,VAL(STR(E7$,3)))
: GOSUB '45(23,E$)
: GOSUB '55(24,(F1(F1)-1+INT(VAL(E7$,2)/16)))
: X=INT(MOD(VAL(STR(E7$,2)),16)/2)
: IF X=0OR X=2THEN GOSUB '55(25,0)
: IF X=1OR X=3THEN GOSUB '55(25,1)
: IF X>3THEN GOSUB '55(25,2)
: D7=Q
1184 IF MOD(VAL(E7$,2),2)=1THEN GOSUB '45(26,"Y")
: ELSE GOSUB '45(26,"N")
: IF INT(MOD(VAL(STR(E7$,6)),16)/8)=1THEN GOSUB '45(27,"Y")
: ELSE GOSUB '45(27,"N")
: GOSUB '55(28,MOD(VAL(STR(E7$,6)),8))
: GOSUB 2540
: GOSUB 2550
: MAT REDIM E3$(249)8
: GOTO 1030
1200 GOSUB '34(21)
: GOTO 1030
1210 GOSUB '43(17)
: IF Q>0AND Q<8THEN 1060
1215 GOSUB '34(22)
: I=Q
: GOSUB '43(21)
: IF I+Q>159THEN 1216
: I=Q
: GOSUB 2550
: IF I+Y>159THEN 1216
: IF X<0THEN 1215
: GOTO 1030
1216 GOSUB '35("Invalid specification- column plus length must be less than 16
0")
: GOTO 1215
1220 GOSUB '43(17)
: IF Q>0AND Q<8THEN 1060
: GOSUB '34(24)
: GOTO 1030
1230 GOSUB '34(25)
: IF Q<3THEN 1240
: GOSUB '35("Field type must be 0 , 1 , or 2")
: GOTO 1040
1240 GOSUB 2520
: GOSUB 2540
: GOSUB 2550
: GOTO 1030
1250 IF D7=2THEN 1060
: GOSUB '71(27)
: GOTO 1030
1260 IF D7=2OR F1>0THEN 1060
: GOSUB '34(28)
: IF Q>7THEN 1265
: GOSUB 2550
: IF X<0THEN 1260
: GOTO 1030
1265 GOSUB '35("Decimals must be from 0 to 7")
: GOTO 1260
1270 IF D7<>1THEN 1060
: GOSUB '34(30)
: IF Q<4THEN 1280
: GOSUB '35("Sign code must be 0 - 3")
: GOTO 1040
1280 GOSUB 2550
: GOTO 1030
1290 IF D7=2THEN 1060
: GOSUB '71(31)
: GOSUB 2550
: GOTO 1030
1300 IF D7=2THEN 1060
: GOSUB '71(32)
: GOSUB 2550
: GOTO 1030
1310 GOSUB '34(29)
: IF POS(" 0123456789PR"=E$)>0THEN 1030
: GOSUB '35("Must be blank, 0-9, R, or P")
: GOTO 1310
1320 GOSUB '71(33)
: GOSUB 2550
: GOTO 1030
1990 IF E$(1)="\E2"THEN 1060
: GOSUB '53("Touch FN'25 again to complete deletion, or EXEC to cancel")
: GOSUB '34(250)
: IF Q=32THEN 1030
: IF Q<>25THEN 1990
: GOTO 2100
2000 GOSUB '43(22)
: IF Q>0THEN 2050
: GOSUB '35("Field length cannot be zero")
: GOTO 1210
2050 GOSUB '43(23)
: IF Q<=J9THEN 2100
: DATA LOAD BA T#3,(E4+33+F4)E4$()
: IF POS(STR(E4$(),C1+J9+8,Q-J9+1)>20)=0THEN 2100
: GOSUB '63("Field as defined"," will overwrite existing fields or text, EX
EC to change","!")
: GOSUB '34(250)
: GOTO 1030
2100 Q=VAL(E6$)
: COM CLEAR J9
: LOAD T#2,"IDS2PR11"1000,
2500 STOP #
2520 GOSUB '43(25)
: D7=Q
: IF D7=2THEN GOSUB '45(26,"N")
: ELSE GOSUB '45(26,"Y")
: IF D7=2THEN GOSUB '45(27,"N")
: IF D7=2THEN GOSUB '45(28,"0")
: ELSE IF F1>0THEN GOSUB '55(28,MOD(VAL(STR(E7$,6)),8))
2530 GOSUB '43(17)
: F1=Q
: IF Q=0THEN F6=1
: ELSE F6=2
: GOSUB '43(19)
: F0$="@SYSPAGE@SYSMNTH@SYSDAY @SYSYEAR"
: MAT SEARCHF0$<,32>,=STR(E$,1,8)TO F9$STEP 8
: GOSUB 2550
: IF F9$=HEX(0000)THEN RETURN
: ELSE F6=INT(VAL(F9$,2)/8)+3
: RETURN
2540 IF D7<>1THEN GOSUB '45(30," ")
: GOSUB '43(30)
: IF D7=1AND E$=" "THEN GOSUB '55(30,0)
: RETURN
2550 GOSUB '43(22)
: X,Y=Q
: IF D7=2THEN 2640
: IF E$(814)="Y"THEN Y=Y+1
: IF E$(812)>"1"THEN Y=Y+1
: X=X-D7
: GOSUB '43(28)
: X=X-Q-SGN(Q)
: IF E$(813)="N"THEN 2640
: Y=Y+INT((X-1)/3)
2640 GOSUB '55(23,Y)
: IF X>=0THEN RETURN
: GOSUB '35("Invalid length, sign, or decimal specification")
: RETURN
2650 DEFFN'71(X)
: GOSUB '43(X)
: IF E$="N"THEN GOSUB '45(X,"Y")
: ELSE GOSUB '45(X,"N")
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR10"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"