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"