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"