Listing of file='INVT090A' on disk='vmedia/701-2616C.wvd.zip'
# Sector 409, program filename = 'INVT090A' 0010 REM INVT090A, RELEASE 2.0, (06/01/79) 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, RECOMMENDED ORDER REPO RT 0040 REM PROGRAM FUNCTION = DISPLAY AND/OR PRINT RECOMMENDED P.O. REPORT. 0050 REM PROGRAM FUNCTION = PRINT OPTION ALSO UPDATES INVENTORY ON ORDER FIE LD 0060 REM DATE WRITTEN = 08/11/78 MK 0070 REM LAST REVISION = 08/12/79 MK 0080 REM --------------------------------------------------------------------- -- 0170 DIM A6$1 0172 DIM K$1,K1$Q0,K2$Q0,K3$17,K8$Q0,K9$30 0198 GOTO 4000 3990 REM 3996 REM *********************************** 3997 REM ! P.O. ACTIVITY FILE INQUIRY/LIST ! 3998 REM *********************************** 3999 REM 4000 SELECT @PARTS0$ 4010 K1$,Q$=" " 4020 K2$=ALL(FF) 4030 K8$=HEX(00) 4040 P1=0 4045 K=VAL(Q0$(2)) 4070 REM %REPORT OPTIONS 4080 GOSUB '100("N,Y","NnYy",1,1,"PRINT REPORT & UPDATE INVENTORY FILE (Y OR N)",2) 4090 IF Q6$=HEX(1F)THEN GOSUB '31 4100 A6$=Q6$ 4110 IF A6$="Y"THEN GOSUB '93(" ") : REM TEST PRINTER 4120 IF I0$=" "AND A6$="Y"THEN 4000 4130 GOSUB '100("A,R,I","AaRrIi",1,1,"ENTER INQUIRY TYPE (A=ALL, R=RANGE, I=INDIVIDUAL)",2) 4140 IF Q6$=HEX(1F)THEN GOSUB '31 4145 K$=Q6$ 4150 Q6$="ALL RANGE INDIVIDUAL" 4160 K3$=STR(Q6$,Q9*10-9,10) 4170 K3$=K3$&" OPTION" 4190 ON Q9GOTO ,4330,4270 4200 REM %ALL OPTION, FINDFIRST 4210 GOSUB '235(2,0) 4220 GOSUB '91 4230 IF J0<>3 THEN 4480 4240 GOSUB '254 4250 GOTO 4870 4260 REM %INDIVIDUAL OPTION 4270 GOSUB '34(HEX(08)) : REM ACQUIRE VENDOR ID 4280 IF Q6$="END"THEN 4870 4290 K1$,K2$=Q6$ 4300 GOTO 4410 4310 REM %RANGE OPTION 4320 PRINT AT(3,0,80);HEX(07);"Starting vendor ID must be lower than endin g vendor ID." 4330 GOSUB '34("STARTING") : REM ACQUIRE STARTING VENDOR 4340 IF Q6$="END" THEN 4870 4350 K1$=Q6$ 4360 GOSUB '34("ENDING") : REM ACQUIRE ENDING VENDOR 4370 IF Q6$="END"THEN Q6$=ALL(7F) 4380 K2$=Q6$ 4390 IF K2$<K1$ THEN 4320 4400 REM %PROCESS P.O. ACTIVITY FILE 4410 Q6$=STR(K1$)&ALL(00) 4420 GOSUB '232(2,0,Q6$) : REM DUMMY FINDOLD 4430 IF J0=7 THEN GOSUB '92 4440 GOSUB '237(2,0) : REM FIND NEXT 4450 IF Q$="E" THEN 4830 4460 GOSUB '91 4470 IF J0=7 THEN 4430 4480 IF J0>0 THEN 4980 4490 F1$=STR(T7$,Q0+1,K) : REM EXTRACT PRODUCT ID 4500 K9$=T7$ : REM SAVE CURRENT KEY 4510 IF STR(T7$,,Q0)>K2$THEN 4830 : REM RANGE CHECK 4520 REM %PRODUCT DETAIL PROCESSING 4530 IF STR(T7$,,Q0)<>K8$ AND K8$>HEX(00) THEN GOSUB 6490 4540 IF A6$="N" THEN 4740 : REM SCREEN INQUIRY? 4550 IF K8$>HEX(00) THEN 4600 : REM NOT FIRST TIME THROUGH? 4560 K8$=STR(T7$,,Q0) : REM STORE CURRENT VENDOR ID 4570 GOSUB '90 4580 PRINT "VENDOR ID ";K8$ 4590 L=L+1 4600 GOSUB 6100 : REM PRODUCT LOOKUP 4610 GOSUB 6680 : REM PRINT DETAIL LINE 4620 IF C6$="1" THEN 4670 : REM SKIP UPDATE IF NO PRODUCT DATA 4630 REM %REWRITE INVENTORY RECORD 4640 E1=E1+C6 4650 DBACKSPACE #2,1S 4660 GOSUB '42(2) 4670 GOSUB '238(1) 4680 REM DELETE ACTIVITY RECORD 4690 GOSUB '231(2,0,K9$) 4700 IF Q$=" "THEN 4430 4710 GOSUB '91 4720 GOTO 4980 4730 REM %SCREEN INQUIRY 4740 IF K8$>HEX(00) THEN 4790 : REM NOT FIRST TIME THROUGH? 4750 K8$=STR(T7$,,Q0) : REM STORE CURRENT VENDOR ID 4760 PRINT AT(1,0,) : REM PRINT VENDOR ID & HEADINGS 4770 PRINT AT(4,0);"VENDOR ID ";K8$;HEX(0D0A);"PRODUCT ID";TAB(K+2);"DESCR IPTION";TAB(40);"U/M";TAB(45);"REORDER";TAB(55);"BACKORDERED" 4780 A6=0 4790 GOSUB 6100 : REM PRODUCT LOOKUP 4800 GOSUB 6940 : REM DISPLAY DETAIL LINE 4810 GOTO 4430 4820 REM %END OF RANGE/END OF FILE 4830 GOSUB 6490 4840 ON POS("RI"=K$)GOTO 4330,4270 4860 REM %END OF REPORT 4870 IF A6$ ="N" THEN 4910 4880 SELECT PRINT <I0$>(132) 4890 PRINT HEX(0C) 4900 SELECT PRINT 005(80) 4910 PRINT AT(1,0,) 4920 GOSUB '100("M,R","MmRr",1,1,"ENTER R TO RESTART, M FOR MENU",2) 4930 IF Q6$="R"THEN 4000 4940 REM %END OF PROGRAM 4950 DEFFN'31 4960 LOAD TM$ 4970 REM %KFAM ERROR DETECTED 4980 Q6$="Inventory master file." 4990 IF T6=2 THEN Q6$="P.O. Activity file." 5000 PRINT AT(3,16,64);" - ";Q6$ 5010 GOSUB '254 5020 GOTO 4950 6000 REM %^SUBROUTINES 6010 REM %ACQUIRE VENDOR ID 6020 DEFFN '34(Q7$) 6030 PRINT AT(1,0,80);"ENTER ";Q7$;" VENDOR ID (OR END)" 6040 GOSUB '100(" ",HEX(7F),Q0,0," ",2) 6050 IF Q6$="end" THEN Q6$="END" 6060 IF Q6$="END"THEN RETURN 6070 GOSUB '96(4) 6080 RETURN 6090 REM %PRODUCT LOOKUP 6100 IF J0=7THEN GOSUB '92 6110 GOSUB '232(1,1,F1$) 6120 C6$,J$(3)=" " 6130 IF Q$=" " THEN 6220 6140 GOSUB '91 6150 IF J0=7 THEN 6100 6160 IF J0<>3 THEN 4980 6170 REM RECORD NOT ON FILE 6180 F2$="NOT ON INVENTORY FILE" 6190 C6$="1" 6200 RETURN 6210 REM CALCULATE REORDER QTY 6220 GOSUB '52(2) 6230 GOSUB '123(H0) 6240 IF E+E1-E3<E4 THEN 6280 6250 F2$="NOT BELOW MINIMUM" 6260 C6$="1" 6270 RETURN 6280 C6=-INT(-MAX(B5,E5-E-E1+E3)/(MAX(B4,1)))*MAX(B4,1) 6290 RETURN 6300 REM %PAGE EJECT 6310 DEFFN'90 6320 SELECT PRINT 005(80) 6330 Q6$=" " 6340 KEYIN Q6$,6350,6350 : REM OPERATOR INTERRUPT CHECK 6350 IF Q6$="P" THEN GOSUB '254 6360 IF Q6$=HEX(1F) THEN GOSUB '31 6370 SELECT PRINT <I0$>(132) 6380 IF L < L0 THEN RETURN : REM LINE COUNT CHECK 6390 P1=P1+1 6400 PRINT HEX(0C0A0E);TAB(3);N2$ : REM COMPANY NAME 6410 PRINT K3$;TAB(50);"RECOMMENDED PURCHASE ORDER REPORT";TAB(110);Q1$;TA B(122);"PAGE";P1 6420 PRINT HEX(0A) 6430 PRINT TAB(45);"RECMND ACTUAL";TAB(84);"ON";TAB(93);"ON";TAB(108);"BA CK-";TAB(118);"LAST" 6440 PRINT "PRODUCT ID";TAB(K+2);"DESCRIPTION";TAB(40);"U/M REORDER REORD ER";TAB(65);"MIN";TAB(74);"MAX";TAB(82);"HAND";TAB(90);"ORDER ALLOCATED O RDERED ACTIVITY WEIGHT" 6450 PRINT HEX(0A) 6460 L=5 6470 RETURN 6480 REM %VENDOR BREAK PROCESSING 6490 K8$=HEX(00) : REM RESET FIRST TIME THROUGH SWITCH 6500 IF A7=0 THEN 6620 : REM ANY PRODUCTS FOR THIS VENDOR? 6510 IF A6$="N" THEN 6580 : REM IS PRINT & UPDATE SWITCH "OFF" 6520 GOSUB '90 6530 PRINT HEX(0A) : REM PRINT A BLANK LINE ON REPORT 6540 SELECT PRINT 005(80) 6550 L=L+1 6560 A7=0 6570 RETURN 6580 PRINT AT(4,35,0); 6590 PRINTUSING "NO. OF PRODUCTS = #####",A7 6600 GOTO 6630 6610 REM NO ACTIVITY 6620 PRINT AT(3,0,80);HEX(07);"No activity for vendor ID ";K1$;"." 6630 GOSUB '254 6640 A6,A7=0 6650 RETURN 6660 %###,###- 6670 REM %PRINT DETAIL LINE 6680 GOSUB '90 6690 PRINT F1$;TAB(K+2);STR(F2$,,MIN(36-K,LEN(F2$))); 6700 IF C6$="1" THEN 6870 : REM SKIP LINE IF NO PRODUCT DATA 6710 PRINT TAB(41);F3$;TAB(45); 6720 PRINTUSING 6660,C6; 6730 PRINT TAB(61); 6740 PRINTUSING 6660,E4; 6750 PRINT TAB(70); 6760 PRINTUSING 6660,E5; 6770 PRINT TAB(79); 6780 PRINTUSING 6660,E; 6790 PRINT TAB(88); 6800 PRINTUSING 6660,E1; 6810 PRINT TAB(98); 6820 PRINTUSING 6660,E3; 6830 PRINT TAB(106); 6840 PRINTUSING 6660,E2; 6850 PRINT TAB(114);U9$;TAB(122); 6860 PRINTUSING "####.####",H5; 6870 PRINT 6880 PRINT HEX(0A) 6890 L=L+2 6900 A7=A7+1 6910 SELECT PRINT 005(80) 6920 RETURN 6930 REM %DISPLAY DETAIL LINE 6940 PRINT AT(A6+6,0);F1$;TAB(K+2);STR(F2$,,MIN(36-K,LEN(F2$))); 6950 IF C6$="1" THEN 6990 : REM SKIP LINE IF NO PRODUCT DATA 6960 PRINT TAB(41);F3$;TAB(45); 6970 PRINTUSING 6660,C6; 6975 PRINT TAB(59); 6980 PRINTUSING 6660,E2 6990 PRINT 7000 A6=A6+1 7010 A7=A7+1 7020 REM TEST FOR FULL SCREEN 7030 IF A6<17 THEN RETURN 7040 GOSUB '254 7050 PRINT AT(6,0,) 7060 A6=0 7070 RETURN 9000 REM %^VARIABLES 9010 REM A6$1 = SWITCH FOR HARDCOPY REPORT Y/N 9020 REM A6 = SCREEN LINE COUNT 9030 REM A7 = TOTAL PRODUCTS PER VENDOR 9040 REM C6$1 = PRODUCT NOT FOUND SWITCH " "=FOUND, "1"=NOT FOUND 9050 REM C6 = REORDER QTY 9060 REM K$1 = INQUIRY TYPE (A/R/I) 9070 REM K1$5 = STARTING VENDOR 9080 REM K2$5 = ENDING VENDOR 9090 REM K3$17 = REPORT FIELD FOR INQUIRY TYPE 9100 REM K8$5 = PREVIOUS VENDOR ID 9110 REM K9$17 = CURRENT ACTIVITY KEY SAVED FOR DELETE 9120 REM $ 9998 DEFFN'29"Q$=";HEX(22);"INVT090A";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 - Recommended purchases report.";HEX(22);":SELECT#15<I0$>:$OPEN# 15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SEL ECTLIST005(80)";HEX(0D)