Listing of file='INVT110E' on disk='vmedia/701-2616C.wvd.zip'
# Sector 860, program filename = 'INVT110E'
0010 REM INVT110E, RELEASE 1-0, (06/15/79), THIS PROGRAM IS A COPYRIGHT PRODUC
T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
SALES PROJ/L.O.S. EXECUTION
0020 REM DATE WRITTEN = 8/28/78
0030 REM SYSTEM NAME = GBS/MVP INVENTORY SYSTEM
0040 REM PROGRAM NAME = SALES PROJ/ LEVEL OF SERVICE
0050 REM PROGRAM FUNCTION = MAKES + PRINTS SALES PROJECTIONS
0060 REM - OR LEVEL OF SERVICE CALCULATIONS
0140 REM **************************************************
0170 DIM B8$24,B9$24,D6(13),D8(13),E6(13),E8(13),E9$10,F9$1,P$(12)3,K5$(50
)4
0172 REM FOLLOWING USED IN PROJECTION ROUTINE ONLY
0174 DIM D6$4,D6$(3)8,D7$6,D7$(39)15,K9$4
0175 REM FOLLOWING USED ONLY IN SAFETY FACTOR CALCULATIONS
0176 DIM C6$4,C6$(21)2,C7$(21)1,P7$(1)2
3970 REM **************************************************
3980 REM * * * START POINT FOR READING SORTWORK FILE * * *
3985 REM * * * NEXT EXECUTABLE LINE # MUST BE 4000 * * *
3990 REM **************************************************
3995 REM
4000 GOSUB 6575
4005 IF I6$="K" THEN 4250
4020 DATA LOAD DC OPEN T#4,S$(4)
4030 LIMITS T#1,S$(1),B6,E8,E8
4035 DATA LOAD DC OPEN T #1,S$(1)
4040 DATA LOAD DC #4,K5$()
4045 REM TEST IF NO RECORDS IN SORT
4050 IF END THEN B8=0
: ELSE B8=1
4055 GOSUB '90
4060 IF B8=0 THEN GOSUB '31
4065 REM GET NEXT INVENTORY RECORD WITH SORT WORKFILE
4070 IF B8<51 THEN 4095
4075 B8=1
4080 DATA LOAD DC #4,K5$()
4085 IF END THEN K5$()=ALL(FF)
4090 REM TEST IF END OF FILE REACHED
4095 IF STR(K5$(B8),1,1)<>HEX(FF) THEN 4120
4100 GOSUB 4555
4105 GOSUB 4615
4110 GOSUB '31
4115 REM SKIP TO RECORD POSITION TO DO DC READ
4120 B7=VAL(K5$(B8),2)-B6
4125 IF B7=0 THEN 4135
4130 DSKIP #1,B7S
4135 GOSUB '78(1)
4140 F8$=STR(M$(B6(1)),B6(2),B6(3))
4145 DBACKSPACE #1,(B7+1)S
4150 REM TEST IF FIRST RECORD - PRINT HEADING
4155 IF F9$="1" THEN 4180
4160 F6$=F8$
4165 GOSUB 4950
4170 GOTO 4205
4175 REM TEST IF NEW KEY
4180 IF F6$=F8$ THEN 4205
4185 GOSUB 4555
4190 F6$=F8$
4195 GOSUB 4950
4200 REM CALL ROUTINE FOR SALES PROJ OR LEVEL OF SERVICE
4205 MAT D6=ZER
4210 ON I6+1 GOSUB 6270,5420
4215 F9$="1"
4220 B8=B8+1
4225 GOTO 4070
4230 REM **************************************************
4235 REM * * * START POINT WHEN BYPASSING SORT * * * * *
4240 REM **************************************************
4245 REM
4250 GOSUB '90
4255 IF K6>3 THEN 4350
4260 ON K6 GOTO 4350,4295
4265 REM ASK FOR INDIVIDUAL
4270 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER PRODUCT ID (OR END)",2)
4275 IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end" THEN 4505
4280 GOSUB '96(2)
4285 F6$=Q6$
4290 REM FIND INDIVIDUAL OR LOWER LIMIT OF RANGE
4295 GOSUB '232(1,0,F6$)
4300 IF K6=3 THEN 4310
4305 IF Q$="N" THEN 4445
4310 GOSUB '91
4315 IF J0=0 THEN 4390
4320 PRINT AT(3,LEN(J$(J0))+1);"- PRODUCT ID ";F6$
4325 IF J0=3 THEN 4270
4330 IF J0<>7 THEN 6555
4335 GOSUB '92
4340 GOTO 4295
4345 REM FIND FIRST RECORD FOR "ALL" OR SINGLE KEY
4350 GOSUB '235(1,0)
4355 IF Q$=" " THEN 4390
4360 GOSUB '91
4365 PRINT AT(3,LEN(J$(J0))+1);"- INVENTORY FILE"
4370 IF J0<>7 THEN 6555
4375 GOSUB '92
4380 GOTO 4350
4385 REM GET RECORD
4390 GOSUB '78(1)
4395 REM SET WORK KEY IF PROCESSING SINGLE KEY
4400 IF K6<4 THEN 4420
4405 F8$=STR(M$(B6(1)),B6(2),B6(3))
4410 REM TEST IF RIGHT KEY
4415 IF F8$<>F6$ THEN 4445
4420 MAT D6=ZER
4425 ON I6+1 GOSUB 6270,5420
4430 F9$="1"
4435 IF K6=3 THEN 4270
4440 REM FIND NEXT ROUTINE
4445 GOSUB '237(1,0)
4450 IF Q$=" " THEN 4495
4455 IF Q$="E" THEN 4505
4460 GOSUB '91
4465 IF J0<>7 THEN 4480
4470 GOSUB '92
4475 GOTO 4445
4480 PRINT AT(3,LEN(J$(J0))+1);"- INVENTORY FILE"
4485 GOTO 6555
4490 REM TEST IF END OF RANGE
4495 IF K6<>2 THEN 4390
4500 IF T7$<=F7$ THEN 4390
4505 GOSUB 4555
4510 GOSUB '31
4515 REM **************************************************
4520 REM * * * * * SUBROUTINES * * * * * * *
4525 REM **************************************************
4530 % ##########
4535 DEFFNL(Z)=ROUND((100*E6(Z)/(E6(Z)+E6(1+Z)),2)
4540 DEFFNR(Z)=ROUND((Z,0)
4545 REM --------------------------------------
4550 REM PRINT SUBTOTALS
4555 MAT E6=D8
4560 MAT E8=E8+D8
4565 MAT D8=ZER
4570 B8$="TOTALS"
4575 B9$=" "
4580 IF I6=0 THEN 4630
4585 IF I6$="K" THEN 4630
4590 B8$=F6$
4595 STR(B8$,LEN(B8$)+2)="TOTALS"
4600 GOTO 4630
4605 REM --------------------------------------
4610 REM PRINT GRAND TOTAL FOR OPTIONS 4-7
4615 B8$="GRAND TOTALS"
4620 B9$=" "
4625 MAT E6=E8
4630 GOSUB '90
4635 PRINT HEX(0A)
4640 L=L+1
4645 IF F9$="1" THEN 4675
4650 PRINT " NO PRODUCTS IN GROUP"
4655 L=L+1
4660 RETURN
4665 REM TEST IF SCALING REQUIRED FOR TOTALS
4670 REM FIRST FIND MAXIMUM
4675 IF I6=1 THEN 4755
4680 I4=E6(1)
4685 FOR I3=1 TO 12
4690 IF E6(I3)<=I4 THEN 4700
4695 I4=E6(I3)
4700 NEXT I3
4705 REM IF MAX TOO BIG, CALC POWER OF TEN FOR SCALE
4710 IF I4<99999999 THEN 4755
4715 I4=INT(LOG(I4+1)/LOG(10))-7
4720 REM SET SCALING LABEL
4725 B9$="SCALED BY 1"
4730 INIT(30)Q6$
4735 STR(B9$,12)=STR(Q6$,1,I4)
4740 MAT E6=(10^(-I4))*E6
4745 REM --------------------------------------
4750 REM PRINT SALES ROUTINE
4755 GOSUB '90
4760 IF I6=0 THEN 4825
4765 IF A6$="S" THEN 4780
4770 PRINT TAB(5);B8$;TAB(19);B9$;TAB(I2-1);
4775 GOTO 4790
4780 PRINT B8$;TAB(I2-1);
4785 REM CALCULATE AND PRINT FIGURES
4790 I3,I4=0
4795 IF E6(1)+E6(2)>0 THEN I3=FNL(1)
4800 IF E6(3)+E6(4)>0 THEN I4=FNL(3)
4805 PRINTUSING "-#####,###,### -#####,###,### -###.## -#####,###,### -#
####,###,### -###.##",E6(1),E6(2),I3,FNR(E6(3)),FNR(E6(4)),I4
4810 L=L+1
4815 RETURN
4820 REM --------------------------------------
4825 PRINT B8$;TAB(12);
4830 REM PRINT SALES, CALC CUMULATIVES AND YEAR END
4835 Q9,I4=0
4840 FOR I3=1 TO 13
4845 IF I3=I2 THEN 4880
4850 I4=I4+1
4855 E8=E6(I4)
4860 Q9=Q9+E8
4865 E6(I4)=Q9
4870 PRINTUSING " ########",FNR(E8);
4875 GOTO 4885
4880 PRINTUSING 4530,FNR(E6(13)+Q9);
4885 NEXT I3
4890 PRINT
4895 PRINT " ";B9$;
4900 REM PRINT QUARTERLY CUMULATIVE SALES (FROM START PROJ)
4905 FOR I3=3 TO 12 STEP 3
4910 PRINT TAB(1+I3*9+5.5*(SGN(I3-I2+.5)+1));
4915 PRINTUSING 4530,FNR(E6(I3));
4920 NEXT I3
4925 PRINT
4930 L=L+2
4935 RETURN
4940 REM --------------------------------------
4945 REM PRINT GROUP NAME
4950 IF A6$="S" AND I6=1 THEN RETURN
4960 GOSUB '90
4965 PRINT HEX(0A);TAB(5*(1-K6));"*** ";B6$;" ";F8$;" ***"
4970 PRINT HEX(0A)
4975 L=L+3
4980 RETURN
4985 REM --------------------------------------
4990 REM PROCESSING AFTER SALES PROJ OR L.O.S. CALCS.
4995 MAT D8=D8+D6
5000 IF A6$="D" THEN 5010
5005 RETURN
5010 B8$=F1$
5015 B9$=F2$
5020 MAT E6=D6
5025 GOSUB 4755
5030 RETURN
5035 REM --------------------------------------
5040 REM PAGE EJECT
5045 DEFFN'90
5050 SELECT PRINT 005(80)
5055 REM PAPER CHANGE CHECK
5060 Q6$=" "
5065 KEYIN Q6$,5070,5070
5070 IF Q6$="P" THEN GOSUB '254
5075 IF Q6$=HEX(1F) THEN GOSUB '31
5080 REM LINE COUNT CHECK
5090 SELECT PRINT <I0$>(132)
5095 IF L <= L0-3 THEN RETURN
5100 P1 = P1 + 1
5105 PRINT HEX(0D0C0A0E);TAB(3);N2$
: REM PRINT COMPANY NAME
5110 REM PRINT FIRST LINE OF HEADING
5115 IF I6=0 THEN 5130
5120 PRINT TAB(55);"LEVEL OF SERVICE REPORT";
5125 GOTO 5150
5130 Q6$="DOLLARS"
5135 IF A9$="Y" THEN 5145
5140 Q6$="UNITS"
5145 PRINT "FIGURES IN ";Q6$;TAB(55);"SALES PROJECTION REPORT";
5150 PRINT TAB(109);Q1$;" PAGE";P1
5155 L=3
5160 REM TEST IF GROUP DESCRIPTION NEEDED
5165 IF P1>1 THEN 5240
5170 PRINT HEX(0A);"DATA GROUPING: ";B6$;" ";
5175 IF (K6-1)*(K6-3)=0 THEN 5205
5180 IF F6$=" " THEN PRINT "BEGINNING";
: ELSE PRINT F6$;
5185 IF F7$=F6$ THEN 5205
5190 Q6$=F7$
5195 IF POS(STR(F7$,1,B6(3))<>7F)=0 THEN Q6$="END"
5200 PRINT " TO ";Q6$;
5205 PRINT
5210 L=L+2
5215 IF I6$="K" THEN 5240
5220 IF B8>0 THEN 5240
5225 PRINT HEX(0A)
5230 GOSUB 4650
5235 RETURN
5240 IF I6=0 THEN 5300
5245 REM LEVEL OF SERVICE HEADING
5250 PRINT HEX(0A);TAB(I2+3);"YEAR TO DATE UNIT SALES: LEVEL OF
YEAR TO DATE $ SALES: LEVEL OF"
5255 IF A6$="S" THEN 5265
5260 PRINT TAB(5);"PRODUCT ID DESCRIPTION";
5265 PRINT TAB(I2+9);"MADE LOST SERVICE MADE
LOST SERVICE"
5270 PRINT HEX(0A)
5275 L=L+4
5280 RETURN
5285 REM --------------------------------------
5290 REM PRINT HEADING FOR SALES PROJECTION
5295 REM CALC COLUMN FOR JAN
5300 I4=1+SGN(I5-1)*(13-I5)
5305 REM CALC YEAR IN JAN
5310 Q6$=STR(Q1$,7,2)
5315 IF K5+I5=2 THEN 5330
5320 CONVERT STR(Q1$,7,2) TO I3
5325 CONVERT I3+1 TO Q6$,(##)
5330 IF A6$="S" THEN 5340
5335 PRINT HEX(0A);"PRODUCT ID";
5340 PRINT TAB(I4*9+8+5.5*(SGN(I4-I2+.5)+1));"19";Q6$
5345 REM PRINT MONTH ABBREVIATIONS
5350 PRINT "DESCRIPTION ";
5355 FOR I3=1 TO 13
5360 IF I3<>I2 THEN 5370
5365 PRINT " TOTAL";
5370 IF I3=13 THEN 5380
5375 PRINT " ";P$(I3);
5380 NEXT I3
5385 PRINT
5390 PRINT " QUARTERLY CUMULATIVE TOTALS"
5395 PRINT HEX(0A)
5400 L=L+5
5405 RETURN
5410 REM --------------------------------------
5415 REM DO CALCULATIONS FOR LEVEL OF SERVICE
5420 D6(1)=H+H2
5425 D6(2)=D3(1)+D3(2)
5430 D6(3)=H1+H4
5435 IF D6(1)*D6(3)<=0 THEN 5460
5440 REM IF DATA NONZERO, CALC EFFECTIVE PRICE
5445 I4=D6(3)/D6(1)
5450 GOTO 5470
5455 REM IF NO DATA, AVERAGE PRICES 1,2,AND 3
5460 IF H(1)>0 THEN I4=H(1)
: ELSE I4=0
5465 REM CALC LOST $ SALES FROM EFFECTIVE PRICE
5470 D6(4)=I4*D6(2)
5475 GOSUB 4995
5480 RETURN
5485 REM -----------------------------------------------------
5490 REM SUBROUTINE
5495 DEFFN'173
5500 B$=" "
5505 IF K9=0 THEN 5760
5510 REM TEST IF LEVEL OF SERVICE LEGAL
5515 IF INT(-C5)=-1 THEN 5530
5520 B$="A"
5525 REM ESTABLISH K-FACTOR
5530 GOSUB 6085
5535 REM INITIALIZE MISC. PARAMS.
5540 INIT(00) D6$(),D7$()
5545 CONVERT STR(K9$,1,2) TO F7
5550 D8,F9=F7
5555 D6=D
5560 REM TEST IF DEMAND ZERO
5565 IF D>0 THEN 5590
5570 D6,D7,D9=0
5575 B$="D"
5580 RETURN
5585 REM ADJUST TREND %
5590 D7=D1
5595 E7=D*D7
5600 IF A4$="F" THEN 5610
5605 D7,E7=0
5610 IF I9=0 THEN 5630
5615 GOSUB 5815
5620 REM START MONTHLY CYCLE
5625 REM CALCULATE SALES,INVENT., BUY (FOR CURRENT PERIOD)
5630 A6=B(F7)*D6*(1+D7*.5)
5635 A7=A6+C8*D6*SQR(B(F7))
5640 A8=A7-F6
5645 IF A8>0 THEN 5660
5650 A8=0
5655 REM ACTUAL ENDING INVENTORY = PREVIOUS+BUY-SALES
5660 F6=F6+A8-A6
5665 REM SAVE SALES, REQUIRED INVENTORY, BUY
5670 $PACK(F=D7$) D7$(F9-D8+1) FROM A6,A7,A8
5675 REM UPDATE DD
5680 IF D7>0 THEN 5695
5685 D6=D6*(1+D7)
5690 GOTO 5700
5695 D6=D6+E7
5700 IF F7<>P2 THEN 5725
5705 REM END OF YEAR PROCESSING
5710 GOSUB 5775
5715 $PACK(F=D6$) D6$(-INT(-F9/P)) FROM D6,D9
5720 REM UPDATE MONTH IN YEAR, TOTAL MONTH COUNTERS
5725 F7=F7+1
5730 F9=F9+1
5735 IF F7<=P THEN 5745
5740 F7=1
5745 IF F9<D8+K9 THEN 5630
5750 REM END OF PROJECTION
5755 GOSUB 5775
5760 RETURN
5765 REM --------------------------------------
5770 REM CALCULATE YEARLY TREND %
5775 D9=0
5780 IF F8=0 THEN 5790
5785 D9=(D6-F8)/F8
5790 F8=D6
5795 RETURN
5800 REM --------------------------------------
5805 REM SUBROUTINE TO DETERMINE EFFECTIVE TREND %
5810 REM SEPARATE CALCULATION WHEN FCST. PERIOD = 1
5815 IF K9>1 THEN 5845
5820 IF B(F7)=0 THEN 6055
5825 D7=2*(I9/(D*B(F7))-1)
5830 GOTO 6040
5835 REM A6,A7,A8,A9,D9 ARE WORK VARIABLES
5840 REM DETERMINE SIGN OF TREND
5845 D7,E7,A7,A8=0
5850 FOR A6=D8 TO D8+K9-1
5855 D9=A6-INT((A6-1)/P)*P
5860 A7=A7+B(D9)
5865 A8=A8+B(D9)*(A6-D8)
5870 NEXT A6
5875 REM NOTE A7 IS B' OF DERIVATION, A8 IS B"
5880 REM AND (B'*D-I9) IS CONSTANT IN QUADRATIC
5885 IF A7*D>I9 THEN 5940
5890 REM POSITIVE TREND (NO COMPOUNDING)
5895 REM SEE DOCUMENTATION FOR DERIVATION OF FORMULA
5900 IF A8=0 THEN 6055
5905 D7=(-A7*.5-A8+SQR(A7*A7*.25+A8*A8-A7*A8+2*A8*I9/D))/A8
5910 REM MONTHLY INCREMENT
5915 E7=D*D7
5920 RETURN
5925 REM NEGATIVE TREND (COMPOUNDED)
5930 REM USE NEWTON'S METHOD TO FIND TREND
5935 REM TEST IF TARGET <= SALES PROJ. FOR TREND OF <=-1
5940 IF I9<=D*.5*B(F7) THEN 6055
5945 REM INITIAL ESTIMATE OF TREND IS 0
5950 REM SET VALUES FOR FIRST PERIOD OF ITERATION
5955 A7=B(D8)
5960 A8=0
5965 A9=1
5970 REM DO SUMMATIONS FOR PERIODS 2 THROUTH K9
5975 FOR A6=D8+1 TO D8+K9-1
5980 D9=A6-P*INT((A6-1)/P)
5985 A8=A8+B(D9)*A9*(A6-D8)
5990 A9=A9*(1+D7)
5995 A7=A7+B(D9)*A9
6000 NEXT A6
6005 REM CALC. DERIVATIVE OF TOTAL SALES WITH RESPECT TO TREND
6010 A8=D*((1+.5*D7)*A8+.5*A7)
6015 IF A8=0 THEN 6055
6020 REM (CHANGE IN TREND)=(SALES-TARGET)/SLOPE
6025 A7=(D*(1+.5*D7)*A7-I9)/A8
6030 D7=D7-A7
6035 IF ABS(A7)>=.001 THEN 5955
6040 IF D7<=-1 THEN 6055
6045 RETURN
6050 REM COMPUTATIONAL ERROR RETURN
6055 D7=D1
6060 B$="C"
6065 RETURN
6070 REM --------------------------------------
6075 REM - SAFETY FACTOR CALC. (MODIFIED SLIGHTLY FROM ORIG)
6080 REM CALCULATE DESIRED FREQUENCY OF A STOCK OUT
6085 IF D0*D=0 THEN 6145
6090 C8=C5
6095 IF INT(-C8)=-1 THEN 6105
6100 C8=.95
6105 C8=D/D0*(1-C8)
6110 REM IF FREQUENCY > .5 NO SAFETY STOCK IS NEEDED
6115 IF C8>=.5 THEN 6145
6120 PACK(.####) C6$ FROM C8
6125 MAT SEARCH C6$(),>STR(C6$,1,2) TO P7$() STEP 2
6130 C9=.5*VAL(STR(P7$(1),2))+.5
6135 REM BRANCK IF OK
6140 IF C9>1 THEN 6160
6145 C8=0
6150 RETURN
6155 REM GET CO-ORDINATES FOR INTERPOLATION
6160 UNPACK(.####)C6$(C9-1) TO D6
6165 UNPACK(.####)C6$(C9) TO D8
6170 UNPACK(#.#) C7$(C9-1) TO D7
6175 UNPACK(#.#) C7$(C9) TO D9
6180 REM INTERPOLATE SAFETY STOCK FACTOR
6185 C8=((D9-D7)/(D8-D6)*(C8-D6)+D7)*(D0/D)
6190 RETURN
6195 REM --------------------------------------
6200 REM INITIALIZATION ROUTINE
6205 DEFFN'172
6210 A4$="F"
6215 C5=.95
6220 D1=0
6225 I9=0
6230 P=12
6235 P2=I8
6240 D6$=HEX(51055303)
6245 D7$=HEX(510551055105)
6250 RETURN
6255 REM --------------------------------------
6260 REM PROCESSING FOR SALES PROJECTION
6265 REM FIND AND GET PROFILE IF NOT IN MEMORY
6270 IF E9$=G1$ THEN 6355
6275 GOSUB '232(2,0,G1$)
6280 IF Q$=" " THEN 6340
6285 IF Q$="N" THEN 6315
6290 GOSUB '91
6295 PRINT AT(3,LEN(J$(J0))+1);"- PROFILE ID ";G1$
6300 IF J0<>7 THEN 6555
6305 GOSUB '92
6310 GOTO 6270
6315 GOSUB '90
6320 L=L+1
6325 PRINT F1$;" PROFILE ";G1$;" NOT FOUND"
6330 RETURN
6335 REM GET PROFILE
6340 GOSUB '79(8)
6345 E9$=G1$
6350 REM SET TREND LIMIT AND TREND TYPE ACCORDING TO SALES STAB
6355 Q9=1
6360 IF I1$="L" THEN 6380
6365 Q9=2
6370 IF I1$="M" THEN 6380
6375 Q9=3
6380 A4$=STR(D4$(),Q9,1)
6385 REM SET SAF FACT TO ZERO SO K-FACT NOT CALCULATED
6390 REM SET START OF YR DEMAND=0 TO SKIP YRLY. TREND CALCS.
6395 D0,F8=0
6400 REM CALL PROJECTION ROUTINE
6405 GOSUB '173
6410 REM UNPACK SALES DATA TO BE PRINTED
6415 FOR I3=I7 TO I7+11
6420 $UNPACK(F=D7$) D7$(I3) TO D6(I3-I7+1)
6425 NEXT I3
6430 REM TEST IF MORE DATA NEEDED FOR FISCAL YEAR TOTAL
6435 IF K2=0 THEN 6465
6440 FOR I3=K1 TO K1+K2-1
6445 $UNPACK(F=D7$) D7$(I3) TO I4
6450 D6(13)=D6(13)+I4
6455 NEXT I3
6460 REM SET Q9 TO YTD UNIT SALES
6465 Q9=H2
6470 IF A9$="N" THEN 6530
6475 REM USE PAST SALES TO EST. PRICE IF ENOUGH DATA
6480 IF H+H2<10 THEN 6500
6485 I4=(H1+H4)/(H+H2)
6490 GOTO 6510
6495 REM IF NOT ENOUGH DATA, AVERAGE PRICES 1,2,AND 3
6500 IF H(1)>0 THEN I4=H(1)
: ELSE I4=0
6505 REM MULTIPLY UNIT SALES BY PRICE
6510 MAT D6=(I4)*D6
6515 REM SET Q9 TO YTD $ SALES
6520 Q9=H4
6525 REM ADD YTD UNIT OR DOLLAR TO YTD TOTAL, COMPLETE CALCS
6530 D6(13)=D6(13)+Q9*K3
6535 GOSUB 4995
6540 RETURN
6545 REM --------------------------------------
6550 REM TERMINATE FOR KFAM OR SORT WORKFILE ERROR
6555 PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED"
6560 GOSUB '254
6565 REM --------------------------------------
6570 REM STARTUP ROUTINE
6575 SELECT @PART S0$
6580 REM GIVE SCREEN DISPLAY
6585 SELECT PRINT 005(80),LIST 005,CO 005
6590 IF I6=0 THEN Q6$="SALES PROJECTION REPORT"
: ELSE Q6$="LEVEL OF SERVICE REPORT"
6595 PRINT HEX(03);AT(0,40-.5*LEN(Q6$));Q6$
6600 GOSUB '93(" ")
6605 IF I0$=" " THEN GOSUB '31
6610 IF K6<>3 THEN PRINT AT(10,33,0);"PRINTING REPORT"
6615 REM SET VALUES OF VARIOUS PARAMETERS
6620 F9$="0"
6625 P1=0
6630 L=L0+5
6635 MAT D8=ZER
6640 MAT E8=ZER
6645 I2=48
6650 IF A6$="D" THEN 6660
6655 I2=22
6660 IF I6=1 THEN RETURN
6665 REM READ MONTH NAMES, PUTTING IN P$() IN PRINT ORDER
6670 Q6$="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
6675 MAT REDIM P$(1)36
6680 P$(1)=STR(Q6$,I5*3-2)
6685 IF I5=1 THEN 6695
6690 STR(P$(1),40-I5*3)=Q6$
6695 MAT REDIM P$(12)3
6700 REM CALL PROJECTION INITIALIZATION ROUTINE
6705 GOSUB '172
6710 STR(K9$,1,2)=STR(Q1$,1,2)
6715 CONVERT STR(K9$,1,2) TO K5
6720 REM CALC FIRST PERIOD OF PROJECTION TO PRINT
6725 I7=1+I5-K5-6*(SGN(I5-K5+.5)-1)
6730 REM CALC LENGTH OF PROJECTION
6735 K9=I7+11
6740 K1,K3=1
6745 K2=I7-1
6750 REM CALC COLUMN FOR FISCAL YEAR TOTALS ON PAGE
6755 I2=2+I8-I5-6*(SGN(I8-I5+.5)-1)
6760 IF I2<13 THEN 6785
6765 REM SPEC CASES WHERE 1ST PROJ PER = 1ST PER FISCAL YEAR
6770 K2,K3=0
6775 RETURN
6780 REM TEST IF LAST PER FISCAL YEAR OCCURS BETWEEN K5 AND I5
6785 IF I7=1 THEN RETURN
6790 FOR I3=K5 TO K5+I7-1
6795 IF I3-12*INT((I3-1)/12)<>I8 THEN 6815
6800 K1=I3-K5+2
6805 K2=I7-K1
6810 K3=0
6815 NEXT I3
6820 RETURN
6825 REM --------------------------------------
6830 REM TERMINATE ROUTINE
6835 DEFFN'31
6845 SELECT PRINT 005(80)
6850 PRINT HEX(030A);TAB(20);"** TERMINATING PROGRAM **"
6855 Q=2
6860 LOAD T "KFAMOPEN" 10,6835 BEG 6865
6865 LOAD T "COMCLEAR"10,199 BEG 6870
6870 SELECT @PART S0$
6875 IF I6$="S" THEN 6895
6880 GOSUB '239(1)
6885 GOTO 6905
6895 GOSUB '219(S$(1),1,S2," ",0)
6900 GOSUB '219(S$(4),4,S2," ",0)
6905 IF I6=0 THEN GOSUB '239(2)
6910 COM CLEAR I
6915 LOAD T M$
6920 REM **************************************************
6925 REM * * * * * VARIABLE DESCRIPTIONS * * * * * *
6930 REM **************************************************
6935 REM - A6$ - REPORT TYPE - DETAIL OR SUMMARY
6940 REM - B6$ - DATA GROUP NAME
6945 REM - B8 - REFERENCE TO POINTER IN SORTWORK RECORDS
6950 REM - B8$ - TOTALS NAME
6955 REM - D6() - PRODUCT SALES (1-12) / YTD SALES (13)
6960 REM - FOR L.O.S, YTDMADE, YTDLOST, $MADE, $LOST
6965 REM - D8() - GROUP ACCUM FOR D6()
6970 REM - E6() - WORK ARRAY TO PRINT DATA
6975 REM - E8 - WORK
6980 REM - E8() - GRAND TOTAL ACCUM FOR D8()
6985 REM - E9$ - NAME OF LAST PROFILE READ
6990 REM - F6$ - FIRST KEY IN RANGE
6995 REM - F7$ - LAST KEY IN RANGE
7000 REM - F8$ - NEXT KEY IN RANGE
7005 REM - F9$ - FLAG IF A KEY FOUND
7010 REM - I2 - FOR PROJ, COL FOR YTD TOTALS
7015 REM - I2 - FOR L.O.S, COLUMN TO PRINT DATA
7020 REM - I3,I4 - WORK
7025 REM - I5 - FIRST PERIOD OF PROJECTION
7030 REM - I6 - 0 FOR SALES PROJECTION, 1 FOR LEVEL OF SERV.
7035 REM - I6$ - "S" IF SORT RUN, "K" OTHERWISE
7040 REM - I7 - FIRST PERIOD IN PROJECTION W/OUTPUT DATA
7045 REM - I8 - LAST PERIOD IN FISCAL YEAR
7050 REM - K1 - 1ST PER TO INCLUDE IN ACCUM OF FISCAL TOTAL
7055 REM - K2 - # PROJ PERIODS TO INCL IN FISCAL TOTAL
7060 REM - K3 - FLAG (0 OR 1) TO INCLUDE YTD IN TOTAL
7065 REM - K5 - CURRENT PERIOD NUMBER
7070 REM - K6 - NUMBER OF GROUP OPTION
7075 REM - 1=ALL, 2=RANGE, 3=INDIV., 4=VENDOR,
7080 REM - 5=PROFILE ID, 6=PREFIX, 7=STOCK LOC
7085 REM - P$() - MONTH ABBREVIATIONS
7090 REM *****************************************************
7095 REM ***** PROJECTION VARIABLE DESCRIPTIONS *******
7100 REM *****************************************************
7105 REM OUTPUT VARIABLES
7110 REM B$,D6,D7,D6$(),D7$(),D9
7115 REM INPUT VARIABLES
7120 REM A4$,B(),B0,B1,C3,C5,D,D0,D1,F8,I9,K9,K9$,P,P2
7125 REM INTERNAL VARIABLES
7130 REM A6,A7,A8,A9,C8,C6$(),C7$(),C9,D6,D6$,D7,D7$,D8,D9,E7,E9,F6,F7,F9
7135 REM *****************************************************
7140 DEFFN'29"Q$=";HEX(22);"INVT110E";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)