image of READY prompt

Wang2200.org

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"