image of READY prompt

Wang2200.org

Listing of file='INVT020A' on disk='vmedia/701-2616C.wvd.zip'

# Sector 166, program filename = 'INVT020A'
0010 REM INVT020A, RELEASE 2.2, (09/11/80) 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, MAINTAIN INVENTORY FIL
     E
0040 REM PROGRAM FUNCTION  =  MAINTAIN RECORDS IN THE INVENTORY MASTER FILE
0050 REM DATE WRITTEN      =  03/20/79 MK
0060 REM LAST REVISION     =  09/11/80 TM
0065 REM THIS PROGRAM WAS UPGRADED TO 2.2 BY ERRATA 1145
0070 REM ---------------------------------------------------------------------
     -
0170     DIM I9$1
0198     GOTO 4000
3996 REM *************************************
3997 REM ! INVENTORY MASTER FILE MAINTENANCE !
3998 REM *************************************
3999 REM
4000     SELECT @PARTS0$
4010     I9=24
   : REM NO. OF FIELDS
4020     B6=24
   : REM LONGEST FIELD - LEFT SIDE OF SCREEN
4030     C6=8
   : REM MAX. DIGITS LEFT OF '.' - LEFT SIDE
4040     B7=9
   : REM LONGEST FIELD - RIGHT SIDE OF SCREEN
4050     C7=6
   : REM MAX. DIGITS LEFT OF '.' - RIGHT SIDE
4060 REM CHECK AUDIT FILE SPACE
4070     LIMITS T#3,S$(3),Q6,Q7,Q8
4080     Q9 = (Q8-2)/(Q7-Q6-1)
4090     IF Q9 > .8 THEN PRINT AT(3,0);"Maintenance audit file is more than";I
     NT(Q9*100);"% full."
4100     IF Q9 < .95 THEN 4140
4110     GOSUB '254
4120     GOSUB '31
4130 REM ENTER PRODUCT ID (KEY FIELD)
4140     GOSUB '238(1)
   : REM ALWAYS RELEASE PREVIOUS RECORD
4150     GOSUB '100(" ",HEX(7F),Q0,0,"ENTER PRODUCT ID. (OR END)",2)
4160     IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31
4170     IF Q6$=" "THEN 4140
4180     GOSUB '96(2)
   : REM CONSTRUCT PRODUCT ID
4190     F1$=Q6$
4200     PRINT AT(4,0,);TAB(10);"Product ID - ";F1$
4210 REM TRANSACTION TYPE (ADD, CHANGE, DELETE)
4220     GOSUB '100("A,C,D","AaCcDdC ",1,1,"ENTER TRANSACTION TYPE (A = ADD, C
      = CHANGE, D = DELETE)",2)
4230     IF Q6$=HEX(1F) THEN GOSUB '31
4240     I9$=Q6$
4250     Q6$="Add   ChangeDelete"
4260     PRINT AT(4,0);STR(Q6$,Q9*6-5,6);
4270     IF I9$<>"A" THEN 4450
4280 REM %ADD A NEW PRODUCT
4290     GOSUB '232(1,0,F1$)
   : REM IS PRODUCT ALREADY ON FILE?
4300     IF Q$="N" THEN 4330
4310     PRINT AT(3,0,80);HEX(07);"Product ID is already in the inventory mast
     er file."
4320     GOTO 4140
4330     GOSUB '36
   : REM CLEAR INVENTORY FILE VARIABLES
4340     GOSUB '37
   : REM DISPLAY ENTIRE RECORD
4350     GOSUB '32
   : REM DATA ENTRY FOR ENTIRE RECORD
4360     GOSUB '33
   : REM CORRECTION ROUTINE
4370     GOSUB '233(1,1,F1$,0)
   : REM FINDNEW
4380     GOSUB '91
   : REM KFAM RETURN CODE CHECK
4390     IF J0>0 THEN 4140
4400     GOSUB '42(2)
   : REM WRITE PRODUCT RECORD
4410     G5$(G0)="New product"
4420     GOSUB 4770
   : REM WRITE AUDIT TRAIL
4430     GOTO 4140
4440 REM %CHANGE/DELETE PRODUCT INFORMATION
4450     GOSUB '232(1,1,F1$)
4460     GOSUB '91
4470     IF J0>0 THEN 4140
4480     GOSUB '52(2)
   : REM READ PRODUCT RECORD
4490     IF T7$=F1$ THEN 4520
4500     PRINT AT(3,0,80);HEX(07);"Record ID in key file does not match the re
     cord ID from the master file."
4510     GOTO 4140
4520     GOSUB '37
   : REM SCREEN DISPLAY
