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 M$[20],I$[20],T$[20],S$[20]
150  DIM M1$[20],D1$[20],I1$[20],T1$[20],S1$[20]
160  DIM Y$[20],Z$[15],P$[20],U$[15],W$[15],E$[10]
180  DIM X$[10]
185  DIM Q[12]
190  DIM L$[5]
200  DIM Q$[72],N$[7],H$[7]
210  DIM B$[8],C$[2],A1$[72]
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"
305  PRINT "           11-SORT BY INV #"
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  GOTO 470
430  PRINT "COMMAND ";
440  INPUT X
450  GOTO X OF 470
460  GOTO 240
470  REM- *** ROUTINE TO ADD ITEMS TO INVENTORY AND ALPHA SORT.***
475  H=1
480  GOSUB 8641
490  IF  END #1 THEN 802
502  READ #1,1
504  READ #1;N0
506  IF N0<99 THEN 512
508  PRINT N0;"items in the trailer. You must sort befor adding more."'7
510  GOTO 250
511  ASSIGN *,1
512  N0=N0+1
514  PRINT "This will be item # ";N0;"in the trailer."
520  PRINT LIN(2);"Manufacturer (7) menu=/";
530  INPUT M$
540  IF M$="/" THEN 240
550  IF M$="000" THEN 430
560  PRINT "MODEL (7)";
570  INPUT D$
580  IF D$="000" THEN 520
590  PRINT "C.C.C. INVENTORY NUMBER (7)";
600  INPUT I$
610  IF I$="000" THEN 560
620  PRINT "COST (7,NO DEC.)";
630  INPUT C1
640  IF C1=0 THEN 590
650  PRINT "SELL PRICE (7,NO DEC.)";
660  INPUT S1
670  IF S1=0 THEN 620
680  PRINT "P.O. NUMBER ";
690  INPUT T$
700  IF T$="000" THEN 650
710  PRINT "STATUS (2)"
720  PRINT "N=NEW"
730  PRINT "D=DEMO"
740  PRINT "B=BROKEN"
750  PRINT "U=USED"
760  PRINT "C=CUSTOMER OWNED"
770  INPUT S$
780  IF S$="000" THEN 680
782  GOSUB 8641
785  READ #1,2
789  IF  END #1 THEN 793
790  READ #1;M1$,D1$,I1$,C2,S2,T1$,S1$
791  IF I$=I1$ THEN 798
792  GOTO 790
793  PRINT #1;M$,D$,I$,C1,S1,T$,S$, END 
794  READ #1,1
795  PRINT #1;N0, END 
796  ASSIGN *,1
797  GOTO 470
798  PRINT "Inv # ";I$;" is in use. Pick a new number please. "'7
799  ASSIGN *,1
800  GOTO 470
802  N0=0
804  GOTO 506
810  STOP 
815  REM***SORT ROUTINE***
817  H=1
820  PRINT LIN(2)"COMMENCE SORT."
822  GOSUB 8641
823  READ #1,1
824  READ #1;N5
825  READ #1,2
827  PRINT "* find trailer *";
830  IF  END #1 THEN 867
832  N1=1
835  I1$=""
840  READ #1;M$,D$,I$,C1,S1,T$,S$
845  I1$=I$
850  READ #1;M$,D$,I$,C1,S1,T$,S$
852  N1=N1+1
855  IF I$<I1$ THEN 870
860  I1$=I$
865  GOTO 850
867  PRINT "No items in trailer."
868  GOTO 240
870  PRINT "* sort to INVSCR *";
872  IF M$[1,1]="!" THEN 850
874  PURGE R,"INVSCR"
878  CREATE R,"INVSCR",100
882  ASSIGN "INVSCR",2,R
886  IF  END #2 THEN 1014
890  READ #2,1;N
894  IF  END #2 THEN 1006
898  READ #2,N+2
902  IF N#0 THEN 914
906  R=2
910  GOTO 958
914  F=2
918  L=N+1
922  R=INT((F+L)/2)
926  READ #2,R;P$,U$,W$,E,A,B$,C$
930  IF I$<W$ THEN 970
934  IF I$>W$ THEN 982
942  FOR I=N+1 TO R STEP -1
946  READ #2,I;P$,U$,W$,E,A,B$,C$
950  PRINT #2,I+1;P$,U$,W$,E,A,B$,C$
954  NEXT I
958  PRINT #2,R;M$,D$,I$,C1,S1,T$,S$
962  PRINT #2,1;N+1
966  GOTO 1022
970  L=R
974  IF F#L THEN 922
978  GOTO 942
982  F=R
986  IF L-F>1 THEN 922
990  R=R+1
994  IF L-F#1 THEN 942
998  F=F+1
1002  GOTO 922
1006  PRINT "FILE FULL"
1010  GOTO 240
1014  N=0
1018  GOTO 898
1022  IF  END #1 THEN 1035
1026  READ #1;M$,D$,I$,C1,S1,T$,S$
1027  IF M$[1,1]="!" THEN 1022
1028  N1=N1+1
1030  GOTO 886
1035  READ #1,1
1036  READ #1;N
1037  IF N#N5 THEN 1330
1039  PRINT "* Create iscr2 *";
1040  A1$="CAT-"
1045  A1$[LEN(A1$)+1]=A$
1050  SYSTEM Q$,A1$
1055  CONVERT Q$[12,15] TO N2
1060  PURGE R,"ISCR2"
1065  CREATE X,"ISCR2",N2+10
1070  ASSIGN "ISCR2",3,R
1071  N3=0
1072  IF R=0 THEN 1075
1073  PRINT "ASSIGN ERROR # ";R
1074  GOTO 240
1075  READ #1,2
1080  READ #3,2
1085  IF  END #2 THEN 1185
1090  IF  END #1 THEN 1220
1095  J=2
1100  READ #2,J;M1$,D1$,I1$,C2,S2,T1$,S1$
1105  IF M1$[1,1]#"!" THEN 1120
1107  J=J+1
1110  GOTO 1100
1120  READ #1;M$,D$,I$,C1,S1,T$,S$
1122  IF  END #1 THEN 1200
1125  IF M$[1,3]#"!!!" THEN 1135
1130  GOTO 1120
1135  IF I$>I1$ THEN 1150
1140  PRINT #3;M$,D$,I$,C1,S1,T$,S$, END 
1142  N3=N3+1
1145  GOTO 1120
1150  PRINT #3;M1$,D1$,I1$,C2,S2,T1$,S1$, END 
1152  N3=N3+1
1155  J=J+1
1160  READ #2,J;M1$,D1$,I1$,C2,S2,T1$,S1$
1165  IF I1$[1,3]#"!!!" THEN 1180
1170  J=J+1
1175  GOTO 1160
1180  GOTO 1135
1185  READ #1;M$,D$,I$,C1,S1,T$,S$
1190  IF I$[1,3]#"!!!" THEN 1200
1195  GOTO 1185
1200  IF  END #1 THEN 1255
1205  PRINT #3;M$,D$,I$,C1,S1,T$,S$, END 
1210  GOTO 1185
1215  IF  END #2 THEN 1255
1220  PRINT #3;M1$,D1$,I1$,C2,S2,T1$,S1$, END 
1222  N3=N3+1
1225  J=J+1
1230  READ #2,J;M1$,D1$,I1$,C2,S2,T1$,S1$
1235  IF M1$[1,3]#"!!!" THEN 1250
1240  J=J+1
1245  GOTO 1230
1250  GOTO 1220
1255  PRINT "* end of merge *";
1257  N3=N3+1
1260  PRINT "* move to master *";
1265  IF  END #1 THEN 1320
1270  IF  END #3 THEN 1300
1272  I1$="0"
1275  READ #1,2
1280  READ #3,2
1282  N4=0
1285  READ #3;M$,D$,I$,C1,S1,T$,S$
1287  IF I$ <= I1$ THEN 1300
1288  PRINT #1;M$,D$,I$,C1,S1,T$,S$, END 
1289  N4=N4+1
1290  I1$=I$
1295  GOTO 1285
1300  READ #1,1
1301  A=0
1302  PRINT #1;A
1303  PRINT " * move completed ** sort completed!! *"
1304  ASSIGN *,1
1305  ASSIGN *,2
1306  ASSIGN *,3
1307  PURGE R,"INVSCR"
1308  PURGE R,"ISCR2"
1309  GOTO 240
1310  PRINT "No sort possible: No items in trailer."
1315  GOTO 240
1320  PRINT "Fatal error: Reload from tape."
1325  GOTO 240
1330  PRINT "ERROR: trailer count does not equal sorted INVSCR. "
1332  GOTO 240
1340  PRINT "ERROR"'7": Starting count does not equal ending count."
1342  GOTO 240
2090  REM- *** ROUTINE TO DELETE AN INVENTORY ITEM ***
2100  PRINT "THIS ROUTINE WILL DELETE A RECORD"
2105  H=1
2110  PRINT 
2120  PRINT "INPUT MANUFACTURER,(/=MENU)";
2130  INPUT Y$
2140  IF Y$="/" THEN 240
2150  PRINT "INPUT INVENTORY # ";
2160  INPUT Z$
2170  IF Z$="000" THEN 2120
2175  GOSUB 8641
2180  IF  END #1 THEN 2225
2185  READ #1,2
2190  C=G=0
2195  C=C+1
2200  READ #1;M$,D$,I$,C1,S1,T$,S$
2210  IF M$#Y$ THEN 2220
2215  IF I$=Z$ THEN 2235
2220  GOTO 2195
2225  PRINT "No such record. Please check input."
2230  GOTO 2090
2235  IMAGE"MANUF    MODEL       INV#     COST     SELL      G/P    %      P.O.#    ST"
2237  PRINT  USING 2235
2240  PRINT  USING 3580
2245  G1=S1-C1
2250  P1=G1/S1*100
2255  PRINT  USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
2260  PRINT LIN(2);"Delete?";
2265  INPUT Q$
2270  IF Q$="n" THEN 2090
2272  PRINT "PAST BRANCH"
2275  READ #1,2
2276  PRINT "PASTREAD"
2280  ADVANCE #1;(C-1)*7,R
2282  PRINT "PASTADVANCE"
2285  UPDATE #1;"!!!"
2286  PRINT "PAST UPDATE"
2287  ASSIGN *,1
2290  PRINT LIN(2)"Delete marked!"
2295  GOTO 2100
2560  REM***FULL LIST PRINTOUT***
2561  H=1
2565  PRINT "Do you want the output on the lineprinter?";
2570  LINPUT L$
2575  IF L$[1,1]="/" THEN 240
2580  IF L$[1,1]="Y" THEN 2610
2590  Z=0
2600  GOTO 2710
2610  PURGE R,"ASCBOB"
2620  SYSTEM X,"FILE-ASCBOB,LP0"
2630  GOTO 2650
2640  PRINT "THE LP IS BUSY... BREAK IF YOU DON'T WANT TO WAIT!"
2650  ASSIGN "ASCBOB",2,R
2660  IF R=8 THEN 2690
2670  IF R=6 THEN 2640
2680  PRINT "ASSIGNMENT OF LP FAILED!!";R
2690  Z=2
2700  PRINT "WAIT....FILE IS BEING PRINTED!!"
2710  REM- *** ROUTINE TO LIST INVENTORY ***
2720  PRINT #Z;"                  *****************************"
2730  PRINT #Z;"                  *    CRISIS COMPUTER CORP   *"
2740  PRINT #Z;"                  *         INVENTORY         *"
2750  PRINT #Z;"                  *          ON-HAND          *"
2760  PRINT #Z;"                  *****************************"
2770  PRINT #Z
2780  PRINT #Z;"FILE BEING LISTED IS  ";A$
2790  PRINT #Z;LIN(3)
2800  D$="WDMYTPN"
2810  GOSUB 7400
2820  PRINT #Z;D$
2830  PRINT #Z;LIN(3)
2850  PRINT #Z; USING 3570
2860  PRINT #Z; USING 3580
2870  PRINT #Z
2880  M1$=""
2890  C2=S2=C3=S3=0
2895  GOSUB 8641
2897  READ #1,2
2900  IF  END #1 THEN 3180
2910  READ #1;M$,D$,I$,C1,S1,T$,S$
2915  IF M$[1,1]="!" THEN 2900
2920  IF M1$="" THEN 2940
2930  IF M1$#M$ THEN 3050
2940  G1=S1-C1
2950  P1=G1/S1*100
2960  IMAGE 7A,2X,7A,2X,7A,2X,7D,2X,7D,2X,7D,2X,S3D.2D,2X,8A,2X,2A
2970  PRINT #Z; USING 2960;M$,D$,I$,C1,S1,G1,P1,T$,S$
2980  M1$=M$
2990  C2=C2+C1
3000  S2=S2+S1
3010  C3=C3+C1
3020  S3=S3+S1
3030  K=K+1
3040  GOTO 2900
3050  G3=S3-C3
3060  PRINT #Z; USING 3220
3070  PRINT #Z; USING 3230;C3,G3
3080  P3=G3/S3*100
3090  PRINT #Z; USING 3240
3100  PRINT #Z; USING 3310;S3,P3
3110  PRINT #Z;'12
3120  S3=C3=0
3130  IF M1$="*" THEN 3200
3140  PRINT #Z; USING 3570
3150  PRINT #Z; USING 3580
3160  PRINT #Z
3170  GOTO 2940
3180  M1$="*"
3190  GOTO 3050
3200  PRINT #Z;LIN(2)
3210  G2=S2-C2
3220  IMAGE"                           ---------          -------"
3230  IMAGE"SUBTOTALS=",15X,9D,9X,9D
3240  IMAGE"                                    -------            ------"
3250  IMAGE"TOTALS=",18X,9D,9X,9D
3260  PRINT #Z; USING 3220
3270  PRINT #Z; USING 3250;C2,G2
3280  IF G2=0 THEN 3350
3290  P2=G2/S2*100
3300  PRINT #Z; USING 3240
3310  IMAGE34X,9D,11X,SDD.DD
3320  PRINT #Z; USING 3310;S2,P2
3330  PRINT #Z;LIN(2)
3340  PRINT #Z;"STATUS = N-NEW,D-DEMO,B-BROKEN,U-USED,C-CUST.OWNED"
3350  PRINT #Z;"                   END OF REPORT"
3360  PRINT #Z
3370  H=1
3375  ASSIGN *,1
3380  IF L$[1,1]#"Y" THEN 3440
3390  PRINT #Z;'12'12
3400  ASSIGN *,2,R
3410  PURGE R,"ASCBOB"
3420  IF R=0 THEN 3440
3430  PRINT "ASCII FILE 'ASCBOB' NOT PURGED.  ";R
3440  GOTO 240
3570  IMAGE"MANUF    MODEL       INV#     COST     SELL      G/P    %      P.O.#    ST"
3580  IMAGE"=======  =======  =======  =======  =======  =======  =====  ========  =="
7399  REM   *****time/date subroutine*****
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  ******subroutines*****
8642  ASSIGN A$,1,R
8643  IF R=0 THEN 8646
8644  PRINT "Assign error # ";R
8645  GOTO 240
8646  RETURN 
8650  END 
