Listing of file='IDS2PRX2' on disk='vmedia/701-2725B.wvd.zip'
# Sector 49, program filename = 'IDS2PRX2'
1000 REM "IDS2PRX2"
1018 COM C1
: IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: F3$=STR(E$(),850)
: Z=0
: IF F3$="005"THEN 1500
: MAT SEARCHE3$(),="Y"TO F9$STEP 9
: IF F9$=HEX(0000)THEN 1500
: X=INT((VAL(F9$,2)+8)/9)
: PRINT AT(14,14);"Test lines are printed at the current paper position"
1040 PRINT AT(15,14);"with no top-of-form. Position forms properly before"
: PRINT AT(16,14);"printing test lines. After the test lines have been"
: PRINT AT(17,14);"printed, a top-of-form is issued automatically."
1070 E$="Check paper position. EXEC = print report, EDIT = test lines, FN'3
1 = cancel."
: F6$=" "
1090 GOSUB '63(STR(E$,,16),STR(E$,17),F6$)
: KEYIN E6$,,1120
: PRINT AT(23,0,80);
: IF E6$=HEX(0D)THEN E6$=HEX(82)
: F6$="!"
: IF E6$<>HEX(82)THEN 1090
: GOTO 1150
1120 IF E6$=HEX(1F)THEN 1818
: PRINT AT(23,0,80);
: F6$="!"
: IF E6$<>HEX(F0)THEN 1090
1150 E4$()=ALL(00)
: I=0
: GOTO 1180
1160 I=I+1
: IF STR(D2$,8,1)=HEX(10)THEN 1460
: IF I<12THEN 1160
1180 IF E6$=HEX(82)THEN 1500
: G=X
1210 GOSUB '77(G)
: G=G+1
: IF STR(E3$(G),,1)="Y"THEN 1210
: Z=1
: E0$()=HEX(020C)
: GOSUB 1850
: GOTO 1070
1460 E$="Check printer select. EXEC = print report, EDIT = test lines, FN'3
1 = cancel."
: F6$="!"
: GOTO 1090
1500 IF F3$<>"005"THEN 1505
: PRINT HEX(03);
: GOTO 1510
1505 IF Z<>0THEN 1510
: E0$()=HEX(020C)
: GOSUB 1850
1510 MAT SEARCHE3$(),="X"TO F9$STEP 9
: IF F9$=HEX(0000)THEN 1795
: Z=(VAL(F9$,2)+8)/9
: E0$()=HEX(01)
: FOR I=1TO 10
: GOSUB '76(0)
: NEXT I
: E$="**************************************"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
: E$="* Wang 2200 IDEAS Report Generator *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
1530 E$="* *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
: E$="* Report Title = "&HEX(22)&STR(E$(),2,8)&HEX(22)&" *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
: E$="* *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
1545 E$="* ("&STR(E$(),18,32)&") *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
: E$="* *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
: E$="* Date = "&STR(R2$,1,2)&"/"&STR(R2$,3,2)&"/"&STR(R2$,5,2)&" User
ID = "&STR(R4$,1,3)&" *"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
1560 E$="**************************************"
: GOSUB '48(22,E$,0)
: GOSUB '76(0)
: FOR I=1TO 3
: GOSUB '76(0)
: NEXT I
: IF F3$="005"THEN 1795
: IF STR(E$(),1307,80)=" "AND POS(STR(E$(),1387,80)<>FF)=0THEN 1650
: GOSUB '48(10,"Record Range Criteria used in this report run :",0)
: GOSUB '76(0)
1585 GOSUB '48(10,"Description Minimum Value Maximum Val
ue",0)
: GOSUB '76(0)
: Q=1307
: FOR I=1TO VAL(E$(151))-48
: E$=STR(E$(),987+I*20,20)
: X=VAL(E$(1598+I*6))
: E$=STR(E$,,21)&STR(E$(),Q,X)
: E$=STR(E$,,48)&STR(E$(),Q+80,X)
: Q=Q+X
: GOSUB '48(10,E$,0)
: GOSUB '76(0)
: NEXT I
: GOSUB '76(0)
1650 IF E$(1468)=" "THEN 1740
: GOSUB '48(10,"Record selection criteria used in this report run :",0)
: GOSUB '76(0)
: Q=1468
: I=1
1665 IF E$(Q)=" "THEN 1740
: X=POS("ABCDEFGHIJKLMNO"=E$(Q))
: E$=STR(E$(),987+X*20,20)
: E$=E$&STR(E$(),Q+1,2)
: IF E$(Q+3)<>"V"THEN E$=E$&STR(E$(),987+POS("ABCDEFGHIJKLMNO"=E$(Q+3))*20,
20)
: ELSE E$=E$&HEX(22)&STR(E$(),757+I*20,VAL(E$(1598+X*6)))&HEX(22)
: GOSUB '48(35-INT(LEN(E$)/2),E$,0)
: GOSUB '76(0)
: I=I+1
1705 IF E$(Q+4)=" "OR Q=1482THEN 1730
: GOSUB '48(34,STR(E$(),Q+4,3),0)
: GOSUB '76(0)
: Q=Q+7
: IF Q<1483THEN 1665
: GOTO 1740
1730 GOSUB '76(0)
1740 IF STR(E$(),1486,5)=" "THEN 1780
: GOSUB '48(10,"Record Sort Criteria used in this report run :",0)
: GOSUB '76(0)
: FOR I=1TO POS(-STR(E$(),1486,5)<>20)
: GOSUB '48(10,STR(E$(),987+POS("ABCDEFGHIJKLMNO"=E$(1485+I))*20,20),0)
: GOSUB '76(0)
: NEXT I
: GOSUB '76(0)
1780 FOR I=1TO 3
: GOSUB '76(0)
: NEXT I
1785 GOSUB '77(Z)
: Z=Z+1
: IF STR(E3$(Z),,1)="X"THEN 1785
: IF F3$="005"THEN PRINT HEX(03);
: E0$()=HEX(020C)
: GOSUB 1850
1795 MAT SEARCHE3$(),>"H"TO F9$STEP 9
: C1=MAX(1,INT((VAL(F9$,2)+8)/9)-1)
: E$="IDS2PRX3IDS2PX"
: CONVERT R0TO STR(E$,15),(##)
: F6$(54)=F6$(17)AND HEX(03)
: V=VAL(F6$(54))
: CONVERT STR(E$(),77,1)TO U
: IF MOD(V,2)=0AND MOD(U,2)=1THEN E$=E$&"IDS2SUB7"
: IF V<2AND U>1THEN E$=E$&"IDS2SUB8"
: LOAD T#2,<LEN(E$)/8>E$1000,1994
1818 COM CLEAR F()
: $CLOSE#1
: MAT REDIM E4$(16)16
: F3$=F4$
: SELECT #1<STR(F4$,,3)>
: HEXPACKE8$(7)FROMSTR(F4$,2,2)
: GOSUB '39(R3$(1),4)
: LOAD T#P,R3$(1)1000,
1820 DEFFN'77(Y)
: UNPACK(##)STR(E3$(Y),6)TO B
: IF INT(B/10)=0THEN 1824
: FOR I=1TO B
: E0$()=HEX(020A)
: GOSUB 1850
: NEXT I
1824 A=VAL(STR(E3$(Y),8),2)
: C=VAL(STR(E3$(Y),7,1))
: IF C=255THEN 1830
: DATA LOAD BA T#D,(A)E4$()
: E4$()=STR(E4$(),C,M)
: GOTO 1831
1830 E4$()=STR(E2$(),A,M)
1831 E0$()=BIN(LEN(E4$())+1)&E4$()
: E8$(6)=" "
: GOSUB '49(0)
: IF E8$(5)=HEX(1F)THEN 1818
: IF F3$<>"005"THEN 1832
: E0$()=HEX(020A)
: GOSUB 1850
1832 IF MOD(B,10)<>0THEN 1833
: E8$(6)=" "
: RETURN
1833 B=B-1
: E0$()=HEX(020A)
: GOSUB 1850
: GOTO 1832
1845 DEFFN'76(L)
: GOSUB '49(L)
: IF E8$(5)=HEX(1F)THEN 1818
: IF F3$<>"005"THEN RETURN
: E0$()=HEX(020A)
: GOSUB '49(0)
: RETURN
1850 E8$(6)=HEX(00)
: GOSUB '49(0)
: E8$(6)=" "
: IF E8$(5)=HEX(1F)THEN 1818
: RETURN
1990 STOP #
: GOTO 1990
1994 %
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PRX2"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"