Listing of file='IDS2PP01' on disk='vmedia/701-2717B.wvd.zip'
# Sector 410, program filename = 'IDS2PP01'
1000 REM "IDS2PP01" - Release 2.1 - INTERACTIVE PROGRAM SPECIFICATION MODULE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB '32("IDS2sP00")
: IF E$(445)=" "THEN E$(445)="0"
: IF E$(457)=" "THEN E$(457)="0"
: IF E$(469)=" "THEN E$(469)="N"
: IF E$(472)=" "THEN E$(472)="N"
: IF POS("ML"=E$(471))=0THEN E$(471)="M"
: GOSUB '36
: IF STR(E$(),53,8)=" "THEN 1050
: GOSUB 2600
: GOTO 2500
1050 F=1
1060 F=F+1
: IF F>F0THEN 2500
1090 GOSUB '34(F)
: IF F=9THEN 1100
: ON F-51GOTO 1110,1120,,1110,1120,,1130,1140,,1130,1150
: GOTO 1060
1100 GOSUB 2600
: F=9
: IF Q=0THEN 1090
: GOTO 1060
1110 IF VER(E$,"H")=1THEN 1060
: GOSUB '38(41," ")
: GOTO 1090
1120 IF E$=" "OR E$=R4$THEN 1125
: GOSUB '35("You won't be able to edit this program again !")
: GOTO 1060
1125 E7$=E$
: GOSUB '43(F-1)
: IF E7$=R4$AND R8$<E$AND F=53THEN GOSUB '35("You won't be able to edit thi
s program again !")
: E$=E7$
: GOTO 1060
1130 IF E$="Y"OR E$="N"THEN 1060
: GOSUB '35("Must be 'Y' or 'N'")
: GOTO 1090
1140 IF Q<4THEN 1060
: GOSUB '35("Program type must be 0 - 3")
: GOTO 1090
1150 IF POS("ML"=STR(E$,,1))>0THEN 1060
: GOSUB '35("Must be 'M' or 'L'")
: GOTO 1090
2500 E$="Touch EXEC=accept, EDIT=modify, '0-'6=as listed above, '15=HELP, or '
31=cancel"
: GOSUB '63(STR(E$,,16),STR(E$,17)," ")
: GOSUB '34(250)
: IF Q=33THEN 1050
: IF Q<>32THEN 2530
: IF POS("ML"=E$(471))>0THEN LOAD T#2,"IDS2PP02"1000,
: F=62
: PRINT HEX(07);
: GOTO 1090
2530 IF Q=31THEN LOAD T#2,"IDS2MP01"1000,
: ON Q+1GOTO 2570,2560,2550,2580,2580,2580,2580
: PRINT HEX(07);
: GOTO 2500
2550 GOSUB '43(62)
: IF E$="L"THEN GOSUB '45(62,"M")
: ELSE GOSUB '45(62,"L")
: GOTO 2500
2560 GOSUB '43(61)
: IF E$="N"THEN GOSUB '45(61,"Y")
: ELSE GOSUB '45(61,"N")
: GOTO 2500
2570 GOSUB '43(58)
: IF E$="N"THEN GOSUB '45(58,"Y")
: ELSE GOSUB '45(58,"N")
: GOTO 2500
2580 F6$=E6$ADDHEX(FF)
: LOAD T#2,"IDS2PPG0"1000,
2590 STOP "END"
2600 GOSUB '43(9)
: IF E$<>" "THEN 2610
: FOR I=9TO 48
: GOSUB '45(I," ")
: NEXT I
: Q=0
: RETURN
2610 GOSUB '39(E$,3)
: IF Q<>0THEN 2640
2620 GOSUB '35("Not a valid IDEAS screen mask file")
: Q=0
: RETURN
2630 GOSUB '35("Unable to generate Program from Archived Screen")
: Q=0
: RETURN
2640 MAT REDIM F$(3)83
: DATA LOAD DA T#P,(A)F$()
: MAT REDIM F$(E9)1
: IF F$(1)=HEX(E1)THEN 2630
: IF F$(1)<>HEX(F3)THEN 2620
: E$=STR(F$(),10,24)&ALL(00)
: FOR I=1TO 32
: ROTATEC(STR(E$,I),-2)
: NEXT I
: ADD(E$,20)
: GOSUB '45(10,E$)
: STR(E$(),1001)=" "
: STR(E$(),2001)=STR(F$(),78,56)
: GOSUB '43(9)
: GOSUB '33(E$)
: F$()=E2$()
: X=F0
: GOSUB '33("IDS2sP00")
2690 IF X>0THEN 2700
: GOSUB '35("Specified screen has no fields")
: Q=0
: RETURN
2700 Q=1
: FOR I=0TO X-1
: Q=MAX(Q,VAL(F$(I*9+1))-1+INT(VAL(STR(F$(),I*9+2),2)/16))
: NEXT I
: X=Q
: GOSUB '55(11,X)
: GOSUB '55(12,1)
: GOSUB '55(13,X)
: X=0
: FOR I=0TO 6
: F5$=STR(E$(),2001+8*I)
: GOSUB '45(I*5+14,F5$)
: IF E$<>" "THEN 2730
: GOSUB '45(I*5+15," ")
: FOR J=I*5+16TO I*5+18
: GOSUB '45(J," 0")
: NEXT J
: GOTO 2770
2730 E7$=F5$OR ALL(20)
: GOSUB '39(E7$,5)
: IF A=0THEN 2780
: MAT REDIM F$(6)83
: DATA LOAD DA T#P,(A)F$()
: MAT REDIM F$(E9)1
: GOSUB '45(I*5+15,STR(F$(),22))
: STR(E$(),I*85+1001,85)=STR(F$(),108)
: E7$=STR(F$(),82,8)OR ALL(20)
: GOSUB '39(E7$,5)
: IF A=0THEN 2780
: MAT REDIM F$(6)83
: DATA LOAD DA T#P,(A)F$()
: MAT REDIM F$(E9)1
2760 CONVERT STR(F$(),93,4)TO Y
: GOSUB '55(I*5+16,Y)
: GOSUB '55(I*5+17,X+1)
: GOSUB '55(I*5+18,X+Y)
: X=X+Y
2770 NEXT I
: Q=1
: RETURN
2780 F0$="Control file for "&STR(E$(),2001+8*I,8)&" not found -- FN '31 to can
cel"
: F6$(11)="N"
: GOSUB '35(F0$)
: GOSUB '34(250)
: LOAD T#2,"IDS2MP01"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PP01"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"