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)