Listing of file='IDS2PR01' on disk='vmedia/701-2716B.wvd.zip'
# Sector 32, program filename = 'IDS2PR01'
1000 REM "IDS2PR01" - Release 2.1 - REPORT GENERATOR GENERAL SPECIFICATIONS
1010 COM F1(9)
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: GOSUB '32("IDS2sR00")
: IF E$(1)="\F2"THEN J4=6
: ELSE J4=8
: E$="Report"
: IF J4=8THEN E$="Batch Program"
: E$=E$&" Generator - Main Specification Screen"
: PRINT HEX(0E);AT(0,7);E$
1023 IF J4=6THEN PRINT AT(20,1);"09 No. of lines/page";AT(20,54);"Number of l
ine formats";
: ELSE STR(E2$(36),5,3),STR(E2$(42),5,3)=AND HEX(FEFF3F)
: DIM F2$(6)83,E1(4)
: J2=0
: GOSUB '45(1,E9$(J4))
: E3$()=ALL(20)
: F$()=ALL(00)
: F5$=E9$(J4)OR ALL(20)
: GOSUB '39(F5$,3)
: J1=Q
: IF Q=2THEN 1240
: J2=1
: STR(E$(),10)=F5$
1190 STR(E$(),50,12)=" "&STR(R2$,1,6)&STR(R4$,1,3)
: E1(1)=256
: E1(2)=1750
: E1(3),E1(4)=0
: STR(E$(),150)=HEX(0000)&" 0 0 001750 256N55N"
: STR(E$(),845,5)=" 0 0"
: GOTO 1490
1240 MAT REDIM E$(18)83
: E4=A
: DATA LOAD DA T#P,(A)E$()
: MAT REDIM E$(E8)1
: CONVERT STR(E$(),152,3)TO E1(3)
: CONVERT STR(E$(),155,3)TO E1(4)
: F$()=ALL(00)
: E3$()=ALL(20)
: Z=3*ABS(INT(-9*E1(3)/249))
: N=3*ABS(INT(-8*E1(3)/249))
: CONVERT STR(E$(),157,3)TO O
: F8=A+(Z+N)/3
: D4,O=3*ABS(INT(-9*O/249))
: D2=F8+6
: J5=P
: IF E1(3)>0THEN 1340
: D2=D2+2
: GOTO 1490
1340 IF Z>0THEN MAT REDIM F$(Z)83,E3$(N)83
: IF Z>0THEN DATA LOAD DA T#P,(A+6,D2)F$(),E3$()
: D4=O
: J5=P
: MAT REDIM F$(E9)1,E3$(249)8
: E2$()=F$()
: FOR I=1TO E1(3)
: F1(8)=MAX(F1(8),INT(VAL(STR(E2$(I),2),2)*.0625)+VAL(E2$(I))-1)
: NEXT I
: GOSUB '33("IDS2sR00")
: IF J4=8THEN STR(E2$(36),5,3),STR(E2$(42),5,3)=AND HEX(FEFF3F)
1490 FOR I=2TO 18
: GOSUB '37(I)
: NEXT I
: IF J1=0THEN 1570
: FOR I=1TO 7
: GOSUB '71(I)
: NEXT I
: Y=0
: FOR I=78TO 126STEP 8
: IF STR(E$(),I,8)<>" "THEN Y=Y+1
: NEXT I
: GOSUB '55(38,Y)
1570 FOR I=35TO 43
: GOSUB '37(I)
: NEXT I
: GOSUB '55(39,E1(2))
: GOSUB '55(40,E1(1))
: GOSUB 2140
: IF J1<>0THEN 1722
1610 F=0
1620 F=F+1
: IF F>19THEN 1722
: IF F<>5AND F<>9AND F<>13AND F<>16THEN 1640
: GOSUB '43(F)
: IF E$<>" "THEN 1640
: IF F=13OR F=16THEN GOSUB '45(F,"0")
: IF F=5THEN GOSUB '45(5,R2$)
: IF F=9THEN GOSUB '45(9,R4$)
1640 I=0
: J2=1
: GOSUB '34(F)
: IF F=42THEN 1730
: IF F<13THEN 1620
: ON F-12GOTO 1690,1710,1620,1690,1620,1620,1720
: IF F<32THEN 1720
1690 IF VER(E$,"H")=1THEN 1620
: GOSUB '35("User class must be 0-9 or A-F")
: GOTO 1640
1710 IF E$=" "OR E$=R4$THEN 1620
: GOSUB '35("User ID (if used) must be current user's")
: GOTO 1640
1720 GOSUB '71(INT(F/2-8))
1722 IF STR(E$(),1493,2)=" "THEN STR(E$(),1493,2)="NN"
: FOR I=43TO 48
: GOSUB '37(I)
: NEXT I
: F5$=STR(E$(),1486,5)
: $TRAN(F5$,HEX(2000))R
: FOR I=1TO LEN(F5$)
: IF F5$=" "THEN E$="Key in file "&STR(E$(),78,8)
: ELSE E$=STR(E$(),(VAL(STR(F5$,I))-65)*20+1007,20)
: GOSUB '45(I+48,E$)
: NEXT I
1730 GOSUB '63("EXEC=Accept EDI","T=Modify top boxes '1-'7=Files '8-'10=Opt
ions '31=Cancel"," ")
: F6$(11)="N"
: GOSUB '34(250)
: IF Q=33THEN J2=1
: IF Q=33THEN 1610
: IF Q>0AND Q<8THEN 1830
: IF Q=8OR Q=10THEN 1840
: IF Q=9THEN 1890
: IF Q<>31THEN 1800
: COM CLEAR F1()
: LOAD T#2,R3$(1)1000,
1800 IF Q<>32THEN PRINT HEX(07);
: IF Q<>32THEN 1730
: ELSE Q=J2
: GOSUB '43(4)
: IF E$=" "THEN Q=-1
: GOSUB '55(4,Q+1)
: GOSUB '37(4)
: STR(E$(),53,9)=STR(R2$,,6)&R4$
: FOR I=6TO 9
: GOSUB '37(I)
: NEXT I
: E2$()=ALL(00)
: IF J1=0OR D4=0THEN 1820
: MAT REDIM E2$(D4)83
: DATA LOAD DA T#J5,(D2)E2$()
: MAT REDIM E2$(250)9
1820 LOAD T#2,"IDS2PR02"1000,
1830 STR(F6$(),12,2)="NN"
: F,J=Q*2+17
: IF J1=0OR STR(E$(),78,56)=" "THEN 1640
1835 F6$(11)="N"
: GOSUB '63("Warning ! -- Cha","nging files may be dangerous; EXEC = contin
ue, FN '31 = cancel","!")
: GOSUB '34(250)
: IF Q=32THEN 1836
: IF Q<>31THEN 1835
: GOTO 1730
1836 F=J
: GOTO 1640
1840 F=Q+33
: J2=1
: GOSUB '43(F)
: IF E$="N"THEN GOSUB '45(F,"Y")
: ELSE GOSUB '45(F,"N")
: GOTO 1730
1890 F=42
: GOTO 1640
1910 DEFFN'71(X)
: GOSUB '43(X*2+17)
: IF E$<>" "THEN 1970
: GOSUB '45(X*2+18," ")
: IF X>1THEN STR(E$(),I*45+89,45),E$(I+864),E$(I+171)=" "
: F1(X)=0
: GOTO 2140
1970 F5$=E$OR ALL(20)
: GOSUB '39(F5$,5)
: IF Q=2THEN 2030
: F0$="File "&HEX(0722)&STR(E$,,8)&HEX(22)&" not found"
: GOSUB '45(X*2+18,F0$)
: GOSUB '45(X*2+17," ")
2010 IF I<>0THEN RETURN
: RETURN CLEAR
: GOTO 1640
2030 DATA LOAD BA T#P,(A)STR(F2$(),1,256)
: IF STR(F2$(),1,4)<>HEX(8201D3E3)THEN 2010
: DATA LOAD DA T#P,(A)F2$()
: J7=0
: FOR K=108TO 176STEP 17
: IF STR(F2$(),K,8)<>" "THEN J7=J7+1
: NEXT K
: IF X<>1THEN CONVERT J7TO E$(X+171),(#)
: ELSE CONVERT J7TO E$(151),(#)
: GOSUB '37(X*2+17)
: GOSUB '45(X*2+18,STR(F2$(),22,32))
: IF STR(F2$(),10,1)<"5"THEN 2120
: F5$=STR(F2$(),82)OR ALL(20)
2100 GOSUB '39(F5$,5)
: DATA LOAD DA T#P,(A)F2$()
2120 CONVERT STR(F2$(),93,4)TO F1(X)
: F1(X)=MAX(F1(X),VAL(STR(F2$(),418)))
2140 J8=F1(8)
: F1(8)=0
: GOSUB '55(40,MAX(256,F1()))
: FOR J=1TO 7
: F1(8)=F1(8)+F1(J)
: NEXT J
: F1(8)=MIN(9999,MAX(J8,1750))
: GOSUB '55(39,F1(8))
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PR01"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"