4530     IF I9$ = "D" THEN 4590
4540     GOSUB '33
   : REM CORRECTION ROUTINE
4550     DBACKSPACE #2,1S
4560     GOSUB '42(2)
   : REM REWRITE PRODUCT RECORD
4570     GOTO 4140
4580 REM %DELETE A RECORD
4590     Q6$=" "
4600     AND (H4$,80)
   : IF H4$=HEX(80) THEN Q6$="Product cannot be deleted, currently has a bill
     of materials."
4610     IF E<>0 THEN Q6$="Product cannot be deleted, on hand amount is not ze
     ro."&HEX(07)
4620     IF E3<>0 THEN Q6$="Product cannot be deleted, allocated amount is not
      zero."&HEX(07)
4630     IF Q6$=" " THEN 4660
4640     PRINT AT(3,0,80);Q6$;HEX(07)
4650     GOTO 4140
4660     GOSUB '100("Y,N","YyNn",1,1,"DELETE (Y OR N)",2)
4670     IF Q6$<>"Y"THEN 4140
4680     GOSUB '231(1,0,F1$)
   : REM DELETE RECORD
4690     GOSUB '91
4700     IF J0>0 THEN 4140
4710     G5$(G0)="Deleted product"
4720     GOSUB 4770
4730     F1$=HEX(FF)
4740     GOSUB '42(2)
   : REM REWRITE PRODUCT RECORD
4750     GOTO 4140
4760 REM %BUILD & WRITE AUDIT FILE DATA
4770     G2$(G0)=" "
4780     G3$(G0)=F2$
4790     G0$(G0)="2"&F1$
   : REM ALL TRANSACTION TYPES - BUILD RECORD ID
4800     G1$(G0)=I9$
4810     G0=G0+1
4820     IF G0<4 THEN RETURN
4830     GOSUB '49(3)
   : REM WRITE TO AUDIT FILE
4840     G0=1
4850     G0$()=ALL(FF)
4860     Q$,Q7$=" "
4870     IF Q9 < .95 THEN RETURN
4880     GOSUB '254
4890 REM %END OF PROGRAM
4900     DEFFN'31
4910     IF G0>1 THEN GOSUB '49(3)
   : REM WRITE REMAINING AUDIT RECORDS
4920     LOAD TM$
6000 REM %^SUBROUTINES
6010 REM %INITIALIZE FILE VARIABLES
6020     DEFFN'36
6030     F$,F2$,F3$,G2$,G3$,H4$,H5$,I5$=" "
6040     B5,C3,D3(1),D3(2)=0
6050     B4=1
6060     E,E0,E1,E2,E3,E4,E5,H,H0,H1,H2,H3,H4,H5,F,F1,F3=0
6070     MAT H=ZER
6080     MAT H1=ZER
6090     RETURN
6100 REM %DISPLAY ENTIRE RECORD
6110     DEFFN'37
6120     PRINT AT(5,0,)
6130     G7=0
6140     FOR I=1TO I9
6150        GOSUB '35
   : REM DISPLAY EACH FIELD
6160     NEXT I
6170     RETURN
6180 REM %CORRECTION ROUTINE
6190     DEFFN'33
6200     CONVERT I9TO Q7$,(##)
6210     PRINT AT(1,0,80);"ENTER LINE NO. ( 1 -";I9;") TO CORRECT  (0=NONE, -1
     =EXIT)"
6220     GOSUB '100("-1",Q7$,2,0," ",1)
6230     IF Q6$ = HEX(1F) THEN GOSUB '31
6240     I=Q9
6250     IF I=-1 THEN 6330
   : REM CHECK FOR VOID OPTION
6260     IF I=0 THEN RETURN
   : REM CHECK FOR END OF CHANGES
6270     Q7$=" "
6280     G7=G7+1
6290     GOSUB '35
6300     IF I9$="C"THEN GOSUB 4790
   : REM WRITE AUDIT TRAIL
