10  COM D$[45]
15  COM H
20  COM A$[15]
25  COM R
30  H=0
40  REM *** REV 1.3 19-FEB-80 ***
50  REM- *** WRITTEN BY BOB ANDERSON FOR CRISIS COMPUTER CORP. 7/79 ***
60  REM ***REVISED 8/79,BA
70  REM***REVISED3/80,BA***
80  REM *** MOD ***
90  REM *** ALAN DE MARTINO ***
100  REM***REVISED 08/11/80 SYSDAT SUBROUTINE ADDED TO LIST+BACKLINE***
110  REM FILE REQUEST ADDED
115  REM***REVISED 5/21/81 =>DATE CHANGED TO PO # & PO# SEARCH ADDED, BA
120  FILES *,*,*
130  DIM S$[20],T$[20]
140  DIM M$[20]
150  DIM M1$[20]
160  DIM Y$[20],Z$[15],P$[20],U$[15],W$[15],E$[10]
170  DIM I$[7],I1$[7]
180  DIM X$[10]
190  DIM L$[5]
200  DIM Q[12],N$[7],H$[7]
210  DIM B$[8],C$[2],A1$[12]
220  REM- *** MASTER CONTROL FOR PROGRAM FUNCTIONS. ***
240  CHAIN R,"*CINV1",100
250  PRINT "PLEASE SELECT THE FUNCTION #"
260  PRINT "1-ADD NEW ITEM                 2-DELETE ITEM"
270  PRINT "3-LIST FILE                    4-SEARCH/INV#"
280  PRINT "5-SEARCH/MODEL                 6-SEARCH/MFG"
290  PRINT "7-SEARCH/PO#                   8-TOTALS"
300  PRINT "9-FILE MAINT.                 10-NEW INVENTORY FILE"
310  PRINT "           11-END OPERATION"
320  IF H=1 THEN 420
330  PRINT LIN(2)"NAME OF INVENTORY FILE :";
340  ENTER 255,X,A$
350  IF X=-256 THEN 340
360  ASSIGN A$,1,R
370  IF R=3 THEN 330
380  PRINT LIN(2)
390  PRINT "TYPE 000 TO BACK LINE 1 INSTRUCTION."
400  PRINT LIN(2)
420  PRINT 
430  PRINT "COMMAND ";
440  INPUT X
450  REM
460  GOTO 240
2960  IMAGE7A,2X,7A,2X,7A,2X,7D,2X,7D,2X,7D,2X,S3D.2D,2X,8A,2X,2A
3220  IMAGE"                           ---------          -------"
3230  IMAGE"Subtotals=",15x,9d,9x,9d
3240  IMAGE"                                    -------            ------"
3250  IMAGE"Totals=",18x,9d,9x,9d
3310  IMAGE34x,9d,11x,sdd.dd
3450  REM ***ROUTINE TO SEARCH FOR A INVENTORY #***
3460  PRINT "THIS ROUTINE WILL SEARCH FOR AND DISPLAY A INVENTORY NUMBER"
3465  H=1
3470  PRINT 
3480  PRINT "INVENTORY #,(/=MENU)";
3490  INPUT X$
3500  IF X$="/" THEN 240
3505  GOSUB 8641
3510  READ #1,2
3520  IF  END #1 THEN 3660
3530  READ #1;M$,D$,I$,C1,S1,T$,S$
3535  IF M$[1,1]="!" THEN 3520
3540  IF I$=X$ THEN 3570
3560  GOTO 3520
3570  IMAGE"MANUF    MODEL       INV#     COST     SELL      G/P    %      P.O.#    ST"
3580  IMAGE"=======  =======  =======  =======  =======  =======  =====  ========  =="
3590  G1=S1-C1
3600  P1=G1/S1*100
3610  PRINT  USING 3570
3620  PRINT  USING 3580
3630  PRINT  USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
3640  PRINT LIN(3)
3645  ASSIGN *,1,R
3650  GOTO 3460
3660  ASSIGN *,1
3665  PRINT "No find---please check input!"'7
3670  GOTO 3460
3680  REM ***SEARCH/MODEL***
3690  PRINT "THIS ROUTINE WILL SEARCH BY MODEL AND LIST."
3700  PRINT 
3705  H=1
3710  PRINT "MODEL,(/=MENU)";
3720  INPUT X$
3730  IF X$="/" THEN 240
3740  GOSUB 8641
3745  READ #1,2
3750  C3=S3=G3=P3=0
3760  PRINT  USING 3570
3770  PRINT  USING 3580
3780  IF  END #1 THEN 4120
3790  READ #1;M$,D$,I$,C1,S1,T$,S$
3795  IF M$[1,1]="!" THEN 3780
3800  LET F=LEN(X$)
3810  IF D$[1,F]=X$[1,F] THEN 3890
3830  GOTO 3780
3840  IF  END #1 THEN 4020
3850  READ #1;M$,D$,I$,C1,S1,T$,S$
3855  IF M$[1,1]="!" THEN 3840
3860  IF D$[1,F]=X$[1,F] THEN 3890
3880  GOTO 3840
3890  G1=S1-C1
3900  P1=G1/S1*100
3910  PRINT  USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
3930  IF C3#0 THEN 3990
3940  C3=C1
3950  S3=S1
3960  G3=G1
3970  P3=P1
3980  IF C3=C1 THEN 4010
3990  C3=C3+C1
4000  S3=S3+S1
4010  GOTO 3840
4020  G3=S3-C3
4030  P3=G3/S3*100
4040  PRINT  USING 3220
4050  PRINT  USING 3250;C3,G3
4060  PRINT  USING 3240
4070  PRINT  USING 3310;S3,P3
4080  PRINT 
4090  C3=S3=0
4100  PRINT "                 END OF REPORT"
4105  ASSIGN *,1
4110  GOTO 3690
4120  ASSIGN *,1
4125  PRINT "No such model...try again!"'7
4130  GOTO 3690
4140  REM****SEARCH/MFG****
4150  PRINT "THIS ROUTINE WILL SEARCH BY MFG AND PRINT"
4160  H=1
4170  PRINT 
4180  PRINT "MFG. (/=MENU)";
4190  INPUT X$
4200  IF X$="/" THEN 240
4210  L$=""
4220  PRINT "LINEPRINTER? (CR=NO)";
4230  LINPUT L$
4240  IF L$[1,1]="Y" THEN 4270
4250  Z=0
4260  GOTO 4370
4270  PURGE R,"ASCBOB"
4280  SYSTEM X,"FILE-ASCBOB,LP0"
4290  GOTO 4310
4300  PRINT "THE LP IS BUSY...BREAK IF YOU DON'T WANT TO WAIT!"
4310  ASSIGN "ASCBOB",2,R
4320  IF R=8 THEN 4350
4330  IF R=6 THEN 4300
4340  PRINT "ASSIGNMENT OF LP FAILED!!!";R
4350  Z=2
4360  PRINT "WAIT.....FILE IS BEING PRINTED!!!"
4370  REM
4380  PRINT #Z;"           ///***LISTING BY MANUFACTURER***///"
4390  PRINT #Z;LIN(3)"   Printing of ";X$
4400  D$="WDMYTPN"
4410  GOSUB 7400
4420  PRINT #Z;LIN(2);D$
4430  C3=S3=G3=P3=0
4440  GOSUB 8641
4445  READ #1,2
4450  PRINT #Z; USING 3570;LIN(2)
4460  PRINT #Z; USING 3580
4470  IF  END #1 THEN 4860
4480  READ #1;M$,D$,I$,C1,S1,T$,S$
4485  IF M$[1,1]="!" THEN 4470
4490  LET F=LEN(X$)
4500  IF X$[1,F]=M$[1,F] THEN 4580
4520  GOTO 4470
4530  IF  END #1 THEN 4720
4540  READ #1;M$,D$,I$,C1,S1,T$,S$
4545  IF M$[1,1]="!" THEN 4530
4550  IF M$[1,F]=X$[1,F] THEN 4580
4570  GOTO 4530
4580  G1=S1-C1
4590  M1$=M$
4600  P1=G1/S1*100
4610  PRINT #Z; USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
4620  J=J+1
4630  IF C3#0 THEN 4690
4640  C3=C1
4650  S3=S1
4660  G3=G1
4670  P3=P1
4680  IF C3=C1 THEN 4710
4690  C3=C3+C1
4700  S3=S3+S1
4710  GOTO 4530
4720  G3=S3-C3
4730  P3=G3/S3*100
4740  PRINT #Z; USING 3220
4750  PRINT #Z; USING 3250;C3,G3
4760  PRINT #Z; USING 3240
4770  PRINT #Z; USING 3310;S3,P3
4780  PRINT #Z
4790  C4=C3
4800  S4=S3
4810  C3=S3=0
4820  PRINT #Z;"                 END OF REPORT"
4830  PRINT #Z;'12
4840  ASSIGN *,2
4845  ASSIGN *,1
4850  GOTO 4150
4860  PRINT "NO SUCH MANUF, TRY AGAIN"
4870  ASSIGN *,2
4875  ASSIGN *,1
4880  GOTO 4150
4890  REM***FILE MAINTAINCE***
4900  PRINT "THIS ROUTINE WILL ALLOW CHANGES TO DATA IN AN INVENTORY ITEM"
4910  PRINT 
4915  H=1
4920  PRINT "INVENTORY #,(/=MENU)";
4930  INPUT X$
4940  IF X$="/" THEN 240
4945  GOSUB 8641
4950  READ #1,2
4954  C=0
4955  C=C+1
4960  IF  END #1 THEN 5610
4970  READ #1;M$,D$,I$,C1,S1,T$,S$
4980  IF I$=X$ THEN 5010
5000  GOTO 4955
5010  PRINT  USING 3570
5020  PRINT  USING 3580
5030  G3=P3=0
5040  G3=S1-C1
5050  P3=G3/S1*100
5060  PRINT  USING 2960;M$,D$,I$,C1,S1,G3,P3,T$,S$
5070  PRINT 
5080  PRINT "YOU CANNOT CHANGE G/P OR %"
5090  PRINT 
5100  PRINT "WHICH COLUMN ARE YOU GOING TO CHANGE? ";
5110  INPUT X$
5120  IF X$[1,2]="MA" THEN 5230
5130  IF X$[1,2]="MO" THEN 5270
5140  IF X$[1,1]="I" THEN 5310
5150  IF X$[1,1]="C" THEN 5350
5160  IF X$[1,2]="SE" THEN 5390
5170  IF X$[1,1]="P" THEN 5430
5180  IF X$[1,2]="ST" THEN 5470
5190  IF X$="N" THEN 4920
5200  IF X$="/" THEN 240
5210  PRINT "WRONG INPUT,CHECK SPELLING IN THE HEADING."
5220  GOTO 5100
5230  PRINT "WHAT IS THE NEW MANUF";
5240  INPUT W$
5250  M$=W$
5260  GOTO 5500
5270  PRINT "WHAT IS THE NEW MODEL";
5280  INPUT W$
5290  D$=W$
5300  GOTO 5500
5310  PRINT "WHAT IS THE NEW INV#";
5320  INPUT W$
5330  I$=W$
5340  GOTO 5500
5350  PRINT "WHAT IS THE NEW COST";
5360  INPUT W
5370  C1=W
5380  GOTO 5500
5390  PRINT "WHAT IS THE NEW SELL";
5400  INPUT W
5410  S1=W
5420  GOTO 5500
5430  PRINT "WHAT IS THE NEW P.O. #? ";
5440  INPUT W$
5450  T$=W$
5460  GOTO 5500
5470  PRINT "WHAT IS THE NEW ST";
5480  INPUT W$
5490  S$=W$
5500  REM
5510  PRINT "YOUR NEW INVENTORY ITEM LOOKS LIKE THIS:"
5520  PRINT 
5530  PRINT  USING 3570
5540  PRINT  USING 3580
5550  G1=S1-C1
5560  P1=G1/S1*100
5570  PRINT  USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
5580  PRINT LIN(3)
5581  PRINT "Any more changes to this item?  no=(cr)";
5582  X$=""
5583  LINPUT X$
5584  X$=UOS$(X$)
5585  IF X$[1,1]="Y" THEN 5100
5586  ADVANCE #1;32767,R
5587  PRINT #1;M$,D$,I$,C1,S1,T$,S$, END 
5588  READ #1,2
5589  ADVANCE #1;(C-1)*7,R
5590  UPDATE #1;"!!!"
5591  PRINT "old item marked for deletion. change in trailer."
5592  READ #1,1
5593  READ #1;N
5594  READ #1,1
5595  PRINT #1;N+1, END 
5596  ASSIGN *,1
5598  GOTO 4890
5600  GOTO 5100
5610  ASSIGN *,1
5620  GOTO 4900
5630  REM****SEARCH/PO#****
5640  PRINT "This routine will wearch by PO# and printout"
5650  H=1
5660  PRINT 
5670  PRINT "PO#   (/=MENU)";
5680  LINPUT X$
5690  IF X$="/" THEN 240
5700  L$=""
5710  PRINT "LINEPRINTER? (CR=NO)";
5720  LINPUT L$
5730  IF L$[1,1]="Y" THEN 5760
5740  Z=0
5750  GOTO 5860
5760  PURGE R,"ASCBOB"
5770  SYSTEM X,"FILE-ASCBOB,LP0"
5780  GOTO 5800
5790  PRINT "The LP is busy...Break if you don't want to wait!"
5800  ASSIGN "ASCBOB",2,R
5810  IF R=8 THEN 5840
5820  IF R=6 THEN 5790
5830  PRINT "Assignment of LP failed!!!";R
5840  Z=2
5850  PRINT "Wait....File is being printed!!!"
5860  REM
5870  PRINT #Z;"           ///***LISTING BY PURCH. ORDER #***///"
5880  PRINT #Z;LIN(3)"   Printing of ";X$
5890  D$="WDMYTPN"
5900  GOSUB 7400
5910  PRINT #Z;LIN(2);D$
5920  C3=S3=G3=P3=0
5925  GOSUB 8641
5930  READ #1,2
5940  PRINT #Z; USING 3570;LIN(2)
5950  PRINT #Z; USING 3580
5960  IF  END #1 THEN 6350
5970  READ #1;M$,D$,I$,C1,S1,T$,S$
5975  IF M$[1,1]="!" THEN 5960
5980  LET F=LEN(X$)
5990  IF X$[1,F]=T$[1,F] THEN 6070
6010  GOTO 5960
6020  IF  END #1 THEN 6210
6030  READ #1;M$,D$,I$,C1,S1,T$,S$
6035  IF M$[1,1]="!" THEN 6020
6040  IF T$[1,F]=X$[1,F] THEN 6070
6060  GOTO 6020
6070  G1=S1-C1
6080  M1$=M$
6090  P1=G1/S1*100
6100  PRINT #Z; USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
6120  IF C3#0 THEN 6180
6130  C3=C1
6140  S3=S1
6150  G3=G1
6160  P3=P1
6170  IF C3=C1 THEN 6200
6180  C3=C3+C1
6190  S3=S3+S1
6200  GOTO 6020
6210  G3=S3-C3
6220  P3=G3/S3*100
6230  PRINT #Z; USING 3220
6240  PRINT #Z; USING 3250;C3,G3
6250  PRINT #Z; USING 3240
6260  PRINT #Z; USING 3310;S3,P3
6270  PRINT #Z
6280  C4=C3
6290  S4=S3
6300  C3=S3=0
6310  PRINT #Z;"                 End of Report"
6320  PRINT #Z;'12
6330  ASSIGN *,2
6335  ASSIGN *,1
6340  GOTO 5640
6350  PRINT "No such PO#; try again."
6360  ASSIGN *,2
6365  ASSIGN *,1
6370  GOTO 5640
7120  REM***TOTALS***
7122  H=1
7125  GOSUB 8641
7130  PRINT "These are the totals for the inventory on hand."
7140  PRINT LIN(2)
7150  V=V1=C2=S2=C1=S1=0
7155  I1$="0"
7160  READ #1,2
7170  IF  END #1 THEN 7240
7180  READ #1;M$,D$,I$,C1,S1,T$,C$
7181  IF I$<I1$ THEN 7214
7182  I1$=I$
7185  IF M$[1,1]="!" THEN 7170
7190  C2=C2+C1
7200  S2=S2+S1
7210  V=V+1
7212  GOTO 7170
7213  READ #1;M$,D$,I$,C1,S1,T$,S$
7214  IF M$[1,1]="!" THEN 7213
7215  C2=C2+C1
7216  S2=S2+S1
7217  V=V+1
7218  V1=V1+1
7220  GOTO 7213
7240  PRINT "Total Items in Inventory (INCLUDING TRAILER)= ";V
7250  PRINT 
7255  PRINT "Total Items in Trailer = ";V1
7256  PRINT 
7260  PRINT "Total Cost Value of Inventory = $";C2
7270  PRINT 
7280  PRINT "Total Sell Value of Inventory = $";S2
7290  G1=S2-C2
7300  P1=G1/S2*100
7310  PRINT 
7320  PRINT "Total G/P of Inventory as Valued = $";G1
7330  PRINT 
7340  PRINT "Total G/P% of Inventory as valued = ";P1;"%"
7350  PRINT LIN(3)
7360  GOTO 240
7390  STOP 
7400  D$="WDMYTPN"
7410  D9=K=0
7420  IF LEN(D$)=0 THEN 8640
7430  T$="MDYWTPN"
7440  A1$="0123456789"
7450  H$=D$[1,7]
7460  R1=R
7470  D$=""
7480  FOR I=1 TO LEN(H$)
7490  IF K<45 THEN 7530
7500  PRINT "FORMAT EXCEEDS CAPACITY.  FORMAT TERMINATED AND"
7510  PRINT "RETURNED TO CALLING PROGRAM."
7520  GOTO 8640
7530  FOR J=1 TO 7
7540  IF H$[I,I]=T$[J,J] THEN 7590
7550  NEXT J
7560  PRINT "INVALID FORMAT CODE = ";H$[I,I];".  FORMAT TERMINATED"
7570  PRINT "AND RETURNED TO CALLING PROGRAM."
7580  GOTO 8640
7590  GOTO J OF 7610,7740,7920,7980,8080,8230,8300
7600  GOTO 7560
7610  IF D9#0 THEN 7630
7620  GOSUB 8340
7630  K=K+1
7640  RESTORE 7710
7650  FOR L=1 TO M
7660  READ M$
7670  NEXT L
7680  D$[K,K+LEN(M$)-1]=M$
7690  K=K+LEN(M$)-1
7700  GOTO 8610
7710  DATA "JANUARY","FEBRUARY","MARCH","APRIL"
7720  DATA "MAY","JUNE","JULY","AUGUST"
7730  DATA "SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"
7740  IF D9#0 THEN 7760
7750  GOSUB 8340
7760  B=D
7770  GOSUB 7820
7780  IF H$[I+1,I+1]#"Y" THEN 7810
7790  K=K+1
7800  D$[K,K]=","
7810  GOTO 8610
7820  REM TWO DIGIT NUMBER TO STRING ROUTINE
7830  K=K+1
7840  D1=INT(B/10)
7850  IF J=5 AND D1=0 THEN 7880
7860  IF D1=0 THEN 7890
7870  D$[K,K]=A1$[D1+1,D1+1]
7880  K=K+1
7890  D2=B-INT(B/10)*10
7900  D$[K,K]=A1$[D2+1,D2+1]
7910  RETURN 
7920  B=TIM(3)
7930  K=K+1
7940  D$[K,K+1]="19"
7950  K=K+1
7960  GOSUB 7820
7970  GOTO 8610
7980  K=K+1
7990  T=(TIM(2)+365*TIM(3)+INT((TIM(3)-1)/4+.01))/7
8000  T=INT(7*(T-INT(T))+1.5)
8010  RESTORE 8050
8020  FOR L=1 TO T
8030  READ M$
8040  NEXT L
8050  DATA "SUNDAY","MONDAY","TUESDAY","WEDNESDAY"
8060  DATA "THURSDAY","FRIDAY","SATURDAY"
8070  GOTO 7680
8080  K=K+1
8090  H=TIM(1)
8100  IF H <= 12 THEN 8140
8110  D$[K,K+7]="  :0  PM"
8120  H=H-12
8130  GOTO 8150
8140  D$[K,K+7]="  :0  AM"
8150  B=H
8160  K=K-1
8170  GOSUB 7820
8180  K=K+1
8190  B=TIM(0)
8200  GOSUB 7820
8210  K=K+3
8220  GOTO 8610
8230  K=K+1
8240  ENTER #P
8250  D$[K,K+5]="PORT #"
8260  K=K+5
8270  B=P
8280  GOSUB 7820
8290  GOTO 8610
8300  IF D9#0 THEN 8320
8310  GOSUB 8340
8320  R=Y*10^4+M*100+D
8330  GOTO 8630
8340  REM  COMPUTE MONTH AND DAY NUMBERS
8350  L=0
8360  D9=1
8370  Y=TIM(3)
8380  FOR S=1 TO 8
8390  IF Y=68+S*4 THEN 8420
8400  IF Y<68+S*4 THEN 8430
8410  NEXT S
8420  L=1
8430  Q[1]=31
8440  RESTORE 8490
8450  FOR S=2 TO 12
8460  READ S1
8470  Q[S]=S1+L
8480  NEXT S
8490  DATA 59,90,120,151,181,212,243,273,304,334,365
8500  D=TIM(2)
8510  FOR M=1 TO 12
8520  IF D <= Q[M] THEN 8580
8530  NEXT M
8540  Y=Y+1
8550  M=1
8560  D=D-365
8570  GOTO 8600
8580  IF M=1 THEN 8600
8590  D=D-Q[M-1]
8600  RETURN 
8610  K=K+1
8620  D$[K,K]=" "
8630  NEXT I
8640  RETURN 
8641  REM   *****assign subroutine*****
8642  ASSIGN A$,1,R
8643  IF R=0 THEN 8646
8644  PRINT "Assign error # ";R
8645  GOTO 240
8646  RETURN 
8650  END 
