image of READY prompt

Wang2200.org

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)