6310     GOTO 6190
6320 REM VOID OPTION
6330     RETURN  CLEAR
6340     IF I9$="A" OR G7=0 THEN 4140
6350     CONVERT MIN(G7,99) TO Q6$,(##)
6360     G2$(G0)=Q6$&" Previous edits for"
6370     G3$(G0)="this product are void."
6380     GOSUB 4790
6390     GOTO 4140
6400 REM %DATA ENTRY FOR NEW PRODUCT
6410     DEFFN'32
6420     G7=1
6430     FOR I=1TO I9
6440        Q7$=" "
6450        GOSUB '35
   : REM DATA ENTRY/DISPLAY ROUTINE
6460     NEXT I
6470     RETURN
6480 REM %GENERAL DATA ENTRY SUBROUTINE
6490     DEFFN'34(Q6$,Q9,G5$(G0),Q7$,Q$(1),Q$(2),Q3,Q4,Q5)
6500     IF G7>0THEN PRINT AT(1,0,80);"ENTER ";G5$(G0);Q7$
6510     IF Q5<2 THEN GOSUB 6740
   : REM RIGHT JUSTIFY NUMERICS
6520     G2$(G0)=Q6$
   : REM SAVE OLD VALUE-AUDIT FILE
6530     IF Q6$>" " AND Q5=2 THEN Q5=3
   : REM DEFAULT ALPHA IF NON-BLANK
6540     IF Q9<>0 AND Q5=1 THEN Q5=0
   : REM DEFAULT FOR NUMERICS
6550     IF G7>0 THEN GOSUB '100(Q$(1),Q$(2),Q3,Q4," ",Q5)
6560     IF Q6$=HEX(1F) THEN GOSUB '31
6570     IF Q5<2 THEN GOSUB 6740
   : REM RIGHT JUSTIFY NUMERICS
6580     G3$(G0)=Q6$
   : REM SAVE NEW VALUE-ALPHA
6590     Q8=50
   : REM START COLUMN - RIGHT SIDE
6600     Q2=INT(I9/2)
   : REM LAST FIELD ON LEFT SIDE
6610     IF I>Q2 THEN 6670
   : REM RIGHT SIDE OF SCREEN?
6620     PRINT AT(I+5,0,Q8);
6630     PRINTUSING "##) ";I;
6640     B8=Q8-B6-2
6650     IF Q5<2 THEN B8=B8+C6-Q3
   : REM NUMERIC?
6660     GOTO 6710
6670     PRINT AT(I+5-Q2,Q8,80-Q8);
6680     PRINTUSING "##) ";I;
6690     B8=80-B7-2
6700     IF Q5<2 THEN B8=B8+C7-Q3
   : REM NUMERIC?
6710     PRINT G5$(G0);TAB(B8);Q6$
   : REM PRINT LABEL, VALUE
6720     RETURN
6730 REM RIGHT JUSTIFY NUMERICS
6740     Q6$=ALL("#")
6750     Q7$=STR(Q6$,,Q3)
   : REM PRINTUSING MASK-ALPHA
6760     IF Q4>0THEN Q7$=Q7$&"."&STR(Q6$,,Q4)
   : REM ANY DIGITS AFTER DECIMAL?
6770     Q7$=Q7$&"-"
6780     Q6$=ALL(00)
6790     PRINTUSING TO Q6$,Q7$,Q9
6800     Q6$=STR(Q6$,3,LEN(Q7$))
6810     RETURN
6820 REM BRANCH TO THE APPROPRIATE SUBROUTINE FOR EACH FIELD
6830     DEFFN'35
6840     Q$=" "
6850     ON I GOSUB 6890,6920,6950,6980,7010,7080,7110,7140,7240,7280,7310,734
     0,7370,7400,7430,7460,7490,7530,7560,7590,7620,7650,7720,7750
6860     IF Q$>" "THEN 6830
6870     RETURN
6880 REM %ACCEPT, VALIDATE, AND DISPLAY FILE VARIABLES
6890     GOSUB '34(F2$,0,"DESCRIPTION"," "," ",HEX(7F),24,0,2)
6900     F2$=Q6$
6910     RETURN
6920     GOSUB '34(G3$,0,"ALTERNATE ID"," (not used)"," ",HEX(7F),12,0,2)
6930     G3$=Q6$
6940     RETURN
6950     GOSUB '34(I5$,0,"LOCATION CODE"," "," ",HEX(7F),6,0,2)
6960     I5$=Q6$
6970     RETURN
6980     GOSUB '34(F$,0,"PRODUCT PREFIX"," (not used)"," ",HEX(7F),12,0,2)
6990     F$=Q6$
7000     RETURN
7010     IF MAX(H1())>0 THEN $PACK(D=HEX(002F))Q6$FROM H1()
   : ELSE Q6$=" "
7020     GOSUB '34(Q6$,0,"PRICE BREAKS"," (i.e. 1/10/50/100/500)"," ",HEX(7F),
     24,0,2)
7030     IF Q6$=" " THEN MAT H1=ZER
   : ELSE $UNPACK(D=HEX(032F))Q6$TO H1()
   : ERRORPRINT AT(3,0,80);"Invalid format for quantity breaks, re-enter."
   : Q$="E"
