Listing of file='GBS1220D' on disk='vmedia/701-2661A.wvd.zip'
# Sector 127, program filename = 'GBS1220D'
0010 REM GBS1220D, RELEASE 1-1, (06/03/80), THIS PROGRAM IS A COPYRIGHT PRO
DUCT OF WANG LABORATORIES. UNAUTHORIZED USE OR REPRODUCTION IS PROHIBITED
. CLEAR FILES - INVENTORY MASTER FILE.
0170 DIM E8$(5)60,I6$1,L4$4,I7$1,E6$1,F6$Q7,P$(1)36
: GOTO 4000
4000 % $###,###,###.##
4010 GOTO 6610
4040 T7=0
: P=12
: P1=1
: INIT(20)E8$(),E6$,L2$,R$
: RETURN
4120 Q6$=STR(Q1$,1,2)&STR(Q1$,7,2)
: IF STR(Q1$,4,2)>"15"THEN 4230
: IF STR(Q1$,1,2)>"01"THEN 4200
: STR(Q6$,1,2)="12"
: CONVERT STR(Q1$,7,2)TO Q9
: CONVERT (Q9-1)TO STR(Q6$,3,2),(##)
: GOTO 4230
4200 CONVERT STR(Q1$,1,2)TO Q9
: CONVERT (Q9-1)TO STR(Q6$,1,2),(##)
: STR(Q6$,3,2)=STR(Q1$,7,2)
4230 GOSUB '100("0100","1399",4,0,"ENTER DATE OF CURRENT SALES (MMYY)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: L4$=Q6$
: PRINT AT(6,15);"2. SALES DATE = ";L4$
: RETURN
4300 PRINT AT(5,15,320);"1. ALL PROFILES"
: PRINT AT(6,15);"2. ERRORS ONLY"
: PRINT AT(7,15);"3. NO HARDCOPY"
: GOSUB '100("1","3",1,0,"ENTER REPORT TYPE",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: I6$=Q6$
: IF I6$="1"THEN Q6$="ALL PROFILES"
: IF I6$="2"THEN Q6$="ERRORS ONLY"
: IF I6$="3"THEN Q6$="NO HARDCOPY"
4390 PRINT AT(5,15,320);"1. REPORT TYPE = ";Q6$
: RETURN
4430 H2=H2+H
: H4=H4+H1
: H3=H3+F3
: D3(2)=D3(2)+D3(1)
: IF H=0THEN D8=H(1)*D3(1)
: ELSE D8=(H1/H)*D3(1)
: T7=T7+H1+D8
: H,H1,F3,D3(1)=0
: RETURN
4560 DEFFN'90
: IF I6$="3"THEN RETURN
: Q6$=" "
: KEYIN Q6$,4600,4600
4600 IF Q6$="P"THEN GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
: SELECT PRINT <I0$>(132)
: IF L<L0THEN RETURN
: PRINT HEX(0D0C0A0E);TAB(3);N2$
: PRINT HEX(0A);TAB(45);"CLEAR INVENTORY FILE P-T-D FIGURES";TAB(111);Q1$;T
AB(121);"PAGE ";P1
: IF I6$="2"THEN PRINT HEX(0A);TAB(7);"ERRORS ONLY"
: PRINT HEX(0A);TAB(7);"INDICES WERE";
: IF I7$="N"THEN PRINT " NOT";
4690 PRINT " GENERATED FROM SALES DATA"
: PRINT HEX(0A);TAB(7);"CURRENT SALES PERIOD = ";L4$
: PRINT TAB(60);"UNSCALED"
: PRINT TAB(11);"PROFILE ID";TAB(29);"DESCRIPTION";TAB(58);"PERIOD SALES";T
AB(78);"REMARKS"
: Q6$=ALL("-")
: PRINT TAB(10);Q6$;STR(Q6$,,40)
: L=9
: P1=P1+1
: RETURN
4800 IF I6$="3"THEN 4990
: GOSUB '90
: R$=" "
: IF I6$="2"AND E8$()=" "THEN 4990
: PRINT HEX(0A);TAB(11);G1$;TAB(26);L2$;TAB(52);
: PRINTUSING 4000,L1*T7;
: L=L+1
: FOR I=1TO 5
: IF E8$(I)=" "THEN 4950
: R$="E"
: PRINT TAB(70);E8$(I)
: L=L+1
4950 NEXT I
: IF R$=" "THEN PRINT TAB(70);" "
: IF R$=" "THEN L=L+1
4990 E9=E9+1
: IF R$="E"THEN E8=E8+1
: GOSUB 4040
: RETURN
5060 DEFFN'195
: GOSUB '197
: MAT B=ZER
: L5=0
: FOR B6=1TO P
: FOR C7=D7TO C8
: IF (C7-1)*P+B6<C6OR (C7-1)*P+B6>C6+INT(((L2-C6)+1)/P)*P-1THEN 5170
: B(B6)=B(B6)+L(C7,B6)
: L5=L5+1
5170 NEXT C7
: NEXT B6
: GOSUB '196
: RETURN
5230 DEFFN'196
: R$="E"
: D7=0
: FOR B6=1TO P
: D7=D7+B(B6)
: NEXT B6
: IF D7>0THEN 5340
: L5=0
: MAT B=CON
: RETURN
5340 R$=" "
: IF ABS(D7-P)<.005*PTHEN RETURN
: MAT B=(P/D7)*B
: D7=0
: FOR B6=1TO P
: IF B(B6)<9.995THEN 5430
: D7=B6
5430 NEXT B6
: IF D7=0THEN 5560
: D6=.5*(B(D7)-9.99)
: B7=D7-1-P*(SGN(D7-1)-1)
: B6=D7+1+P*(SGN(P-D7)-1)
: B(B6)=B(B6)+D6
: B(B7)=B(B7)+D6
: B(D7)=9.99
5560 MAT B=(100)*B
: FOR B6=1TO P
: B(B6)=INT(B(B6)+.5)
: NEXT B6
: MAT B=(.01)*B
: RETURN
5640 DEFFN'197
: CONVERT STR(L4$(2),1,2)TO Q9
: IF STR(L4$(1),3,2)=STR(L4$(2),3,2)THEN 5730
: CONVERT STR(L4$(1),3,2)TO B6
: CONVERT STR(L4$(2),3,2)TO C7
: D7=C7-B6+1
: GOTO 5740
5730 D7=1
5740 C6=Q9+(D7-1)*P
5760 C8=INT(L2/P)+SGN(MOD(L2,P))
: IF INT(L2/P)=L2/PAND STR(L4$(1),1,2)<>"01"THEN C8=C8+1
: RETURN
5810 T7=ROUND((T7/L1,0)
: IF T7=0THEN RETURN
: IF INT(LGT(T7)+1)<=4THEN RETURN
: S7=10^((INT(LGT(T7))+1)-4)
: T7=ROUND((T7/S7,0)
: GOSUB 5760
: FOR C6=1TO C8
: FOR C7=1TO P
: L(C6,C7)=ROUND((L(C6,C7)/S7,0)
: NEXT C7
: NEXT C6
: L1=L1*S7
: CONVERT S7TO Q6$,(##########)
: E8$(4)="STORED SALES DATA WAS RE-SCALED BY "&STR(Q6$,POS(Q6$<>"0"))
: RETURN
6010 FOR D6=1TO 4-B6
: FOR D7=1TO P
: L(D6,D7)=L(D6+B6,D7)
: NEXT D7
: NEXT D6
: CONVERT STR(L4$(1),1,2)TO I
: E8$(3)="DATA FR0M "&P$(I)&STR(L4$(1),3,2)&" TO "&P$(12)&STR(L4$(1),3,2)&"
WAS DELETED TO MAKE ROOM FOR "&P$(1)&STR(L4$,3,2)
: L2=(L2+1)-((P-I)+1)
: STR(L4$(1),1,2)="01"
: CONVERT STR(L4$(1),3,2)TO Q9
: Q9=Q9+1
6150 CONVERT Q9TO STR(L4$(1),3,2),(##)
: CONVERT STR(L4$(2),3,2)TO D7
: IF D7>=Q9THEN 6200
: D7=D7+1
: STR(L4$(2),1,2)="01"
: CONVERT D7TO STR(L4$(2),3,2),(##)
6200 RETURN
6230 CONVERT STR(L4$(1),1,2)TO C8
: C9=C8+L2
: CONVERT STR(L4$(1),3,2)TO C6
: CONVERT STR(L4$,3,2)TO C7
: CONVERT STR(L4$,1,2)TO B6
: IF (C7-C6)*P+B6>=C8AND (C7-C6)*P+B6<=C9THEN 6340
: E6$="2"
: RETURN
6340 IF (C7-C6)*P+B6<P*4+1THEN 6400
: GOSUB 6010
: RETURN
6400 D6=(C7-C6)+1
: IF (C7-C6)*P+B6=C9THEN L2=L2+1
: RETURN
6460 DEFFN'31
: IF I6$="3"THEN 6500
: PRINT HEX(0A0A);TAB(11);"NUMBER OF PROFILES PROCESSED = ";E9
: PRINT HEX(0A);TAB(11);"NUMBER OF PROFILES WITH ERRORS = ";E8
6500 SELECT PRINT 005(80)
: PRINT HEX(030A);TAB(20);"** TERMINATING PROGRAM **"
: GOSUB '239(1)
: GOSUB '219(S$(1),1,S2," ",0)
: GOSUB '219(S$(4),4,S2," ",0)
: COM CLEAR I
: LOAD TM$
6610 SELECT @PARTS0$
: SELECT PRINT 005(80),LIST 005,CO 005
: PRINT AT(0,20,);"CLEAR INVENTORY FILE"
: GOSUB 4040
: P$(1)="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
: MAT REDIM P$(12)3
: DATA LOAD DC OPEN T#1,S$(1)
: DATA LOAD DC OPEN T#4,S$(4)
: GOSUB '230(1,14,13,1,S$(13),3," ",STR(M$(),34,3),STR(M$(),37,3))
: GOSUB '91
: IF J=0THEN 6790
6750 PRINT AT(3,LEN(J$(J0))+1);"- Profile File"
: GOSUB '254
: GOSUB '31
6790 LIMITS T#1,S$(1),B9,C7,C8,C9
: IF C9=2THEN 6860
: PRINT AT(3,0);Q6$;" File not an Active File"
: GOSUB '254
: GOSUB '31
6860 GOSUB 4300
: GOSUB 4120
: GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH TO GENERATE INDICES (Y/N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: I7$=Q6$
: PRINT AT(7,15);"3. GENERATE INDICES - ";
: IF I7$="N"THEN PRINT "NO"
: ELSE PRINT "YES"
: Q6$="Y"
: GOSUB '100("Y,N","YyNn",1,1,"IS DATA OK (Y/N)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 6860
7010 IF I6$<"3"THEN 7050
: $CLOSE#15
: GOTO 7110
7050 GOSUB '93(" ")
: IF I0$=" "THEN 6860
: L=L0
: GOSUB '90
7110 DATA LOAD DC #4,K5$()
: IF END THEN B8=0
: ELSE B8=1
: IF B8=0THEN GOSUB '31
7150 IF B8>0THEN DBACKSPACE #1,BEG
: IF B8<51THEN 7210
: B8=1
: DATA LOAD DC #4,K5$()
: IF END THEN K5$()=ALL(FF)
7210 IF STR(K5$(B8),1,1)<>HEX(FF)THEN 7240
: GOTO 7340
7240 B7=VAL(K5$(B8),2)-B9
: IF B7=0THEN 7280
: DSKIP #1,B7S
7280 GOSUB '78(1)
: DBACKSPACE #1,1S
: IF F6$<>" "THEN 7330
: F6$=G1$
7330 IF G1$=F6$THEN 7930
7340 Q6$=F6$
: F6$=G1$
: G1$=Q6$
: SELECT PRINT 005(80),LIST 005,CO 005
: L1=1
7380 GOSUB '232(1,0,G1$)
: IF Q$="N"THEN 7490
: GOSUB '91
: IF J0=0THEN 7530
: PRINT AT(3,LEN(J$(J0))+1);"- Profile File"
: IF J0<>7THEN GOSUB '31
: GOSUB '254
: GOTO 7380
7490 E6$="1"
: E8$(1)="PROFILE RECORD NOT FOUND"
: GOTO 7880
7530 GOSUB '79(13)
: IF L2<>0THEN 7650
: L4$(1),L4$(2)=L4$
: L1,L2=1
: GOSUB 5810
: CONVERT STR(L4$,1,2)TO Q9
: L(1,Q9)=T7
: GOTO 7740
7650 GOSUB 6230
: IF E6$<>"2"THEN 7700
: E8$(2)="SALES DATA NOT STORED - NOT IN RANGE OF EXISTING DATA"
: GOTO 7840
7700 GOSUB 5810
: IF E8$(3)=" "THEN L(D6,B6)=T7
: ELSE L(4,1)=T7
7740 IF I7$="N"THEN 7840
: GOSUB '197
: CONVERT STR(L4$(1),1,2)TO B6
: IF (L2+B6)-C6>=PTHEN 7810
: E8$(5)="INDICES CANNOT BE GENERATED - NOT ENOUGH SALES DATA"
: GOTO 7840
7810 GOSUB '195
: C5$="E"
7840 DBACKSPACE #13,1S
: GOSUB '69(13)
7880 GOSUB 4800
: IF STR(K5$(B8),1,1)=HEX(FF)THEN GOSUB '31
: G1$=F6$
7930 GOSUB 4430
: GOSUB '68(1)
: B8=B8+1
: GOTO 7150
9999 DEFFN'29"Q$=";HEX(22);"GBS1220D";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)