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)