home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / BF / BF015.ZIP / CPABAR.BAS next >
BASIC Source File  |  1988-06-22  |  12KB  |  604 lines
  1. common cpafile$
  2.  
  3.  UpperCase:
  4.    def fnucase$(cpafile$)
  5.       length=len(cpafile$)
  6.  
  7.       if length =0 then
  8.          exit def
  9.       end if
  10.  
  11.       for I=1 to length
  12.          ch=asc(mid$(cpafile$,I,1))
  13.  
  14.             if ch > 96 and ch < 127 then
  15.             mid$(cpafile$,I,1)=chr$(ch-32)
  16.          end if
  17.    
  18.         next
  19.  
  20.         fnucase$=cpafile$
  21.  
  22.    end def
  23.  
  24. REM **** CPABAR ****
  25.     CLOSE
  26.     CLS
  27.     print "                         GENERATE BAR CHART"
  28.     print
  29.    DEFSNG A-Z:DEFINT E,L,I,J
  30.    DIM X$(12)
  31.  
  32.     FOR I=1 TO 12
  33.         READ X$(I)
  34.     NEXT I
  35.  
  36.    DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  37.    DIM T$(100),EF(500),ES(500),LF(500),LC(500),D$(500),A(1500),A3(100)
  38.     B4=VAL(MID$(DATE$,1,2))
  39.     B5=VAL(MID$(DATE$,4,2))
  40.     B6=VAL(MID$(DATE$,9,2))
  41.     DEF FNV(I)=INT((I-1)*Q+1.5)
  42.     T1$=" EACH COLUMN WILL REPRESENT ###.## \            \ "
  43.  
  44.      GOSUB GetFile                 '1770
  45.  
  46.     GOSUB SortFileRead                '2320 READ LGS FILE
  47.  
  48.     GOSUB HolidayRead                '2210 READ HOLIDAYS
  49.  
  50.     GOSUB FigureDays                '1910 FIGURE DAYS
  51.  
  52. Starting:
  53. 190 INPUT "Output to <F>ile, <S>creen, or <P>rinter (F/S/P)";O$
  54.  
  55.     IF O$="F" OR O$="f" then 
  56.         GOTO ToFile             '230
  57.     end if
  58.  
  59.      IF O$="S" OR O$="s" THEN
  60.         OPEN "SCRN:" FOR OUTPUT AS #2
  61.         GOTO ToScrnOrPrt        '260
  62.      end if
  63.  
  64.      IF O$="P" OR O$="p" THEN
  65.         OPEN "LPT1:" FOR OUTPUT AS #2
  66.         GOTO ToScrnOrPrt        '260
  67.      end if
  68.  
  69.      IF O$<>"F" OR O$<>"f" OR O$<>"S" OR O$<>"s" OR O$<>"P" OR O$<>"p" THEN
  70.         goto starting                 '190
  71.      end if
  72.  
  73. ToFile:
  74. 230 PRINT "Output file will be ";F$;".BAR O.K. (Y/N) ";
  75.      INPUT Q$
  76.  
  77.      IF Q$="N" or Q$="n" THEN
  78.         INPUT "Enter new name ";F$
  79.       ELSEif Q$<>"N" or Q$<>"n" then
  80.         F$=F$+".BAR"
  81.     end if
  82.  
  83.     OPEN F$ FOR OUTPUT AS #2
  84.  
  85. ToScrnOrPrt:
  86. 260 PRINT "**** PROJECT LENGTH IS";C3;T6$;". ****"
  87.      INPUT "Enter width for the chart. ENTER defaults to 40 : ",L
  88.  
  89.      IF L<=0 OR L>95 THEN
  90.         L=40
  91.         ELSE L=INT(L)
  92.      end if
  93.  
  94.      IF LEFT$(T6$,3)<>"WOR" AND LEFT$(T6$,3)<>"CAL" THEN
  95.         PRINT "**** BAR CHARTS ONLY WORK ON PROJECTS WITH CALENDAR OR WORKING DAYS ****"
  96.         GOTO DoneBar              '560
  97.      end if
  98.      INPUT "Want Whole project or Portion (W/P) ",W$
  99.      V5=0  'FLAG FOR WHETHER ALL ACTIVITIES ARE INCLUDED IN THE PORTION
  100.      Q=C3/L  'PROJECT LENGTH DIVIDED BY WIDTH
  101.  
  102.      IF LEFT$(W$,1)="P" OR LEFT$(w$,1)="p" THEN
  103.         PRINT "****";
  104.         PRINT USING T1$;Q,T6$;
  105.         PRINT "****"
  106.      else
  107.         GOTO Header                '970
  108.      end if
  109.  
  110. AllOrPart:
  111. 320 INPUT "Will several portions be placed together (Y/N/Help) ",Q$
  112.  
  113.      IF LEFT$(Q$,1)="N" or left$(Q$,1)="n" THEN
  114.         goto BeginDate             '390
  115.      end if
  116.  
  117.      IF LEFT$(Q$,1)="H" or left$(Q$,1)="h" THEN
  118.        PRINT:PRINT;"If you want to put several portions together, reply 'Y'. PCPM will space"
  119.        PRINT "activities within each portion so the activities which extend from one portion "
  120.        PRINT "to another will be in alignment when the barcharts are placed side by side."
  121.        PRINT "If you reply 'N', then only those activities that appear within"
  122.        print "the time period you specify are shown."
  123.        print
  124.        GOTO AllOrPart                        '320
  125.      end if
  126.  
  127.      v5=1     'case yes
  128.  
  129. BeginDate:
  130. 390 IF T7=0 THEN
  131.         INPUT "Enter beginning date in MMDDYY format ",A7
  132.         ELSE goto BeginTime                  '420
  133.      end if
  134.  
  135.      GOSUB DatePointer      '1700 FIND VALID DATE AND ARRAY A NUMBER
  136.  
  137.      D5=J
  138.      GOTO EndDate                           '440
  139.  
  140. BeginTime:
  141. 420 INPUT "Enter beginning time period number (integer) ",D5
  142.      IF D5<=0 OR D5>C3 THEN
  143.         BEEP
  144.         PRINT "**** INVALID RESPONSE ****"
  145.         GOTO BeginTime                         '420
  146.      end if
  147.  
  148. EndDate:
  149. 440 PRINT "Enter ending date (MMDDYY) or length in ";T6$;" ";
  150.      INPUT A7
  151.  
  152.      IF A7<10000 THEN
  153.         D7=A7
  154.         D6=D5+D7
  155.         GOTO DoneTime           '490
  156.      end if
  157.  
  158.      GOSUB DatePointer         '1700
  159.  
  160.      D6=J
  161.  
  162. DoneTime:
  163. 490 IF D6<=D5 THEN
  164.         goto BeginDate           '390
  165.         ELSE Q=(D6-D5)/L
  166.      end if
  167.  
  168.      PRINT "****";:PRINT USING T1$;Q,T6$;:PRINT "****":GOTO Header  '970
  169.  
  170. 510 PRINT #2,G9$
  171.     PRINT #2,TAB(36);
  172.      GOSUB 840
  173.  
  174.      if O$="P" or O$="p" then
  175.         print #2, chr$(12)
  176.      end if
  177.  
  178.      INPUT "Want another Bar Chart from the same run (N/Y) ",Q$
  179.  
  180.      IF LEFT$(Q$,1)="Y" OR LEFT$(Q$,1)="y" THEN
  181.         CLOSE#2
  182.         GOTO Starting                           '190
  183.      end if
  184.  
  185. DoneBar:
  186. 560 CLOSE #2
  187.      chain "CPAMENU"
  188.  
  189. 580 REM
  190.  
  191.     FOR I=1 TO L+1
  192.         A6=A(FNV(I)+D5-1)
  193.         GOSUB 920
  194.         T$(I)=P6$
  195.      NEXT I
  196.  
  197.      S7=LEN(T$(1))
  198.  
  199.     FOR I=2 TO L+1
  200.         IF LEN(T$(I))>S7 THEN
  201.             S7=LEN(T$(I))
  202.         end if
  203.      NEXT I
  204.  
  205.      I=S7
  206.  
  207.     FOR J=1 TO L+1
  208.  
  209. 700   I1=LEN(T$(J))
  210.         IF I-I1=0 THEN
  211.             goto 740
  212.         end if
  213.         T$(J)=" "+T$(J)
  214.         GOTO 700
  215.  
  216. 740 NEXT J
  217.  
  218.     FOR J=1 TO I
  219.         PRINT #2,TAB(36);MID$(T$(1),J,1);
  220.         FOR K=2 TO L+1
  221.             PRINT #2,MID$(T$(K),J,1);
  222.         NEXT K
  223.         PRINT #2,G9$
  224.      NEXT J
  225.  
  226.     REM **** PRINTING HEADINGS AND DASHES ****
  227.      PRINT #2," ACT    DESCRIPTION                ";
  228.  
  229. 840 T2$=""
  230.  
  231.     FOR K=1 TO L+1
  232.         T2$=T2$+"="
  233.      NEXT
  234.  
  235.     PRINT #2,T2$
  236.     PRINT #2,G9$
  237.      RETURN
  238.  
  239.     REM **** CONVERT TO MONTH DAY YEAR IN STRING FORMAT ****
  240.  
  241. 920 P6$=STR$(A6)
  242.  
  243.      IF LEN(P6$)=6 THEN
  244.         P6$=" "+P6$
  245.      end if
  246.  
  247.     U9=VAL(LEFT$(P6$,3))
  248.     P6$=X$(U9)+RIGHT$(P6$,4)
  249.      RETURN
  250.  
  251. Header:
  252. 970 T4=INT((L+3)/2)
  253.     PRINT #2,G8$
  254.     PRINT #2,TAB(T4);"CRITICAL PATH ANALYSIS: BAR CHART"
  255.      PRINT #2,G9$
  256.      T4=INT((L+8)/2)
  257.      PRINT #2,G9$
  258.      PRINT #2,TAB(T4+10);"LEGEND"
  259.      PRINT #2,TAB(T4);"==========================="
  260.      PRINT #2,TAB(T4);"==   CRITICAL PATH = #   =="
  261.      PRINT #2,TAB(T4);"== ACTIVITY DURATION = * =="
  262.      PRINT #2,TAB(T4);"==     FLOAT TIME = -    =="
  263.      PRINT #2,TAB(T4);"== FINISHED ACTIVITY = C =="
  264.      PRINT #2,TAB(T4);"==   CONTINUATIONS = < > =="
  265.      PRINT #2,TAB(T4);"==========================="
  266.      PRINT #2,G9$
  267.      P4$="PROJECT NAME : "+P$
  268.      T4=INT((L+15-LEN(P4$))/2)
  269.      PRINT #2,TAB(T4);P4$;"    RUN DATE: ";X$(B4);B5;"19";RIGHT$(STR$(B6),2)
  270.      PRINT #2,G9$
  271.       PRINT #2,G9$
  272.  
  273.       IF LEFT$(W$,1)<>"P" or left$(W$,1) <> "p" THEN
  274.         goto 1210
  275.         ELSE PRINT #2,TAB(20);"REQUESTED WIDTH =";
  276.       end if
  277.  
  278.      PRINT #2,L;" REQUESTED DAYS = ";D6-D5;
  279.      T4=64
  280.       GOTO 1220
  281.  
  282. 1210 T4=INT((L+27-LEN(T6$))/2)
  283.  
  284. 1220 PRINT #2,TAB(T4);"TIME PERIOD = ";T6$;
  285.      PRINT #2, USING " * ###.##";Q
  286.       PRINT #2,G9$
  287.  
  288.       IF LEFT$(W$,1)="P" or left$(W$,1)="p" THEN
  289.         goto 1270
  290.         ELSE D5=1
  291.       end if
  292.  
  293.       D6=D5+C3
  294.  
  295. 1270 GOSUB 580
  296.  
  297.      K5=0
  298.      A$="*"
  299.      B$="-"
  300.      PRINT #2,G9$
  301.       PRINT " **** FORMING BAR CHART ****"
  302.  
  303.      FOR I=1 TO N
  304.         W=I
  305.         IF V5=1 THEN
  306.             goto 1380
  307.         end if
  308.  
  309.         IF ES(W)+1>D6 THEN
  310.             goto 1680
  311.         end if
  312.  
  313.         IF LF(W)+1<D5 AND EF(W)+1<D5 THEN
  314.             goto 1680
  315.         end if
  316.  
  317. 1380  IF EF(W)=LF(W) THEN
  318.             A$="#"
  319.             ELSE A$="*"
  320.         end if
  321.  
  322.         IF LC(W)=1 THEN
  323.             A$="C"
  324.         end if
  325.  
  326.         IF V5=1 THEN
  327.             goto 1420
  328.         end if
  329.  
  330.         IF A$="C" AND EF(W)+1<D5 THEN
  331.             goto 1680
  332.         end if
  333.  
  334. 1420  IF V5=1 AND D6<ES(W)+1 THEN
  335.             goto 1640
  336.         end if
  337.  
  338.         IF D5>=ES(W)+1 THEN
  339.             A=D5
  340.             ELSE A=ES(W)+1
  341.         end if
  342.  
  343.         IF D6<=LF(W)+1 THEN
  344.             C=D6
  345.             ELSE C=LF(W)+1
  346.         end if
  347.  
  348.         IF D5>=EF(W)+1 THEN
  349.             B=D5
  350.             ELSE goto 1470
  351.         end if
  352.  
  353.         IF D5>=EF(W)+1 THEN
  354.             goto 1480
  355.         end if
  356.  
  357. 1470  IF D6<=EF(W)+1 THEN
  358.             B=D6
  359.             ELSE B=EF(W)+1
  360.         end if
  361.  
  362. 1480  A=INT((A-D5)/Q)+5
  363.         C=INT((C-D5)/Q)+5
  364.         B=INT((B-D5)/Q)+5
  365.         PRINT #2,LEFT$(D$(W),32);TAB(A+30);
  366.  
  367.         IF D5>ES(W)+1 OR D5>EF(W)+1 THEN
  368.             PRINT #2,"<";
  369.             ELSE PRINT #2," ";
  370.         end if
  371.  
  372.         IF D5>=EF(W)+1 THEN
  373.             B=B-1
  374.             ELSE goto 1550
  375.         end if
  376.  
  377.         IF V5=1 AND A$="C" AND EF(W)+1<D5 THEN
  378.             goto 1670
  379.             ELSE goto 1600
  380.         end if
  381.  
  382. 1550  FOR J=A TO B
  383.             PRINT #2,A$;
  384.         NEXT J
  385.  
  386.         IF A$="C" THEN
  387.             goto 1630    'STOP AT EARLY FINISH OF COMPLETE ACT
  388.         end if
  389.  
  390.         IF D6<=EF(W)+1 OR B>=C THEN
  391.             goto 1660
  392.         end if
  393.  
  394. 1600  FOR J=B+1 TO C
  395.             PRINT #2,B$;
  396.         NEXT J
  397.  
  398. 1630  IF A$="C" AND D6>EF(W)+1 THEN
  399.             goto 1670
  400.             ELSE goto 1660
  401.         end if
  402.  
  403. 1640  PRINT #2,LEFT$(D$(W),33);TAB(36+D6-D5);">";
  404.         GOTO 1670
  405.  
  406. 1660  IF D6<LF(W)+1 OR D6<EF(W)+1 THEN
  407.             PRINT #2,">";
  408.         end if
  409.  
  410. 1670  PRINT #2,G9$
  411. 1680 NEXT I
  412.  
  413.      GOTO 510
  414.  
  415. DatePointer:
  416. 1700 FOR J=1 TO C3+1   '**** FIND DATE AND RETURN POINTER *****
  417.         IF A7=A(J) THEN
  418.             goto 1760
  419.         end if
  420.  
  421.       NEXT J
  422.  
  423.       BEEP
  424.       PRINT "**** DAY";A7;"MUST BE BETWEEN";A(1);"AND";A(C3+1);" NO HOLIDAYS ****"
  425.      INPUT "Enter new day (MMDDYY) ",A7
  426.       GOTO DatePointer                     '1700
  427.  
  428. 1760 RETURN
  429.  
  430. GetFile:
  431. 1770 REM **** READING IN ALREADY CREATED INPUT FILE ******************
  432.  
  433.       if len(cpafile$) > 0 then
  434.             G$=cpafile$
  435.             goto commndfile
  436.       end if
  437.  
  438. GetFile1:
  439. 1780 INPUT "Enter the name of the input file [.CPM] or Q to quit ";G$
  440.  
  441.       IF G$="Q" OR G$="q" THEN
  442.          close
  443.          chain "CPAMENU"
  444.       end if
  445.  
  446.   commndfile:
  447.       P=INSTR(1,G$,".")
  448.  
  449.       IF P<>0 THEN
  450.          F$=LEFT$(G$,INSTR(1,G$,".")-1)
  451.          ELSE F$=G$
  452.       end if
  453.  
  454.       IF LEN(F$)>8 THEN
  455.         PRINT "**** NOT A VALID PCPM FILE ****"
  456.         BEEP
  457.         GOTO GetFile1                    '1780
  458.       end if
  459.  
  460.       ON ERROR GOTO 1900
  461.            
  462.      cpafile$=F$
  463.      cpafile$=fnucase$(cpafile$)
  464.      F$=cpafile$
  465.      G$=F$+".CPM"
  466.      OPEN G$ FOR INPUT AS #3
  467.      INPUT #3,P$,T6$,DA$
  468.      M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  469.      CLOSE #3
  470.      PRINT " **** INPUT FILE READ ****"
  471.       RETURN
  472.  
  473. 1900 PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****"
  474.      BEEP
  475.      GOTO GetFile            '1770
  476.  
  477. FigureDays:
  478. 1910 REM ** CREATE ARRAY OF MMDDYYS ******************************
  479.      PRINT "**** CALCULATING DAYS ****"
  480.       D1=1
  481.  
  482.       IF A(1)=0 THEN
  483.          A(1)=M6*10000+D6*100+Y6
  484.       end if
  485.  
  486. 1950 D1=D1+1
  487.  
  488.       IF D1>C3+1 THEN
  489.         RETURN
  490.       end if
  491.  
  492. 1970 A8=A8+1
  493.  
  494.       GOSUB Cnvt2DaMoYr                 '2060
  495.  
  496.       IF LEFT$(T6$,3)="CAL" THEN
  497.          goto 2000
  498.         ELSEIF D4=6 OR D4=7 THEN
  499.          goto 1970
  500.       end if
  501.  
  502. 2000 O8=0
  503.  
  504.       GOSUB HolidayOrNot                 '2170
  505.  
  506.       IF O8=1 THEN
  507.         goto 1970
  508.       end if
  509.  
  510.      A(D1)=M5*10000+D5*100+Y5
  511.       GOTO 1950
  512.  
  513.       REM ** CONVERT CENTURY DAY TO MM, DD, YY **************************
  514.  
  515. Cnvt2DaMoYr:
  516. 2060 T9=INT(A8/1461)
  517.      Y5=INT((A8-T9+364)/365)
  518.      Y4=A8-INT((Y5-1)*1461/4)
  519.       L8=2
  520.  
  521.       IF Y5/4=INT(Y5/4) THEN
  522.          L8=1
  523.       end if
  524.  
  525.       T9=Y4
  526.  
  527.       IF T9>61-L8 THEN
  528.         T9=T9+L8
  529.       end if
  530.  
  531.      M5=INT((T9*9+269)/275)
  532.      D5=T9-INT(M5*275/9)+30
  533.      D4=A8-INT(A8/7)*7+1
  534.       RETURN
  535.  
  536. HolidayOrNot:
  537. 2170 FOR J=1 TO H9   '**** HOLIDAY OR NOT ********************************
  538.  
  539.         IF A8=A3(J) THEN
  540.             O8=1
  541.         end if
  542.  
  543.       NEXT J
  544.  
  545.      RETURN
  546.  
  547. HolidayRead:
  548. 2210 ON ERROR GOTO 2310
  549.      OPEN F$+".HOL" FOR INPUT AS #1
  550.       J=0
  551.  
  552. 2240 J=J+1
  553.  
  554.       IF EOF(1) THEN
  555.             goto 2280
  556.       end if
  557.  
  558.      INPUT #1,A3(J)
  559.       GOTO 2240
  560.  
  561. 2280 H9=J-1  'NUMBER OF HOLIDAYS
  562.  
  563. 2290 CLOSE #1
  564.      ON ERROR GOTO 0:RETURN
  565.  
  566. 2310 PRINT "**** NO HOLIDAY FILE - CONTINUING ****":RESUME 2290
  567.  
  568. SortFileRead:
  569. 2320 REM READING IN SORT FILE
  570.       ON ERROR GOTO NoSortFile            '2460 NO SORT FILE
  571.      OPEN F$+".LGS" FOR INPUT AS #1
  572.      INPUT #1,A8,A(1),C3
  573.      I=0
  574.  
  575. 2370 I=I+1
  576.  
  577.       IF EOF(1) THEN
  578.          goto 2430
  579.       end if
  580.  
  581.       IF I MOD 10=0 THEN
  582.         PRINT I;
  583.       end if
  584.  
  585.       INPUT #1,D$(I),S,F,O2,D,ES(I),LS,EF(I),LF(I),FL,RP$,B
  586.  
  587.       IF RP$="" THEN
  588.         LC(I)=0
  589.         ELSE LC(I)=1
  590.       end if
  591.  
  592.       GOTO 2370
  593.  
  594. 2430 N=I-1
  595.      PRINT " **** LGS FILE READ ****"
  596.       CLOSE #1:RETURN
  597.  
  598. NoSortFile:
  599. 2460 PRINT "FILE ";F$;".LGS MUST BE CREATED BY OPTION 5 FIRST AND EXIST ON DISK****"
  600.       BEEP
  601.       close
  602.       chain "CPAMENU"
  603. 
  604.