Listing of file='INVT110A' on disk='vmedia/701-2616C.wvd.zip'
# Sector 971, program filename = 'INVT110A' 0010 REM INVT110A, RELEASE 1-0, (06/18/79), THIS PROGRAM IS A COPYRIGHT PRODUC T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED, SALES PROJ/L.O.S. INPUT OPTIONS 0020 REM DATE WRITTEN = 8/28/78 0030 REM SYSTEM NAME = GBS/MVP INVENTORY SYSTEM 0040 REM MODULE NAME = SALES PROJECTION/LEVEL OF SERV INPUT 0050 REM MODULE FUNCTION = ENTER GROUPING KEY ,OUTPUT OPTIONS 0060 REM ************************************************** 0170 COM A6$1,A9$1,B6(3),B6$19,F6$Q0,F7$Q0,F8$Q0,I5,I6,I6$1,I8,K6 3940 REM ************************************************** 3960 REM * * * * NEXT LINE # MUST BE 4000 * * * * 3980 REM ************************************************** 3990 REM 4000 SELECT @PART S0$ 4010 SELECT PRINT 005(80),LIST 005, CO 005 4020 REM SET I8 TO LAST MONTH OF FISCAL YEAR 4030 P,I8=12 4060 REM SET I6=0 FOR SALES PROJ., =1 FOR L.O.S. 4070 IF Q6$="SALES PROJECTION REPORT" THEN I6=0 : ELSE I6=1 4080 REM ************************************************** 4090 REM ENTER DATA GROUPING 4100 PRINT AT(5,16,);"DATA GROUPING OPTIONS" 4110 PRINT HEX(0A);,"1 All products" 4120 PRINT ,"2 Range of products" 4130 PRINT ,"3 Individual products" 4140 PRINT ,"4 By vendor" 4150 PRINT ,"5 By profile ID" 4160 PRINT ,"6 By product prefix" 4170 PRINT ,"7 By stock location" 4180 GOSUB '100("1","7",1,0,"ENTER NUMBER OF DATA GROUPING OPTION",1) 4190 GOSUB 5800 4200 K6=Q9 4210 REM SET E8 TO USE IN CURSOR POSITIONING FOR DISPLAYS 4220 IF K6=1 OR K6=3 THEN E8=0 : ELSE E8=2 4230 REM DEFINE GROUP NAME AND LENGTH OF KEY 4240 DATA "ALL PRODUCTS","PRODUCT ID","INDIVIDUAL PRODUCTS","VENDOR","PROF ILE ID","PRODUCT PREFIX","STOCK LOCATION" 4250 RESTORE K6 4260 READ B6$ 4270 B6(3)=Q0 4280 IF K6<4 THEN 4540 4290 REM ------------------------------------------------------------- 4300 REM DEFINE ELEMENT #, STARTING BYTE WITHIN ELEMENT, AND KEY LENGTH 4310 Q4=VAL(Q0$(4)) : REM LENGTH OF VENDOR 4320 ON K6-4 GOTO 4390,4440,4490 4330 REM FOR VENDOR 4340 B6(1)=1 4350 B6(2)=42+Q0 4360 B6(3)=Q4 4370 GOTO 4540 4380 REM FOR PROFILE ID 4390 B6(1)=4 4400 B6(2)=217+Q0+Q4-3*62 4410 B6(3)=VAL(Q0$(7)) 4420 GOTO 4540 4430 REM FOR PREFIX 4440 B6(1)=1 4450 B6(2)=1+Q0 4460 B6(3)=12 4470 GOTO 4540 4480 REM STOCK LOCATION 4490 B6(1)=2 4500 B6(2)=54+Q0+Q4-62 4510 B6(3)=6 4520 REM ------------------------------------------------------------- 4530 REM DISPLAY GROUPING OPTION 4540 PRINT AT(5,16,);"DATA GROUPING: ";B6$ 4550 IF E8=0 THEN 4780 4560 REM ENTER START OF RANGE 4570 PRINT AT(1,0,80);"ENTER STARTING ";B6$;" (OR END)" 4580 GOSUB '100(" ",HEX(7F),B6(3),0," ",2) 4590 GOSUB 5800 4600 IF Q6$="END" OR Q6$="end" THEN 5820 4610 GOSUB 5710 4620 F6$=F7$ 4630 REM ENTER END OF RANGE 4640 PRINT AT(1,0,80);"ENTER ENDING ";B6$;" (OR END)" 4650 GOSUB '100(" ",HEX(7F),B6(3),0," ",2) 4660 GOSUB 5800 4670 F7$=ALL(7F) 4680 IF Q6$="end" OR Q6$="END" THEN 4730 4690 GOSUB 5710 4700 IF F7$>=F6$ THEN 4730 4710 PRINT AT(3,0,80);"Starting ID must be lower than Ending ID.";HEX(07) 4720 GOTO 4570 4730 PRINT AT(6,0);,"RANGE OF ";B6$;" CODES:" 4740 IF F6$=" " THEN Q7$="BEGINNING" : ELSE Q7$=F6$ 4750 IF POS(STR(F7$,1,B6(3))<>7F)=0 THEN Q6$="END" : ELSE Q6$=F7$ 4760 PRINT ," ";Q7$;" TO ";Q6$ 4770 REM ENTER REPORT TYPE 4780 Q6$="D" 4790 GOSUB '100("D,S","DdSsD ",1,1,"ENTER REPORT TYPE ('D'=DETAIL 'S'=SU MMARY)",3) 4800 GOSUB 5800 4810 A6$=Q6$ 4820 IF A6$="D" THEN F8$="DETAIL" : ELSE F8$="SUMMARY" 4830 PRINT AT(6+E8,16);"REPORT TYPE: ";F8$ 4840 REM ASK FOR TYPE OF OUTPUT 4850 IF I6=1 THEN 5000 4860 Q6$="Y" 4870 GOSUB '100("N,Y","NnYyY ",1,1,"DO YOU WISH OUTPUT IN DOLLARS (Y OR N )",3) 4880 GOSUB 5800 4890 A9$=Q6$ 4900 IF A9$="Y" THEN F8$="DOLLARS" : ELSE F8$="UNITS" 4910 PRINT AT(7+E8,16);"PRINTED AMOUNTS IN ";F8$ 4920 REM ENTER STARTING PERIOD OF PROJECTION 4930 CONVERT STR(Q1$,1,2) TO Q9 4940 CONVERT P TO Q$(2),(##) 4950 GOSUB '100("1",Q$(2),2,0,"ENTER STARTING PERIOD OF PROJECTION",0) 4960 GOSUB 5800 4970 I5=Q9 4980 PRINT AT(8+E8,16);"STARTING PERIOD OF PROJECTION =";I5 4990 REM VERIFY INFO 5000 Q6$="Y" 5010 GOSUB '100("N,Y","NnYyY ",1,1,"IS DATA OK (Y OR N)",3) 5020 GOSUB 5800 5030 IF Q6$="N" THEN 4100 5040 REM PROCESSING IF NO SORT NEEDED 5050 REM FIRST LOAD FILE OPEN SUBROUTINES AND OPEN FILES 5070 IF K6>3 AND F7$>F6$ THEN 5520 5080 GOSUB '98("Opening Files") 5090 Q=2 5100 LOAD T "KFAMOPEN"199,199 BEG 5110 5110 LOAD T "COMCLEAR"10,199BEG 5130 5120 REM OPEN INVENTORY FILE 5130 SELECT @PART S0$ 5170 GOSUB '230(1,14,1,1,S$(1),1," ",STR(M$(),4,3),STR(M$(),,3)) 5180 GOSUB '91 5190 IF J0=0 THEN 5240 5200 PRINT AT(3,LEN(J$(J0))+1);"- INVENTORY FILE" 5210 GOSUB '254 5220 GOSUB '31 5230 REM IF SALES PROJECTION, OPEN PROFILE FILE 5240 IF I6=1 THEN 5350 5280 GOSUB '230(2,14,8,1,S$(8),1," ",STR(M$(),19,3),STR(M$(),22,3)) 5290 GOSUB '91 5300 IF J0=0 THEN 5350 5310 PRINT AT(3,LEN(J$(J0))+1);"- PROFILE FILE" 5320 GOSUB '254 5330 GOSUB '31 5340 REM CLEAR KFAMOPEN AND LOAD SUBROUTINES 5350 LOAD T "COMCLEAR" 10,3999 BEG 5360 5360 Q6$="KFAMCODEINVFILE"&S0$(3)&"FINFILE"&S0$(3)&"SLSSTABVPROFILE"&S0$(1 4) 5365 I=0 5370 DEFFN'99 5390 Q4=VAL(Q0$(4)) 5400 Q7=VAL(Q0$(7)) 5410 I=I+1 5420 IF I=6 THEN 5440 5430 LOAD DC T#0,STR(Q6$,I*8-7,8)199,210 5440 LOAD DC T#0,"PRNTAVAL"3700,3742 BEG 5470 5460 REM LOAD PRINT MODULE 5470 GOSUB '98("Loading Print Module") 5480 I6$="K" 5490 Q6$=STR(M5$,,7)&"E" 5500 LOAD T Q6$ 4000 5510 REM SAVE INPUT INFORMATION BEFORE CLEARING VARIABLES 5520 I6$="S" 5530 $PACK(F=HEX(A008A001A0016001A013A00CA00CA00C60016001A00160016001)) M$ ()<50,> FROM M5$,A6$,A9$,B6(),B6$,F6$,F7$,F8$,I5,I6,I6$,I8,K6 5540 REM LOAD SORT SETUP MODULE 5550 GOSUB '98("Loading Sort Routine") 5555 Q6$=STR(M5$,1,7)&"B" 5560 COM CLEAR M5$ 5580 LOAD T Q6$ 5590 REM *************** 5600 REM * SUBROUTINES * 5610 REM *************** 5620 REM PRINT MESSAGE ON CRT FOR PROGRAM LOAD 5630 DEFFN'98(Q6$) 5640 PRINT HEX(0D030A0A0A0A0A) 5650 PRINT TAB(6);"**************************************************" 5660 PRINT TAB(6);"*";TAB(31-.5*LEN(Q6$));Q6$;TAB(55);"*" 5670 PRINT TAB(6);"**************************************************" 5680 RETURN 5690 REM CHARACTER FILL AND LEFT OR RIGHT JUSTIFY 5700 REM FOR PRODUCT # AND VENDOR 5710 F7$=Q6$ 5720 IF K6<>2 AND K6<>4 AND K6<>5 THEN RETURN 5730 IF K6=2 THEN Q9=2 5740 IF K6=4 THEN Q9=4 5750 IF K6=5 THEN Q9=7 5760 GOSUB '96(Q9) 5770 F7$=Q6$ 5780 RETURN 5790 REM TEST FOR ENTRY OF '31 AFTER '100 5800 IF Q6$<>HEX(1F) THEN RETURN 5810 REM TERMINATE ROUTINE 5820 DEFFN'31 5830 SELECT PRINT 005(80) 5840 PRINT HEX(030A);TAB(20);"** TERMINATING PROGRAM **" 5850 COM CLEAR I 5860 LOAD T M$ 5870 REM PRINT "RE-ENTER" 5880 PRINT AT(3,0,80);HEX(07);"RE-ENTER" 5890 RETURN 5900 REM ************************************************** 5910 REM * * * * * VARIABLE DESCRIPTIONS * * * * * * 5920 REM ************************************************** 5930 REM - A6$ - REPORT TYPE - DETAIL OR SUMMARY 5940 REM - A9$ - OUTPUT TYPE (U=UNITS D=DOLLARS) 5950 REM - B6$ - DATA GROUP NAME 5960 REM - B6() - FIELD #, CHAR POS. AND LENGTH OF KEY FOR SORT 5970 REM - E8 - WORK 5980 REM - F6$ - FIRST KEY IN RANGE 5990 REM - F7$ - LAST KEY IN RANGE 6000 REM - F8$ - WORK 6010 REM - I3,I4 - WORK 6020 REM - I5 - PERIOD TO START PROJECTION 6030 REM - I6 - PROGRAM NUMBER (0=PROJECTION 1=LEVEL OF SERV) 6040 REM - I6$ - "S" EXECUTE SORT, "K" OTHERWISE 6050 REM - I8 - LAST PERIOD OF FISCAL YEAR 6060 REM - K6 - NUMBER OF GROUP OPTION 6070 REM ***************************************************** 6080 DEFFN'29"Q$=";HEX(22);"INVT110A";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)