Listing of file='INVT020A' on disk='vmedia/701-2616C.wvd.zip'
# Sector 166, program filename = 'INVT020A' 0010 REM INVT020A, RELEASE 2.2, (09/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED 0020 REM --------------------------------------------------------------------- - 0030 REM SYSTEM & MODULE = GBS/MVP INVENTORY SYSTEM, MAINTAIN INVENTORY FIL E 0040 REM PROGRAM FUNCTION = MAINTAIN RECORDS IN THE INVENTORY MASTER FILE 0050 REM DATE WRITTEN = 03/20/79 MK 0060 REM LAST REVISION = 09/11/80 TM 0065 REM THIS PROGRAM WAS UPGRADED TO 2.2 BY ERRATA 1145 0070 REM --------------------------------------------------------------------- - 0170 DIM I9$1 0198 GOTO 4000 3996 REM ************************************* 3997 REM ! INVENTORY MASTER FILE MAINTENANCE ! 3998 REM ************************************* 3999 REM 4000 SELECT @PARTS0$ 4010 I9=24 : REM NO. OF FIELDS 4020 B6=24 : REM LONGEST FIELD - LEFT SIDE OF SCREEN 4030 C6=8 : REM MAX. DIGITS LEFT OF '.' - LEFT SIDE 4040 B7=9 : REM LONGEST FIELD - RIGHT SIDE OF SCREEN 4050 C7=6 : REM MAX. DIGITS LEFT OF '.' - RIGHT SIDE 4060 REM CHECK AUDIT FILE SPACE 4070 LIMITS T#3,S$(3),Q6,Q7,Q8 4080 Q9 = (Q8-2)/(Q7-Q6-1) 4090 IF Q9 > .8 THEN PRINT AT(3,0);"Maintenance audit file is more than";I NT(Q9*100);"% full." 4100 IF Q9 < .95 THEN 4140 4110 GOSUB '254 4120 GOSUB '31 4130 REM ENTER PRODUCT ID (KEY FIELD) 4140 GOSUB '238(1) : REM ALWAYS RELEASE PREVIOUS RECORD 4150 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER PRODUCT ID. (OR END)",2) 4160 IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31 4170 IF Q6$=" "THEN 4140 4180 GOSUB '96(2) : REM CONSTRUCT PRODUCT ID 4190 F1$=Q6$ 4200 PRINT AT(4,0,);TAB(10);"Product ID - ";F1$ 4210 REM TRANSACTION TYPE (ADD, CHANGE, DELETE) 4220 GOSUB '100("A,C,D","AaCcDdC ",1,1,"ENTER TRANSACTION TYPE (A = ADD, C = CHANGE, D = DELETE)",2) 4230 IF Q6$=HEX(1F) THEN GOSUB '31 4240 I9$=Q6$ 4250 Q6$="Add ChangeDelete" 4260 PRINT AT(4,0);STR(Q6$,Q9*6-5,6); 4270 IF I9$<>"A" THEN 4450 4280 REM %ADD A NEW PRODUCT 4290 GOSUB '232(1,0,F1$) : REM IS PRODUCT ALREADY ON FILE? 4300 IF Q$="N" THEN 4330 4310 PRINT AT(3,0,80);HEX(07);"Product ID is already in the inventory mast er file." 4320 GOTO 4140 4330 GOSUB '36 : REM CLEAR INVENTORY FILE VARIABLES 4340 GOSUB '37 : REM DISPLAY ENTIRE RECORD 4350 GOSUB '32 : REM DATA ENTRY FOR ENTIRE RECORD 4360 GOSUB '33 : REM CORRECTION ROUTINE 4370 GOSUB '233(1,1,F1$,0) : REM FINDNEW 4380 GOSUB '91 : REM KFAM RETURN CODE CHECK 4390 IF J0>0 THEN 4140 4400 GOSUB '42(2) : REM WRITE PRODUCT RECORD 4410 G5$(G0)="New product" 4420 GOSUB 4770 : REM WRITE AUDIT TRAIL 4430 GOTO 4140 4440 REM %CHANGE/DELETE PRODUCT INFORMATION 4450 GOSUB '232(1,1,F1$) 4460 GOSUB '91 4470 IF J0>0 THEN 4140 4480 GOSUB '52(2) : REM READ PRODUCT RECORD 4490 IF T7$=F1$ THEN 4520 4500 PRINT AT(3,0,80);HEX(07);"Record ID in key file does not match the re cord ID from the master file." 4510 GOTO 4140 4520 GOSUB '37 : REM SCREEN DISPLAY 4530 IF I9$ = "D" THEN 4590 4540 GOSUB '33 : REM CORRECTION ROUTINE 4550 DBACKSPACE #2,1S 4560 GOSUB '42(2) : REM REWRITE PRODUCT RECORD 4570 GOTO 4140 4580 REM %DELETE A RECORD 4590 Q6$=" " 4600 AND (H4$,80) : IF H4$=HEX(80) THEN Q6$="Product cannot be deleted, currently has a bill of materials." 4610 IF E<>0 THEN Q6$="Product cannot be deleted, on hand amount is not ze ro."&HEX(07) 4620 IF E3<>0 THEN Q6$="Product cannot be deleted, allocated amount is not zero."&HEX(07) 4630 IF Q6$=" " THEN 4660 4640 PRINT AT(3,0,80);Q6$;HEX(07) 4650 GOTO 4140 4660 GOSUB '100("Y,N","YyNn",1,1,"DELETE (Y OR N)",2) 4670 IF Q6$<>"Y"THEN 4140 4680 GOSUB '231(1,0,F1$) : REM DELETE RECORD 4690 GOSUB '91 4700 IF J0>0 THEN 4140 4710 G5$(G0)="Deleted product" 4720 GOSUB 4770 4730 F1$=HEX(FF) 4740 GOSUB '42(2) : REM REWRITE PRODUCT RECORD 4750 GOTO 4140 4760 REM %BUILD & WRITE AUDIT FILE DATA 4770 G2$(G0)=" " 4780 G3$(G0)=F2$ 4790 G0$(G0)="2"&F1$ : REM ALL TRANSACTION TYPES - BUILD RECORD ID 4800 G1$(G0)=I9$ 4810 G0=G0+1 4820 IF G0<4 THEN RETURN 4830 GOSUB '49(3) : REM WRITE TO AUDIT FILE 4840 G0=1 4850 G0$()=ALL(FF) 4860 Q$,Q7$=" " 4870 IF Q9 < .95 THEN RETURN 4880 GOSUB '254 4890 REM %END OF PROGRAM 4900 DEFFN'31 4910 IF G0>1 THEN GOSUB '49(3) : REM WRITE REMAINING AUDIT RECORDS 4920 LOAD TM$ 6000 REM %^SUBROUTINES 6010 REM %INITIALIZE FILE VARIABLES 6020 DEFFN'36 6030 F$,F2$,F3$,G2$,G3$,H4$,H5$,I5$=" " 6040 B5,C3,D3(1),D3(2)=0 6050 B4=1 6060 E,E0,E1,E2,E3,E4,E5,H,H0,H1,H2,H3,H4,H5,F,F1,F3=0 6070 MAT H=ZER 6080 MAT H1=ZER 6090 RETURN 6100 REM %DISPLAY ENTIRE RECORD 6110 DEFFN'37 6120 PRINT AT(5,0,) 6130 G7=0 6140 FOR I=1TO I9 6150 GOSUB '35 : REM DISPLAY EACH FIELD 6160 NEXT I 6170 RETURN 6180 REM %CORRECTION ROUTINE 6190 DEFFN'33 6200 CONVERT I9TO Q7$,(##) 6210 PRINT AT(1,0,80);"ENTER LINE NO. ( 1 -";I9;") TO CORRECT (0=NONE, -1 =EXIT)" 6220 GOSUB '100("-1",Q7$,2,0," ",1) 6230 IF Q6$ = HEX(1F) THEN GOSUB '31 6240 I=Q9 6250 IF I=-1 THEN 6330 : REM CHECK FOR VOID OPTION 6260 IF I=0 THEN RETURN : REM CHECK FOR END OF CHANGES 6270 Q7$=" " 6280 G7=G7+1 6290 GOSUB '35 6300 IF I9$="C"THEN GOSUB 4790 : REM WRITE AUDIT TRAIL 6310 GOTO 6190 6320 REM VOID OPTION 6330 RETURN CLEAR 6340 IF I9$="A" OR G7=0 THEN 4140 6350 CONVERT MIN(G7,99) TO Q6$,(##) 6360 G2$(G0)=Q6$&" Previous edits for" 6370 G3$(G0)="this product are void." 6380 GOSUB 4790 6390 GOTO 4140 6400 REM %DATA ENTRY FOR NEW PRODUCT 6410 DEFFN'32 6420 G7=1 6430 FOR I=1TO I9 6440 Q7$=" " 6450 GOSUB '35 : REM DATA ENTRY/DISPLAY ROUTINE 6460 NEXT I 6470 RETURN 6480 REM %GENERAL DATA ENTRY SUBROUTINE 6490 DEFFN'34(Q6$,Q9,G5$(G0),Q7$,Q$(1),Q$(2),Q3,Q4,Q5) 6500 IF G7>0THEN PRINT AT(1,0,80);"ENTER ";G5$(G0);Q7$ 6510 IF Q5<2 THEN GOSUB 6740 : REM RIGHT JUSTIFY NUMERICS 6520 G2$(G0)=Q6$ : REM SAVE OLD VALUE-AUDIT FILE 6530 IF Q6$>" " AND Q5=2 THEN Q5=3 : REM DEFAULT ALPHA IF NON-BLANK 6540 IF Q9<>0 AND Q5=1 THEN Q5=0 : REM DEFAULT FOR NUMERICS 6550 IF G7>0 THEN GOSUB '100(Q$(1),Q$(2),Q3,Q4," ",Q5) 6560 IF Q6$=HEX(1F) THEN GOSUB '31 6570 IF Q5<2 THEN GOSUB 6740 : REM RIGHT JUSTIFY NUMERICS 6580 G3$(G0)=Q6$ : REM SAVE NEW VALUE-ALPHA 6590 Q8=50 : REM START COLUMN - RIGHT SIDE 6600 Q2=INT(I9/2) : REM LAST FIELD ON LEFT SIDE 6610 IF I>Q2 THEN 6670 : REM RIGHT SIDE OF SCREEN? 6620 PRINT AT(I+5,0,Q8); 6630 PRINTUSING "##) ";I; 6640 B8=Q8-B6-2 6650 IF Q5<2 THEN B8=B8+C6-Q3 : REM NUMERIC? 6660 GOTO 6710 6670 PRINT AT(I+5-Q2,Q8,80-Q8); 6680 PRINTUSING "##) ";I; 6690 B8=80-B7-2 6700 IF Q5<2 THEN B8=B8+C7-Q3 : REM NUMERIC? 6710 PRINT G5$(G0);TAB(B8);Q6$ : REM PRINT LABEL, VALUE 6720 RETURN 6730 REM RIGHT JUSTIFY NUMERICS 6740 Q6$=ALL("#") 6750 Q7$=STR(Q6$,,Q3) : REM PRINTUSING MASK-ALPHA 6760 IF Q4>0THEN Q7$=Q7$&"."&STR(Q6$,,Q4) : REM ANY DIGITS AFTER DECIMAL? 6770 Q7$=Q7$&"-" 6780 Q6$=ALL(00) 6790 PRINTUSING TO Q6$,Q7$,Q9 6800 Q6$=STR(Q6$,3,LEN(Q7$)) 6810 RETURN 6820 REM BRANCH TO THE APPROPRIATE SUBROUTINE FOR EACH FIELD 6830 DEFFN'35 6840 Q$=" " 6850 ON I GOSUB 6890,6920,6950,6980,7010,7080,7110,7140,7240,7280,7310,734 0,7370,7400,7430,7460,7490,7530,7560,7590,7620,7650,7720,7750 6860 IF Q$>" "THEN 6830 6870 RETURN 6880 REM %ACCEPT, VALIDATE, AND DISPLAY FILE VARIABLES 6890 GOSUB '34(F2$,0,"DESCRIPTION"," "," ",HEX(7F),24,0,2) 6900 F2$=Q6$ 6910 RETURN 6920 GOSUB '34(G3$,0,"ALTERNATE ID"," (not used)"," ",HEX(7F),12,0,2) 6930 G3$=Q6$ 6940 RETURN 6950 GOSUB '34(I5$,0,"LOCATION CODE"," "," ",HEX(7F),6,0,2) 6960 I5$=Q6$ 6970 RETURN 6980 GOSUB '34(F$,0,"PRODUCT PREFIX"," (not used)"," ",HEX(7F),12,0,2) 6990 F$=Q6$ 7000 RETURN 7010 IF MAX(H1())>0 THEN $PACK(D=HEX(002F))Q6$FROM H1() : ELSE Q6$=" " 7020 GOSUB '34(Q6$,0,"PRICE BREAKS"," (i.e. 1/10/50/100/500)"," ",HEX(7F), 24,0,2) 7030 IF Q6$=" " THEN MAT H1=ZER : ELSE $UNPACK(D=HEX(032F))Q6$TO H1() : ERRORPRINT AT(3,0,80);"Invalid format for quantity breaks, re-enter." : Q$="E" 7040 IF MAX(H1())<1E4 THEN RETURN 7050 PRINT AT(3,0,80);"Quantity breaks may not exceed 9999.";HEX(07) 7060 Q$="E" 7070 RETURN 7080 GOSUB '34(F3$,0,"UNIT OF MEASURE"," "," ",HEX(7F),2,0,2) 7090 F3$=Q6$ 7100 RETURN 7110 GOSUB '34(H5$,0,"COUNTING CYCLE"," (for physical inventory counts)"," ",HEX(7F),1,0,2) 7120 H5$=Q6$ 7130 RETURN 7140 GOSUB '123(H0) 7150 GOSUB '34(U9$,0,"LAST ACTIVITY"," "," ",HEX(7F),8,0,2) 7160 IF Q6$=" " THEN H0=0 7170 IF G7=0 OR Q6$=" " THEN RETURN 7180 GOSUB '121(Q6$) 7190 IF U9>0THEN H0=U9 7200 IF Q6$<>"E" THEN RETURN 7210 PRINT AT(3,0,80);"Invalid date, re-enter.";HEX(07) 7220 Q$="E" 7230 RETURN 7240 GOSUB '34(G2$,0,"VENDOR ID"," "," ",HEX(7F),VAL(Q0$(4)),0,2) 7250 GOSUB '96(4) 7260 G2$=Q6$ 7270 RETURN 7280 GOSUB '34(" ",E,"ON HAND"," ","0","999999",6,0,1) 7290 E=Q9 7300 RETURN 7310 GOSUB '34(" ",E1,"ON ORDER"," ","0","999999",6,0,1) 7320 E1=Q9 7330 RETURN 7340 GOSUB '34(" ",B4,"PACK SIZE"," ","1","999999",6,0,1) 7350 B4=Q9 7360 RETURN 7370 GOSUB '34(" ",B5,"MINIMUM ORDER"," ","0","999999",6,0,1) 7380 B5=Q9 7390 RETURN 7400 GOSUB '34(" ",E4,"MINIMUM"," ","0","999999",6,0,1) 7410 E4=Q9 7420 RETURN 7430 GOSUB '34(" ",E5,"MAXIMUM"," ","0","999999",6,0,1) 7440 E5=Q9 7450 RETURN 7460 GOSUB '34(" ",F,"AVERAGE COST"," ","0","9999.99",4,2,1) 7470 F=Q9 7480 RETURN 7490 GOSUB '34(" ",F1,"LAST COST"," ","0","9999.99",4,2,1) 7500 F1=Q9 7510 RETURN 7520 REM PRICES 7530 J9=1 7540 GOSUB 7680 7550 RETURN 7560 J9=2 7570 GOSUB 7680 7580 RETURN 7590 J9=3 7600 GOSUB 7680 7610 RETURN 7620 J9=4 7630 GOSUB 7680 7640 RETURN 7650 J9=5 7660 GOSUB 7680 7670 RETURN 7680 Q7$="PRICE "&BIN(J9+48) 7690 GOSUB '34(" ",H(J9),Q7$," ","0","9999.99",4,2,1) 7700 H(J9)=Q9 7710 RETURN 7720 GOSUB '34(" ",H5,"WEIGHT"," (not used)","0","9999.9999",4,4,1) 7730 H5=Q9 7740 RETURN 7750 GOSUB '34(" ",C3,"LEAD TIME"," (not used)","0","999",3,0,1) 7760 C3=Q9 7770 RETURN 9000 REM %^VARIABLES 9010 REM B6 = LONGEST FIELD, LEFT SIDE OF SCREEN 9020 REM B7 = LONGEST FIELD, RIGHT SIDE OF SCREEN 9030 REM B8 = SCREEN COLUMN NO. - PRINT FIELD VALUE 9040 REM C6 = MAXIMUM NO. OF DIGITS LEFT OF DECIMAL, LEFT SIDE OF SCREEN 9050 REM C7 = MAXIMUM NO. OF DIGITS RIGHT OF DECIMAL, RIGHT SIDE OF SCREEN 9060 REM G7 = NUMBER OF EDITS/RECORD (0 MEANS DISPLAY ONLY) 9070 REM I9$ = TRANSACTION TYPE 9080 REM I9 = NUMBER OF SCREEN FIELDS 9100 REM $ 9998 DEFFN'29"Q$=";HEX(22);"INVT020A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D ) 9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22); "GBS/MVP - Maintain inventory master file.";HEX(22);":SELECT#15<I0$>:$OPE N#15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:S ELECTLIST005(80)";HEX(0D)