image of READY prompt

Wang2200.org

Listing of file='IDS2PPG0' on disk='vmedia/701-2725B.wvd.zip'

# Sector 223, program filename = 'IDS2PPG0'
1000 REM "IDS2PPG0" - Release 2.1 - INTERACTIVE PROGRAM CANNED MODULE CHECK
1005 E6$=F6$(17)AND HEX(02)
   : IF E6$=HEX(00)THEN LOAD T#2,"IDS2SUB8"3701,3899BEG 1010
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM C(5)
   : GOSUB '32("IDS2sP03")
   : F9=0
   : GOSUB '37(1)
   : GOSUB '37(2)
   : GOSUB '45(22,F6$)
   : ON VAL(F6$)GOTO ,,1080,1090,1100
   : GOSUB '45(3,"Add/change/delete")
   : GOTO 1110
1080 GOSUB '45(3,"Add a record only")
   : GOTO 1110
1090 GOSUB '45(3,"Random inquiry")
   : GOTO 1110
1100 GOSUB '45(3,"Sequential inquiry")
1110 GOSUB '37(4)
   : GOSUB '37(5)
   : GOSUB '37(13)
   : GOSUB '37(14)
   : GOSUB '43(13)
   : E$=E$OR ALL(20)
   : GOSUB '39(E$,5)
   : MAT REDIM E3$(6)83
   : DATA LOAD DA T#P,(A)E3$()
   : FOR I=0TO 4
   : GOSUB '45(I+15,STR(E3$(),I*17+108,8))
   : IF E$<>" "THEN F6=I
   : STR(E$(),I*2+645,2)=STR(E3$(),I*17+121)
   : NEXT I
   : GOSUB '43(4)
   : GOSUB '39(E$,3)
   : MAT REDIM E3$(24)83
   : DATA LOAD DA T#P,(A)E3$()
   : X=VAL(STR(E3$(),137))
1280 Y=VAL(STR(E3$(),138))
   : Z=VAL(STR(E3$(),135))
   : STR(E$(),641,4)=BIN(P)&BIN(A+8,2)&BIN(X)
   : IF Z>0THEN 1320
   : F9=1
   : GOTO 1710
1320 F$()=ALL(00)
   : E3$()=" "
   : MAT REDIM F$(X)83,E3$(Y)83
   : DATA LOAD DA T#P,(A+8)F$(),E3$()
   : MAT REDIM F$(Z)9,E3$(Z)8
   : GOSUB '45(6,E3$(1))
   : F5=Z+1
   : FOR I=ZTO 1STEP -1
   : IF INT(VAL(STR(F$(I),4))/8)=23AND INT(VAL(STR(F$(I),5))/2)=79THEN F5=I
   : NEXT I
   : STR(E$(),635,6)=HEX(0100)&HEX(00)&HEX(00)&BIN(F5)&HEX(00)
   : E$(656)=BIN(MAX(F5,Z))
1440 IF F5>ZTHEN GOSUB '45(12,"@ACCEPT?")
   : ELSE GOSUB '45(12,E3$(F5))
   : I=-1
1470 I=I+1
   : GOSUB '43(I+15)
   : IF E$>" "THEN MAT SEARCHE3$(),=STR(E$,,8)TO F9$STEP 8
   : IF F9$>HEX(0000)OR E$=" "THEN 1512
   : F9=3
   : GOTO 1710
1512 IF E$=" "AND E$(637)=HEX(FF)THEN E$(637)=BIN(I-1)
   : IF E$=" "THEN C(I+1)=999
   : ELSE C(I+1)=(7+VAL(F9$,2))/8
   : IF E$<>" "THEN E$(655)=BIN(I)
   : IF E$>" "AND C(I+1)>VAL(E$(637))THEN E$(637)=BIN(C(I+1))
   : IF I<4THEN 1470
   : FOR I=0TO VAL(E$(655))
   : F4=MIN(C())
   : FOR J=1TO 5
   : IF C(J)<>F4THEN 1540
   : GOSUB '43(J+14)
   : GOSUB '45(I+7,E$)
   : C(J)=999
1540 NEXT J,I
   : F1=0
   : FOR I=0TO VAL(STR(E1$(2),43),2)-1
   : DATA LOAD BA T#2,(VAL(STR(E1$(2),55),2)+I*VAL(STR(E1$(2),46),2))E4$()
   : F1=F1+VAL(STR(E4$(),9),2)
   : NEXT I
   : F2=(I+1)*VAL(STR(E1$(2),48),2)
   : GOSUB '55(20,100*F1/F2)
   : GOSUB '55(21,F2-F1)
   : I=5
1630 I=I+1
   : GOSUB '43(I)
   : IF E$=" "THEN 1690
   : C1$=STR(E$(),53,8)&E$
   : GOSUB '60(E1$(2),C1$)
   : IF STR(E6$(),,16)=C1$THEN F7=I
1690 IF I<12AND F7=0THEN 1630
   : F9=5*SGN(F7)
1710 MAT REDIM E3$(24)83,F$(E9)1
1720 ON F9GOTO 1740,1750,1760,1770,1780
   : E$="Touch EXEC to accept,"
   : GOTO 1790
1740 E$="Not enough fields."
   : GOTO 1790
1750 E$="No keyable fields."
   : GOTO 1790
1760 E$="Key fields don't match."
   : GOTO 1790
1770 E$="Invalid last field."
   : GOTO 1790
1780 GOSUB '43(F7)
   : E$="Edits exist for "&HEX(22)&E4$()&HEX(222E)
1790 E$=E$&"  EDIT for screen, FN'31 to cancel"
   : IF F9>0THEN GOSUB '35(E$)
   : ELSE GOSUB '53(E$)
   : F6$(11)="N"
   : GOSUB '34(250)
   : F6$(11)="Y"
   : IF Q=31THEN LOAD T#2,"IDS2PP01"1000,
   : F5$="IDS2PPG1"
   : IF Q=32AND F9=0THEN LOAD T#2,F5$1000,
   : IF Q<>33THEN 1720
   : R3$()="IDS2MS01"
   : E6$=HEX(01)
   : E$(),E9$(2)=STR(E$(),53,8)
   : LOAD T#2,"IDS2PS01"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PPG0"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"