Listing of file='IDS2PS22' on disk='vmedia/701-2716B.wvd.zip'
# Sector 893, program filename = 'IDS2PS22'
1000 REM "IDS2PS22" - Release 2.1 - SCREEN/REPORT/BATCH USER-CODED MODULE SPEC
S
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB 2100
: CONVERT VAL(STR(E$(),78))-31TO STR(E$(),2073,2),(##)
: IF E0$="IDS2sS22"THEN 1030
: GOSUB '32("IDS2sS22")
: GOSUB '36
1030 STR(F6$(),11,4)=ALL("Y")
: IF STR(E$(),98,1944)<>" "THEN 2000
1040 F=9
1050 F=F+1
: IF F>F0THEN 2010
: IF F<>10THEN 1070
: GOSUB '43(10)
: IF E$=" "THEN GOSUB '45(10,"N")
1070 IF F>12THEN F6$(12)="N"
: ELSE F6$(12)="Y"
: GOSUB '34(F)
: ON F-8GOTO 2090,1090,,1100,1135,,,,,,1130,,,1130,,,1130,,,1130
: GOTO 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 1070
1130 IF E$<>" "THEN 1132
: GOSUB '43(F-2)
: IF E$=" "THEN 1050
: GOSUB '35("Required field - Please enter a value")
: GOTO 1070
1132 MAT SEARCHE3$(),=STR(E$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)OR VER(E$,"@TSTFLD#")=8OR E$="LSTFNKEY"OR E$="@SYSBUF0"TH
EN 1050
: GOSUB '35("Invalid field name")
: GOTO 1070
1135 GOSUB 1140
: GOTO 1050
1140 LIMITS T#2,E$,A,B,C,D
: ON DGOTO 1142
1141 GOSUB '35("Invalid user-coded program file name")
: F=13
: GOTO 1070
1142 DATA LOAD BA T#2,(A+1)STR(E3$(),,256)
: DATA LOAD BA T#2,(A+2)STR(E3$(),POS(-STR(E3$(),,256)>FC),256)
: GOSUB 2130
: IF STR(E3$(),2,4)<>HEX(FF0001A2)THEN 1141
: MAT SEARCHE3$(),=HEX(FF0002A2)TO F9$
: IF F9$=HEX(0000)THEN 1141
: E$=STR(E3$(),VAL(F9$,2)+4)
: STR(E$,POS(E$=0D))=" "
: STR(E$(),106,64)=E$
: MAT SEARCHE3$(),=HEX(FF0004CE27)TO F9$
: IF F9$=HEX(0000)THEN 1141
1160 E$=STR(E3$(),VAL(F9$,2)+5)
: X=VER(E$,"###")
: CONVERT STR(E$,,X)TO I
: IF I<32OR I>79THEN 1163
: GOSUB '35("User Prime Number falls within IDEAS range")
: GOTO 1070
1163 STR(E$(),170,3)=STR(E$,,X)
: E$=STR(E$,X+1)
: STR(E$,POS(E$=0D))=" "
: STR(E$(),173,24)=E$
: E$=STR(E$,2)
: FOR I=197TO 263STEP 33
: STR(E$(),I,5)=" "
: IF E$=" "THEN 1180
: X=POS(E$=2C)
: IF X=0THEN X=LEN(E$)
: STR(E$(),I,5)=STR(E$,,X-1)
: E$=STR(E$,X+1)
1180 IF STR(E$(),I,5)=" "THEN 1190
: IF I=197THEN MAT SEARCHE3$(),=HEX(FF0005A2)TO F9$
: IF I=230THEN MAT SEARCHE3$(),=HEX(FF0006A2)TO F9$
: IF I=263THEN MAT SEARCHE3$(),=HEX(FF0007A2)TO F9$
: IF F9$=HEX(0000)THEN STR(E$(),I+5,20)=" "
: IF F9$>HEX(0000)THEN STR(E$(),I+5,20)=STR(E3$(),VAL(F9$,2)+4,POS(STR(E3$(
),VAL(F9$,2)+4)=0D)-1)
1186 OR (STR(E2$(I/11+2),5,1),01)
: GOTO 1200
1190 STR(E$(),I,33)=" "
: AND (STR(E2$(I/11+2),5,1),FE)
1200 NEXT I
: AND (STR(E2$(28),5,1),FE)
: MAT SEARCHE3$(),=HEX(FF0003A2)TO F9$
: E$(316)=" "
: IF F9$=HEX(0000)THEN 1300
: A=VAL(F9$,2)
: E$=STR(E3$(),VAL(STR(F9$,2))+4)
: IF STR(E$,,1)<>"A"AND STR(E$,,2)<>"NU"THEN 1300
: E$(316)=E$
: E$=STR(E$,POS(E$="=")+1)
: E$=STR(E$,POS(E$<>20))
: STR(E$,POS(E$=0D))=" "
: STR(E$(),296,20)=E$
: OR (STR(E2$(28),5,1),01)
1218 GOTO 1300
1300 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
: GOSUB '36
: RETURN
2000 GOSUB '43(13)
: GOSUB 1140
2010 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=9THEN 2070
: GOTO 2010
2070 IF Q=9AND J9<>0THEN 2080
: PRINT HEX(07);
: GOTO 2010
2080 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,
2090 F5$="IDS2PS22"
: LOAD T#2,"IDS2PS96"1000,
2100 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
2130 DEFFNA(X)=MAX(POS(STR(E3$(),X)<>20),1)
: DEFFNE(X)=MAX(POS(STR(E3$(),X)=20),1)
: DEFFNC(X)=POS(STR(E3$(),X)=22)
: A=0
2150 IF POS(STR(E3$(),A+1)=FF)=0THEN RETURN
: A=A+POS(STR(E3$(),A+1)=FF)
: STR(E3$(),A+3)=STR(E3$(),A+2+FNA(A+3))
: IF STR(E3$(),A+3,1)=HEX(D8)THEN 2150
: IF STR(E3$(),A+3,1)=HEX(A2)THEN 2280
2200 IF POS(STR(E3$(),A+3)=20)=0OR FNE(A+3)>POS(STR(E3$(),A+3)=0D)THEN 2150
: IF FNC(A+3)=0OR FNC(A+3)>POS(STR(E3$(),A+3)=0D)THEN 2260
: IF FNE(A+3)<FNC(A+3)THEN 2260
: A=A+2+FNC(A+3)
: A=A+FNC(A+1)-2
: GOTO 2200
2260 STR(E3$(),A+2+FNE(A+3))=STR(E3$(),A+1+FNE(A+3)+FNA(A+2+FNE(A+3)))
: GOTO 2200
2280 STR(E3$(),A+4)=STR(E3$(),A+3+FNA(A+4))
: GOTO 2150
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS22"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"