image of READY prompt

Wang2200.org

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)