Listing of file='FCSG020A' on disk='vmedia/701-2661A.wvd.zip'
# Sector 605, program filename = 'FCSG020A'
0010 REM FCSG020A, RELEASE 1-0, (07/24/78), THIS PROGRAM IS A COPYRIGHT PRODUC
T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
ORDER POINT ADJUSTMENT
0170 DIM A4$1,B$1,B0$1,B6$37,B7$1,B8$17,C2$4,C3$4,C4$4,C6$2,C6$(21)2,C7$(21)1,
F6$Q2,F7$Q7,G6$Q4,G7$37,I6$1,P(13),P$1,P7$4,P8$4,P9$4,P6$(14)2,P7$(1)2
4000 %-##,###,### -##,###,###
4005 %-##,###,###
4010 %############ ##### -####### -####### ####### ##
4015 GOTO 5745
4035 DEFFN'181(P9$)
: CONVERT STR(P9$,1,2)TO P9
: UNPACK(####)STR(P6$(P9),1,2)TO P9
: IF P$="D"THEN 4065
: P9=P9+(VAL(STR(P9$,3,1))-49)*7+VAL(STR(P9$,4,1))-48
: RETURN
4065 CONVERT STR(P9$,3,2)TO P6
: P9=P9+P6
: RETURN
4085 DEFFN'182(P9)
: P9=P9-INT((P9-1)/P1)*P1
: PACK(####)P9$FROMP9
: MAT SEARCHP6$()<1,P*2+2>,>=STR(P9$,1,2)TO P7$()STEP 2
: P6=(VAL(STR(P7$(1),2))-1)/2
: UNPACK(####)STR(P6$(P6),1,2)TO P7
: CONVERT P6TO P9$,(##)
: P7=P9-P7
: IF P$="D"THEN 4170
: P6=INT((P7+6)/7)
: CONVERT P6TO STR(P9$,3,1),(#)
: CONVERT P7-(P6-1)*7TO STR(P9$,4,1),(#)
: RETURN
4170 CONVERT P7TO STR(P9$,3,2),(##)
: RETURN
4185 DEFFN'183(P7$,P8)
: GOSUB '181(P7$)
: GOSUB '182(P9+P8)
: P8$=P9$
: RETURN
4215 DEFFN'184(P7$,P8$)
: GOSUB '181(P7$)
: P8=P9
: GOSUB '181(P8$)
: P8=P9-P8
: P8=P8+P1*(1-SGN(P8+.5))*.5
: RETURN
4275 DEFFN'170(F9,C3$,C4$)
: GOSUB '184(C3$,C4$)
: F6=P8+1
4300 DEFFN'171(F9,C3$,F6)
: F8,E8,G6=0
: GOSUB '181(C3$)
: CONVERT STR(C3$,1,2)TO F7
: UNPACK(####)P6$(F7+1)TO E6
: IF F9<0THEN 4385
: IF A4$<>"F"THEN 4385
: G6=D1
: IF ABS(D1)<B2THEN 4385
: G6=B2*SGN(D1)
: GOTO 4385
4375 E6=E6+P(F7)
4385 E7=E6-P9+1
: F6=F6-E7
: IF F6>0THEN 4410
: E6=E6+F6
: E7=E7+F6
4410 P9=P9+E7
: E7=E7/P(F7)
: E8=E8+E7
: IF G6>=0THEN 4490
: IF G6*(F9+E8)>=-1THEN 4490
: P9=E8
: E8=-1/G6-F9
: E7=E7-(P9-E8)
: IF F6<=0THEN 4490
: E6=E6+F6
: F6=0
4470 IF E6<=P1THEN 4490
: E6=E6-P1
: GOTO 4470
4490 F8=F8+B(F7)*E7
: IF F6<=0THEN 4535
: F7=F7+1
: IF F7<=PTHEN 4375
: P9,F7=1
: E6=0
: GOTO 4375
4535 GOSUB '182(E6+1)
: C3$=P9$
: F6=D*F8*(1+G6*F9+.5*G6*E8)
: IF F6>0THEN 4570
: F6=0
4570 F7=D0*F8^D5
: RETURN
4590 DEFFN'175
: B$=" "
: B9=0
: IF B0$="N"THEN 4625
: IF B0>0THEN 4655
4625 IF C1<=0THEN 4655
: GOSUB '183(C2$,-C1*7)
: GOSUB '171(0,P8$,C1*7)
: B9=.5*F8*D
4655 B0$="Y"
: IF B0>0THEN 4680
: B0$="N"
4680 IF A3$="S"THEN 4745
: IF A3$="F"THEN 4745
: IF A3$="W"THEN 4965
: IF A3$="M"THEN 5065
: B$="I"
: RETURN
4745 GOSUB '171(0,C2$,C1*3.5+C3)
: B6=F6
: C6=F7
: GOSUB '171(0,C2$,C3)
: B7=F6
: GOSUB '171(E8,C3$,C2*7)
: B7=B7+F6
: IF A3$="S"THEN 4850
: IF B4>0THEN 4825
: B4=1
4825 C7=F6+.5*B4
: IF C7>B4THEN 4875
: C7=B4
: GOTO 4875
4850 C7=F6
: IF C7=0THEN 4875
: IF C7>B5THEN 4875
: C7=B5
4875 GOSUB '177
: C6=C6*C8
: IF C6>D2THEN 4910
: C6=D2
4910 B6=B6+C6
: B7=B7+C6
4930 IF B7>B6THEN 4940
: B7=B6+1
4940 GOSUB '176
: RETURN
4965 GOSUB '171(0,C2$,(C1+D3)*7)
: B6=F6
: C6=D3+C1-.143*C3
: IF C6>=0THEN 5000
: B$="L"
5000 C6=(C6/(C1+D3))*B6
: IF D2<C6THEN 5020
: B6=B6+D2-C6
5020 GOSUB '183(C2$,C3)
: GOSUB '171(C3/30,P8$,C2*7)
: B7=B6+F6
: GOTO 4930
5065 B6=D3
: B7=D4
: GOTO 4930
5100 DEFFN'177
: IF C7*C6=0THEN 5160
: C7=C7/C6*(1-C5)
: IF C7>=.5THEN 5160
: PACK(.####)C6$FROMC7
: MAT SEARCHC6$(),>STR(C6$,1,2)TO P7$()STEP 2
: C9=(VAL(STR(P7$(1),2))+1)/2
: IF C9>1THEN 5175
5160 C8=0
: RETURN
5175 UNPACK(.####)C6$(C9-1)TO D6
: UNPACK(.####)C6$(C9)TO D8
: UNPACK(#.#)C7$(C9-1)TO D7
: UNPACK(#.#)C7$(C9)TO D9
: C8=(D9-D7)/(D8-D6)*(C7-D6)+D7
: RETURN
5220 DEFFN'176
: B8=0
: IF B0+B1>B6THEN 5300
: B8=B7-B0-B1
: IF A3$="F"THEN 5280
: IF B8>B5THEN 5295
: B8=B5
: GOTO 5295
5280 IF B4>=B8THEN 5295
: B$="M"
5295 IF B4<>0THEN B8=-INT(-B8/B4)*B4
5300 RETURN
5315 DEFFN'179
: GOSUB '180
: D5=.5
: FOR E9=0TO 20
: PACK(#.#)C7$(21-E9)FROME9*.2
: NEXT E9
: PACK(.####)C6$()FROM0,.0004,.0009,.0015,.0023,.0035,.0056,.0088,.0134,.01
99,.0294,.0425,.06,.0829,.1131,.151,.1985,.2561,.3252,.4062,.5
: RETURN
5375 DEFFN'180
: P=12
: P$="D"
: P(1)=31
: P(2)=28
: P(3)=31
: P(4)=30
: P(5)=31
: P(6)=30
: P(7)=31
: P(8)=31
: P(9)=30
: P(10)=31
: P(11)=30
: P(12)=31
: P(13)=00
: P1=0
: FOR P6=1TO P
: PACK(####)P6$(P6)FROMP1
: P1=P1+P(P6)
: NEXT P6
: PACK(####)P6$(P+1)FROMP1
: RETURN
5525 DEFFN'90
: SELECT PRINT 005(80)
: IF I6$="4"THEN RETURN
: Q6$=" "
: KEYIN Q6$,5538,5538
5538 IF Q6$="P"THEN GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
: SELECT PRINT <I0$>(132)
: IF L<L0THEN 5620
: PRINT HEX(0C0A0E);TAB(3);N2$
: P3=P3+1
: PRINT HEX(0A)
: IF I6$="2"THEN PRINT B6$;
: IF I6$="3"THEN PRINT B6$;
: PRINT TAB(51);"ORDER POINT ADJUSTMENT REPORT";TAB(110);Q1$;TAB(122);"PAGE
";P3
: PRINT HEX(0A);TAB(15);G7$
: PRINT HEX(0A)
5600 PRINT TAB(20);"PRODUCT DESCRIPTION";TAB(64);"VENDOR ORDER
ORDER UP RECOMMENDED RETURN"
: PRINT TAB(20);"NUMBER";TAB(64);"NUMBER POINT TO LEVEL O
RDER CODE"
: PRINT HEX(0A)
: L=9
5620 RETURN
5635 DEFFN'31
: IF I6$<>"4"THEN 5685
: IF I7=0THEN 5660
: PRINT AT(9,10,);"TOTAL NUMBER OF PRODUCTS WITH MISSING PROFILES = ";I7
5660 IF I8=0THEN 5670
: PRINT AT(10,10,);"NUMBER OF UNSUCCESSFUL ATTEMPTS TO ADD TO P.O. FILE = "
;I8
5670 IF I7+I8=0THEN 5685
: GOSUB '254
5685 SELECT PRINT 005(80)
: PRINT AT(1,30,);"** TERMINATING PROGRAM **"
: LOAD TM$
5705 IF I6$="4"THEN 5725
: GOSUB '90
: PRINT HEX(0A);TAB(20);I5;"PRODUCTS IN UPDATE"
: L=L+2
5725 I5=0
: RETURN
5745 SELECT @PARTS0$
: GOSUB '179
: SELECT PRINT 005(80),CO 005(80),LIST 005(80)
: I7,I8=0
: P3=0
: B7$="A"
: C2$=Q1$
: STR(C2$,3,2)=STR(Q1$,4,2)
5815 PRINT AT(5,10,);"1. EACH PRODUCT IN UPDATE"
: PRINT AT(6,10);"2. ONLY PRODUCTS WITH RECOMMENDED ORDERS"
: PRINT AT(7,10);"3. ONLY ERRORS"
: PRINT AT(8,10);"4. NO PRINTOUT"
: Q6$="1"
: GOSUB '100("1","4",1,0,"ENTER NUMBER OF DESIRED REPORT TYPE",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: I6$=Q6$
: IF I6$<"4"THEN 5875
: $CLOSE#15
5865 GOTO 5890
5875 GOSUB '93(" ")
: IF I0$=" "THEN 5815
5885 L=L0
5890 B6$="EACH PRODUCT IN UPDATE"
: IF I6$="1"THEN 5925
: B6$="ONLY PRODUCTS WITH RECOMMENDED ORDERS"
: IF I6$="2"THEN 5925
: B6$="ERRORS"
: IF I6$="3"THEN 5925
: B6$="NO HARDCOPY PRINTOUT"
5925 PRINT AT(5,10,);"PRINT OPTION - ";B6$
: Q6$=B7$
: GOSUB '100("A,R,I,P,V,0","AaRrIiPpVv",1,1,"UPDATE TYPE (A=ALL R=RANGE I=I
ND. P=REV.PER. V=VEND.# 0=END)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="0"THEN GOSUB '31
: B7$=Q6$
: IF B7$="V"THEN 6120
: IF B7$="P"THEN 6205
: G7$="INDIVIDUAL"
: IF B7$="I"THEN 6245
: G7$="ALL"
5985 IF B7$="A"THEN 6245
5995 GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),0,"ENTER STARTING PRODUCT ID (OR END)"
,2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="END"OR Q6$="end"THEN GOSUB '31
: GOSUB '96(2)
: F1$=Q6$
: GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),0,"ENTER ENDING PRODUCT ID (OR END)",2
)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="END"OR Q6$="end"THEN F6$="END"
: IF F6$="END"THEN 6080
6050 GOSUB '96(2)
: F6$=Q6$
: IF F1$<=F6$THEN 6080
: PRINT AT(3,0,80);"Starting ID must be lower than Ending ID"
: GOTO 5995
6080 G7$="RANGE = ############ TO"
: IF F1$=" "THEN STR(G7$,9,12)=" BEGINNING "
: ELSE STR(G7$,9,12)=F1$
: STR(G7$,26,12)=F6$
: IF F6$="END"THEN INIT("^")F6$
: GOTO 6245
6110 SELECT PRINT 005(80)
6115 PRINT AT(1,0,)
6120 GOSUB '100(" ",HEX(7F),VAL(Q0$(4)),0,"ENTER VENDOR ID (OR END)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="END"OR Q6$="end"THEN GOSUB '31
: IF Q6$<>" "THEN 6175
: PRINT AT(3,0);"Re-enter"
: GOTO 6115
6175 GOSUB '96(4)
: G6$=Q6$
: G7$="VENDOR ID ="
: STR(G7$,17,5)=G6$
: GOTO 6245
6205 GOSUB '100("0","9",1,0,"ENTER REVIEW PERIOD (0=END)",1)
: IF Q6$=HEX(1F)OR Q9=0THEN GOSUB '31
: I9=Q9
: G7$="REVIEW PERIOD = # WEEKS"
: CONVERT I9TO STR(G7$,17,1),(#)
: IF I9>1THEN 6245
: G7$=STR(G7$,1,LEN(G7$)-1)
6245 PRINT AT(6,10);"UPDATE TYPE - ";G7$
: Q6$="Y"
: GOSUB '100("Y,N","YyNn",1,1,"IS DATA OK (Y OR N)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 5815
: IF B7$="I"THEN 6300
: PRINT AT(1,0,)
: PRINT AT(9,25,);"PERFORMING ORDER POINT ADJUSTMENTS"
: GOTO 6305
6300 PRINT AT(10,0);"PRODUCT ID VENDOR ORDER PT OUTL REC ORD RC"
6305 GOSUB '90
: IF B7$="I"THEN 6335
: IF B7$="R"THEN 6390
: GOTO 6445
6335 GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),0,"ENTER PRODUCT NUMBER (OR END)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$<>"END"AND Q6$<>"end"THEN 6375
: GOSUB 5705
: SELECT PRINT 005(80)
: P3,I7,I8=0
: GOTO 5885
6375 GOSUB '96(2)
: F1$=Q6$
6390 GOSUB '232(1,0,F1$)
: IF Q$=" "THEN 6480
: IF B7$="R"THEN 6995
: GOSUB '91
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Product ID ";F1$
: IF B7$="I"THEN 6335
: GOSUB '92
: IF J0<>7THEN GOSUB '31
: IF B7$="R"THEN 6390
: GOTO 6335
6445 GOSUB '235(1,0)
: IF Q$=" "THEN 6480
: GOSUB '91
: IF J0<>7THEN GOSUB '31
: GOSUB '92
: GOTO 6445
6480 GOSUB '78(2)
: IF B7$<>"P"THEN 6510
: IF A3$="M"THEN 6990
: IF C1<>I9THEN 6990
6510 IF B7$<>"V"THEN 6525
: IF G2$<>G6$THEN 6990
6525 B0=E-E3
: B1=E1
: B$=" "
: I5=I5+1
: IF I5>1THEN 6560
6560 B6=E4
: B7=E5
: IF A3$="M"THEN 6775
: IF G1$=F7$THEN 6710
: F7$=" "
6595 GOSUB '232(2,0,G1$)
: IF Q$=" "THEN 6695
: IF I6$="4"THEN 6640
: IF Q$<>"N"THEN 6640
: GOSUB '90
: PRINT TAB(20);"PRODUCT ID ";F1$;" *** PROFILE ID ";G1$;" NOT FOUND ***"
: L=L+1
: IF B7$="I"THEN 6640
: GOTO 6680
6640 SELECT PRINT 005
: GOSUB '91
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Profile ID ";G1$
: IF J0=3THEN 6680
: IF B7$="I"THEN 6335
: IF J0<>7THEN GOSUB '31
: GOSUB '92
: GOTO 6595
6680 I7=I7+1
: GOTO 6990
6695 F7$=G1$
: GOSUB '79(4)
6710 Q9=1
: IF I1$="L"THEN 6735
: Q9=2
: IF I1$="M"THEN 6735
: Q9=3
6735 UNPACK(##.##)STR(D4$(1),4+(Q9-1)*20)TO A,A0,A1,A2,A3,A4,A5,B3,B,B2
: A4$=STR(D4$(1),Q9)
: GOSUB '175
: E4,B6=INT(B6)
: E5,B7=-INT(-B7)
6775 GOSUB '176
: DBACKSPACE #2,1S
: GOSUB '68(2)
: IF B8<=0THEN 6885
: B8$=G2$
: STR(B8$,VAL(Q0$(4))+1)=F1$
: STR(T5$(3),,3)=HEX(000001)
: GOSUB '234(3,0,B8$,0)
: IF Q$="D"THEN 6885
: IF Q$=" "THEN 6885
: I8=I8+1
: GOSUB '91
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Product ID ";B8$
: GOSUB '92
: IF B7$="I"THEN 6335
: GOSUB '31
6885 IF I6$="4"THEN 6960
: IF I6$="1"THEN 6910
: IF B$<>" "THEN 6910
: IF I6$="3"THEN 6960
: IF B8<=0THEN 6960
6910 GOSUB '90
: PRINT TAB(20);F1$;TAB(37);F2$;TAB(64);G2$;TAB(71);
: PRINTUSING 4000,E4,E5;
: IF B8<=0THEN 6940
: PRINT TAB(101);
: PRINTUSING 4005,B8;
6940 PRINT TAB(117);B$
: L=L+1
6960 IF B7$<>"I"THEN 6990
: SELECT PRINT 005(80)
: PRINT AT(11,0);
: PRINTUSING 4010,F1$,G2$,E4,E5,B8,B$
6990 IF B7$="I"THEN 6335
6995 GOSUB '237(1,0)
: IF Q$=" "THEN 7045
: IF Q$="E"THEN 7055
: GOSUB '91
: IF J0=1THEN 7025
: IF J0>0THEN PRINT AT(3,LEN(J$(J0))+1);"- Product ID ";T7$
7025 GOSUB '92
: IF J0=1THEN 7055
: IF J0<>7THEN GOSUB '31
: GOTO 6995
7045 IF B7$<>"R"THEN 6480
: IF T7$<=F6$THEN 6480
7055 GOSUB 5705
: IF B7$="A"THEN GOSUB '31
: SELECT PRINT 005(80)
: P3,I7,I8=0
: GOTO 5885
9998 DEFFN'29"Q$=";HEX(22);"FCSG020A";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)