Listing of file='IDS2PS28' on disk='vmedia/701-2716B.wvd.zip'
# Sector 978, program filename = 'IDS2PS28'
1000 REM "IDS2PS28" - Release 2.1 - SCRN/RPT/BATCH PASS/FAIL DISPLAY & INSERT/
DELETE
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: COM J8
1030 GOSUB '32("IDS2sS26")
: R3$(1)="IDS2PS18"
: FOR I=1TO 5
: GOSUB '37(I)
: NEXT I
: X=1
1040 PRINT HEX(060F)
: FOR I=XTO 50
: PRINT ;AT(MOD(I,17)+6,INT(I/17)*27+4);
: X=I*18+536
: IF E$(X)=" "THEN PRINT " available "
: ELSE PRINT E$(X);" ";E$(X+1);" ";STR(E$(),X+2,8);" ";STR(E$(),X+10,8)
: NEXT I
1050 E8$="EXEC = Accept, E"
: F0$="DIT = Modify, FN'0 = Op spec, '16 = Messages, '31 = Cancel"
: GOSUB '63(E8$,F0$," ")
: J8=MIN(MAX(1,J8),50)
: PRINT HEX(02040202000E)
1076 CONVERT J8TO F9$,(##)
: PRINT HEX(0602040202000E);AT(MOD(J8,17)+6,INT(J8/17)*27+1);F9$;
1090 KEYIN E6$,,1500
: IF E6$=HEX(0D)THEN E6$=HEX(82)
: IF E6$=HEX(82)THEN 1600
: IF POS(HEX(0D0820)=E6$)>0THEN 1100
1096 PRINT HEX(07);
: GOTO 1090
1100 $TRAN(E6$,HEX(31080120110D))R
1105 PRINT HEX(060F);AT(MOD(J8,17)+6,INT(J8/17)*27+1);F9$;" ";
: J8=MOD(J8+VAL(E6$)-1,50)+1
: GOTO 1076
1500 IF POS(HEX(05060C0D45464C4D31F00009490A4A101F)=E6$)=0THEN 1096
: IF E6$=HEX(09)OR E6$=HEX(49)THEN 1810
: IF E6$=HEX(0A)OR E6$=HEX(4A)THEN 1840
: IF E6$=HEX(1F)THEN 1790
: IF E6$<>HEX(F0)THEN 1550
: CONVERT J8TO STR(E$(),2044,2),(##)
: GOSUB '32("IDS2sS28")
: E7$=F5$
: LOAD T#2,"IDS2PS55"1000,
1550 IF E6$=HEX(10)THEN 2000
: IF E6$=HEX(00)THEN 1870
: $TRAN(E6$,HEX(0105014531063146110C114C210D214D))R
: GOTO 1105
1600 F6$(14)="N"
: STR(E$(),2042)=" "
: IF J9=0THEN 1650
: 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
1650 IF STR(E$(),98)=" "THEN 1790
: FOR I=0TO 8
: F$()=E$(76)&BIN(I+48)&STR(E$(),78,20)
: ON IGOTO 1690,1700,1710,1720,1730,1740,1750,1760
: STR(F$(),23)=STR(E$(),98,228)
: GOSUB '42(E1$(2),0)
: IF Q=0THEN 1800
: GOTO 1780
1690 STR(F$(),23)=STR(E$(),326,228)
: GOTO 1770
1700 STR(F$(),23)=STR(E$(),554,228)
: GOTO 1770
1710 STR(F$(),23)=STR(E$(),782,228)
: GOTO 1770
1720 STR(F$(),23)=STR(E$(),1010,228)
: GOTO 1770
1730 STR(F$(),23)=STR(E$(),1238,228)
: GOTO 1770
1740 STR(F$(),23)=STR(E$(),1466,192)
: GOTO 1770
1750 STR(F$(),23)=STR(E$(),1658,192)
: GOTO 1770
1760 STR(F$(),23)=STR(E$(),1850,192)
1770 IF STR(F$(),23)=" "THEN 1780
: GOSUB '42(E1$(2),0)
: IF Q=0THEN 1800
1780 NEXT I
: F6$(14)="Y"
1790 COM CLEAR J8
: LOAD T#2,R3$(1)1000,
1800 GOSUB '53("System file for special edits is full, please cancel")
: GOSUB '34(250)
: IF Q<>31THEN 1800
: GOTO 1790
1810 IF J8=50THEN 1820
: STR(E$(),J8*18+536,(50-J8)*18)=STR(E$(),J8*18+554)
1820 STR(E$(),1436,18)=" "
1830 X=J8
: GOTO 1040
1840 IF J8=50OR STR(E$(),1436,18)<>" "THEN 1096
: MAT COPY -E$()<J8*18+536,(50-J8)*18>TO -E$()<J8*18+554,(50-J8)*18>
: STR(E$(),J8*18+536,18)=" "
: GOTO 1830
1870 E6$=E$(76)
: $TRAN(E6$,"1061829304455627")R
: IF E6$>"6"THEN F9$="3"&E6$
: ELSE F9$="2"&E6$
: F5$="IDS2PS"&F9$
: LOAD T#2,F5$1000,
2000 GOSUB '32("IDS2sS51")
: GOSUB '36
2020 STR(F6$(),11,3)="NNN"
2030 GOSUB '53("EXECUTE = Accept, FN'1 - FN'9 = Edit message")
: GOSUB '34(250)
: STR(F6$(),11,3)="NYY"
: IF Q=32THEN 1030
: IF Q>0AND Q<10THEN 2100
: PRINT HEX(07);
: GOTO 2020
2100 X=Q
: STR(F6$(),11,3)="NNN"
2120 GOSUB '34(X+5)
: IF POS(E$=22)=0THEN 2030
: GOSUB '35("No double quotes are allowed in messages !")
: GOTO 2120
2500 STOP #
: ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS28"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"