Listing of file='IDS2PS38' on disk='vmedia/701-2724B.wvd.zip'
# Sector 528, program filename = 'IDS2PS38'
1000 REM "IDS2PS38" - Release 2.1 - SCREEN/REPORT/BATCH READ A RECORD FROM DAT
A FILE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: J8=0
: DIM J3$8
: GOSUB 2580
: CONVERT VAL(STR(E$(),78))-31TO STR(E$(),2073,2),(##)
: IF E0$="IDS2sS35"THEN 1030
: GOSUB '32("IDS2sS35")
: GOSUB '36
1030 STR(F6$(),11,4)=ALL("Y")
: IF STR(E$(),98,1944)<>" "THEN 2500
1040 F=9
1050 F=F+1
: IF F>F0THEN 2500
: IF F<>10THEN 1065
: GOSUB '43(10)
: IF E$=" "THEN GOSUB '45(10,"N")
1065 IF F>23AND POS("12"=STR(E$(),107,1))=0AND POS("12"=STR(E$(),110,1))=0THEN
1050
: IF F>14AND F<20AND STR(E$(),107,1)="0"THEN 2020
: IF F>21AND F<24AND STR(E$(),107,1)="0"THEN 2020
: GOTO 1070
1069 GOSUB '45(F," ")
1070 GOSUB '34(F)
: ON F-8GOTO 2570,1090,,1100,1120,1130,1140,1150,1131,1150,1160,1170,1180,1
140,1150,1190,1200,1210,1190,1200,1210,1190,1200,1210,1190,1200,1210,1190
,1200,2500
: IF F<21THEN 1050
1090 IF E$="Y"THEN 1050
: GOSUB '45(11," ")
: GOSUB '45(12," ")
: F=12
: GOTO 1050
1100 IF E$="Y"OR E$="N"THEN 1050
: GOSUB '35("Must be 'Y' or 'N'")
: GOTO 1069
1120 GOSUB 2000
: IF Q=0THEN 1069
: GOSUB '43(F)
: IF E$>"FILE # 0"AND E$<"FILE # 8"THEN E$=STR(C8$,(VAL(STR(E$,8))-49)*8+1,
8)
: MAT REDIM E4$(3)83
: E$=E$OR ALL(20)
: GOSUB '39(E$,5)
: DATA LOAD DA T#P,(A)E4$()
: MAT REDIM E4$(16)16
: IF STR(E4$(),10,1)<"5"THEN 1122
: J3$=STR(E4$(),82,8)
: MAT SEARCHC8$,=J3$TO F9$STEP 8
: IF F9$=HEX(0000)THEN J3$=" "
1122 FOR I=0TO 4
: STR(E8$,I*2+1)=STR(E4$(),I*17+121,2)
: NEXT I
: FOR I=0TO 4
: GOSUB '45(I*3+26,STR(E8$,I*2+1))
: NEXT I
: GOTO 1050
1130 IF Q>=0AND Q<4THEN 1050
: GOSUB '35("File access option must be 0 - 3")
: GOTO 1069
1131 IF Q>0AND Q<5OR E$=" "THEN 1050
: GOSUB '35("File access option must be 1 - 4")
: GOTO 1069
1140 IF VER(E$,"#")=1THEN 1050
: IF E$=" "THEN 1142
: IF E$>="A"AND E$<="Z"THEN 1050
: GOSUB '35("Sysflag designator must be 0-9 or A-Z")
: GOTO 1069
1142 GOSUB '45(F+1," ")
: F=F+1
: IF F<>16THEN 1050
: GOTO 1142
1150 IF POS("YN"=E$)>0THEN 1050
: GOSUB '35("Must be 'Y' or 'N'")
: GOTO 1069
1160 IF E$="U"THEN 1162
: IF E$="I"THEN 1050
: GOSUB '35("Must be 'I' or 'U'")
: GOTO 1069
1162 GOSUB '43(13)
: F5$=E$
: MAT SEARCHC8$,=F5$TO F9$STEP 8
: IF F9$=HEX(0000)AND STR(F5$,,6)<>"FILE #"THEN 1050
: FOR I=20TO 21
: GOSUB '43(I)
: IF E$=" "THEN GOSUB '45(I,F5$)
: NEXT I
: F=F+2
: GOTO 1050
1170 IF E$=" "AND STR(E$(),112,1)="I"THEN 1171
: IF E$=" "THEN 1175
: X=0
: GOSUB 2600
: IF E$=STR(F0$,,8)OR E$=STR(F0$,9,8)THEN 1177
: IF J3$<>" "AND E$=J3$THEN 1172
: GOSUB 2590
: MAT SEARCHE3$(),=STR(E$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1175
: J8=1
: GOTO 1050
1171 GOSUB '45(21," ")
: F=F+1
: GOTO 1050
1172 J8=2
: GOSUB '45(21,STR(E$(),99,8))
: F=21
: GOTO 1050
1175 GOSUB '35("Invalid field or file name")
: GOTO 1069
1177 GOSUB '45(21,E$)
: J8=0
: F=21
: GOTO 1050
1180 IF E$=" "AND STR(E$(),112,1)="I"AND STR(E$(),113,8)=" "THEN 1050
: IF E$=" "THEN 1175
: X=0
: ON J8GOTO 1182,1183
: GOSUB 2600
: IF E$=STR(F0$,,8)OR E$=STR(F0$,9,8)THEN 1050
: GOTO 1175
1182 GOSUB '43(13)
: GOSUB 2000
: IF Q=0THEN 1069
: MAT REDIM F$(24)83
: DATA LOAD DA T#P,(A+8)F$()
: GOSUB '43(21)
: MAT SEARCHF$(),=STR(E$,,8)TO F9$STEP 8
: GOSUB 2580
: IF F9$>HEX(0000)THEN 1050
: GOSUB '35("Field not in file")
: GOTO 1069
1183 IF E$<>STR(E$(),99,8)THEN 1175
: GOTO 1050
1184 STOP #
1190 IF E$=" "THEN 1192
: IF POS("FC"=E$)>0THEN 1050
: GOSUB '35("Must be 'F' or 'C'")
: GOTO 1069
1191 GOSUB '35("Must be 'F' or 'C'")
: GOTO 1069
1192 FOR I=FTO 38
: GOSUB '45(I," ")
: NEXT I
: GOTO 2500
1200 GOSUB '43(F-1)
: IF E$="C"THEN 1050
: GOSUB '43(F)
: GOSUB 2590
: MAT SEARCHE3$(),=STR(E$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)OR VER(E$,"@TSTFLD#")=8OR E$="@SYSBUF0"THEN 1050
: GOSUB '35("Invalid field name")
: GOTO 1069
1210 GOSUB '43(F+3)
: F=F+1
: IF E$=" "THEN 1192
: GOTO 1070
1999 STOP #
2000 IF E$>"FILE # 0"AND E$<"FILE # 8"THEN E$=STR(C8$,(VAL(STR(E$,8))-49)*8+1,
8)
: IF E$=" "THEN 2010
2002 E$=E$OR ALL(20)
: GOSUB '39(E$,5)
: IF Q=0THEN 2010
: DATA LOAD BA T#P,(A)E4$()
: IF STR(E4$(),,4)<>HEX(8201D3E3)THEN 2010
: IF STR(E4$(),13,1)<"5"THEN RETURN
: E$=STR(E4$(),85,2)&STR(E4$(),88,6)
: GOTO 2002
2010 Q=0
: GOSUB '35("Not an IDEAS data file")
: RETURN
2020 GOSUB '45(F," ")
: GOTO 1050
2500 F0$="EXEC = Accept, EDIT = Modify,"
: IF J9=1THEN F0$=F0$&" FN'9 = Delete,"
: F0$=F0$&" FN'31 = Cancel"
: GOSUB '53(F0$)
: GOSUB '34(250)
: IF Q=33THEN 1040
: IF Q=32THEN LOAD T#2,"IDS2PS28"1000,
: IF Q=9AND J9<>0THEN 2560
: PRINT HEX(07);
: GOTO 2500
2560 F6$(14)="N"
: STR(E$(),2042)=" "
: FOR I=1TO 9
: C9$=STR(E$(),82,16)&E$(78)&E$(76)&BIN(I+47)
: Q=0
: IF I=1OR F6$(42+I)="Y"THEN GOSUB '41(E1$(2),C9$,.5)
: F$()=" "
: IF Q<>0THEN GOSUB '42(E1$(2),0)
: NEXT I
: F6$(14)="Y"
: LOAD T#2,"IDS2PS18"1000,
2570 F5$="IDS2PS38"
: LOAD T#2,"IDS2PS96"1000,
2580 MAT REDIM F$(27)83
: DATA LOAD DA T#3,(E4+8)F$()
: MAT REDIM F$(E9)1
: IF C5$<>"S"THEN RETURN
: Q=VAL(C7$)*9-8
: F$(Q)=STR(C7$,3)
: F$(Q+5)=STR(C7$,2)
: RETURN
2590 MAT REDIM E3$(24)83
: IF C5$="S"THEN I=51
: ELSE I=17
: DATA LOAD DA T#3,(E4+I)E3$()
: MAT REDIM E3$(249)8
: RETURN
2600 F0$=STR(E$(),99,8)
: IF STR(F0$,,6)<>"FILE #"THEN 2610
: STR(F0$,9)=STR(C8$,(VAL(STR(F0$,8))-49)*8+1,8)
: RETURN
2610 MAT SEARCHC8$,=STR(F0$,,8)TO F9$STEP 8
: STR(F0$,9,8)="FILE # X"
: X=0
: IF F9$>HEX(0000)THEN X=(VAL(F9$,2)+7)/8
: CONVERT XTO STR(F0$,16,1),(#)
: IF F9$=HEX(0000)THEN F0$=" "
: RETURN
2800 STOP #
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS38"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"