7040     IF MAX(H1())<1E4 THEN RETURN
7050     PRINT AT(3,0,80);"Quantity breaks may not exceed 9999.";HEX(07)
7060     Q$="E"
7070     RETURN
7080     GOSUB '34(F3$,0,"UNIT OF MEASURE"," "," ",HEX(7F),2,0,2)
7090     F3$=Q6$
7100     RETURN
7110     GOSUB '34(H5$,0,"COUNTING CYCLE"," (for physical inventory counts)","
      ",HEX(7F),1,0,2)
7120     H5$=Q6$
7130     RETURN
7140     GOSUB '123(H0)
7150     GOSUB '34(U9$,0,"LAST ACTIVITY"," "," ",HEX(7F),8,0,2)
7160     IF Q6$=" " THEN H0=0
7170     IF G7=0 OR Q6$=" " THEN RETURN
7180     GOSUB '121(Q6$)
7190     IF U9>0THEN H0=U9
7200     IF Q6$<>"E" THEN RETURN
7210     PRINT AT(3,0,80);"Invalid date, re-enter.";HEX(07)
7220     Q$="E"
7230     RETURN
7240     GOSUB '34(G2$,0,"VENDOR ID"," "," ",HEX(7F),VAL(Q0$(4)),0,2)
7250     GOSUB '96(4)
7260     G2$=Q6$
7270     RETURN
7280     GOSUB '34(" ",E,"ON HAND"," ","0","999999",6,0,1)
7290     E=Q9
7300     RETURN
7310     GOSUB '34(" ",E1,"ON ORDER"," ","0","999999",6,0,1)
7320     E1=Q9
7330     RETURN
7340     GOSUB '34(" ",B4,"PACK SIZE"," ","1","999999",6,0,1)
7350     B4=Q9
7360     RETURN
7370     GOSUB '34(" ",B5,"MINIMUM ORDER"," ","0","999999",6,0,1)
7380     B5=Q9
7390     RETURN
7400     GOSUB '34(" ",E4,"MINIMUM"," ","0","999999",6,0,1)
7410     E4=Q9
7420     RETURN
7430     GOSUB '34(" ",E5,"MAXIMUM"," ","0","999999",6,0,1)
7440     E5=Q9
7450     RETURN
7460     GOSUB '34(" ",F,"AVERAGE COST"," ","0","9999.99",4,2,1)
7470     F=Q9
7480     RETURN
7490     GOSUB '34(" ",F1,"LAST COST"," ","0","9999.99",4,2,1)
7500     F1=Q9
7510     RETURN
7520 REM PRICES
7530     J9=1
7540     GOSUB 7680
7550     RETURN
7560     J9=2
7570     GOSUB 7680
7580     RETURN
7590     J9=3
7600     GOSUB 7680
7610     RETURN
7620     J9=4
7630     GOSUB 7680
7640     RETURN
7650     J9=5
7660     GOSUB 7680
7670     RETURN
7680     Q7$="PRICE "&BIN(J9+48)
7690     GOSUB '34(" ",H(J9),Q7$," ","0","9999.99",4,2,1)
7700     H(J9)=Q9
7710     RETURN
7720     GOSUB '34(" ",H5,"WEIGHT"," (not used)","0","9999.9999",4,4,1)
7730     H5=Q9
7740     RETURN
7750     GOSUB '34(" ",C3,"LEAD TIME"," (not used)","0","999",3,0,1)
7760     C3=Q9
7770     RETURN
9000 REM %^VARIABLES
9010 REM    B6 = LONGEST FIELD, LEFT SIDE OF SCREEN
9020 REM    B7 = LONGEST FIELD, RIGHT SIDE OF SCREEN
9030 REM    B8 = SCREEN COLUMN NO. - PRINT FIELD VALUE
9040 REM    C6 = MAXIMUM NO. OF DIGITS LEFT OF DECIMAL, LEFT SIDE OF SCREEN
9050 REM    C7 = MAXIMUM NO. OF DIGITS RIGHT OF DECIMAL, RIGHT SIDE OF SCREEN
9060 REM    G7 = NUMBER OF EDITS/RECORD (0 MEANS DISPLAY ONLY)
9070 REM   I9$ = TRANSACTION TYPE
9080 REM    I9 = NUMBER OF SCREEN FIELDS
9100 REM $
9998 DEFFN'29"Q$=";HEX(22);"INVT020A";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 - Maintain inventory master file.";HEX(22);":SELECT#15<I0$>:$OPE
     N#15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:S
     ELECTLIST005(80)";HEX(0D)