home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / BF / BF015.ZIP / PCPM4.EXE / arc / CPAUPD.BAS < prev    next >
BASIC Source File  |  1987-02-12  |  5KB  |  236 lines
  1.   '*** CPAUPD ***
  2.   common cpafile$
  3.  
  4.  UpperCase:
  5.    def fnucase$(cpafile$)
  6.       length=len(cpafile$)
  7.  
  8.       if length =0 then
  9.          exit def
  10.       end if
  11.  
  12.       for I=1 to length
  13.          ch=asc(mid$(cpafile$,I,1))
  14.                                     
  15.             if ch> 96 and ch<127 then
  16.             mid$(cpafile$,I,1)=chr$(ch-32)
  17.          end if
  18.  
  19.         next
  20.  
  21.         fnucase$=cpafile$
  22.  
  23.    end def
  24.  
  25.      cls
  26.      CLOSE
  27.      print "             UPDATE INPUT FILE FOR ACTUAL TIMES"
  28.      print
  29.  
  30.     REM CPAUPD   UPDATE INPUT FILE FOR ACTUAL TIMES
  31.     DEFINT B-Z:DEFSNG A
  32.     DIM X$(12),A6(500)
  33.  
  34.     FOR I=1 TO 12
  35.       READ X$(I)
  36.     NEXT I
  37.   
  38.      DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  39.     DIM S(500),F(500),D$(500),D(500),O2(500)
  40.     DIM H3(100),B(500),S$(48),R3(500),C(500)
  41.     B4=VAL(MID$(DATE$,1,2))
  42.     B5=VAL(MID$(DATE$,4,2))
  43.     B6=VAL(MID$(DATE$,9,2))
  44.   
  45.      GOSUB GetFile                   '5000 READ INPUT FILE
  46.  
  47.      ON ERROR GOTO FileHandlingErrs        '6500
  48.  
  49.      H$=F$+".UPD"
  50.     OPEN H$ FOR INPUT AS #2
  51.     INPUT #2,C4,C5,C6  'DATE OF CREATION OF UPDATE FILE
  52.     J=0
  53.  
  54. Start:
  55. 230 J=J+1
  56.  
  57.     IF EOF(2) THEN
  58.         goto Warning                           '280
  59.     end if
  60.  
  61.     INPUT #2,D$,S,F,D2,A6
  62.  
  63.     IF A6=0 THEN
  64.         goto Start                             '230
  65.     end if
  66.  
  67.      GOSUB CompChgActTime                     '2000
  68.  
  69.     PRINT "**** ";D$;" UPDATED TO";D2;T6$;" ****"
  70.  
  71.      GOTO Start                               '230
  72.  
  73. Warning:
  74. 280 IF N<>J-1 THEN
  75.         PRINT "**** WARNING - WRONG NUMBER OF ENTRIES IN UPDATE FILE ****"
  76.     end if
  77.  
  78.     CLOSE #2
  79.     PRINT "File ";F$;" updated - O.K. to write to disk (Y/N) ";
  80.      INPUT Q$
  81.      IF LEFT$(Q$,1)="N" THEN
  82.          goto Back2MainMenu                    '320
  83.         ELSE goto 330
  84.      end if
  85.  
  86. Back2MainMenu:
  87. 320 INPUT "Press ENTER to return to the main menu ",Q$
  88.      close
  89.      chain "CPAMENU"
  90.  
  91. 330 GOSUB UpdateInput                  '3000 WRITE TO DISK
  92.  
  93.      close
  94.      chain "CPAMENU"
  95.     PRINT "**** UPDATE FILE ";H$;" NOT FOUND - CREATE WITH OPTION 5 ****"
  96.     PRINT
  97.      GOTO Back2MainMenu                 '320
  98.  
  99. CompChgActTime:
  100. 2000 REM SUBROUTINE TO COMPARE AND CHANGE ACTUAL TIMES
  101.  
  102.      FOR I=1 TO N
  103.  
  104.       IF S(I)<>S THEN
  105.             goto 2100
  106.       end if 
  107.  
  108.       IF F(I)<>F THEN
  109.             goto 2100
  110.       end if
  111.  
  112.       IF D$(I)<>D$ THEN
  113.             PRINT "**** DESCRIPTIONS VARY - ";D$(I);" - ";D$;" ****"
  114.           ELSE goto 2070
  115.       end if
  116.  
  117.       INPUT "Enter Y (O.K.), N for wrong activity, or Q to Quit (abort here) (Y/N/Q) ";Q$
  118.  
  119.       IF Q$="Q" or Q$="q" THEN
  120.             CLOSE #2
  121.             chain "CPAMENU"
  122.       end if
  123.  
  124. 2070  D(I)=D2
  125.  
  126. 2100 NEXT
  127.  
  128.      RETURN
  129.  
  130. UpdateInput:
  131. 3000 REM **** UPDATING INPUT FILE ******************
  132.      G$=F$+".CPM"
  133.      OPEN G$ FOR OUTPUT AS #3
  134.      WRITE #3,P$,T6$,DA$
  135.  
  136.      FOR I=1 TO N
  137.  
  138.        WRITE #3,D$(I),S(I),F(I),O2(I),D(I),A6(I),R3(I),B(I),C(I)
  139.  
  140.        IF I/10=INT(I/10) THEN
  141.           PRINT I;
  142.        end if
  143.  
  144.      NEXT
  145.  
  146.      CLOSE #3
  147.      PRINT " **** FILE ";G$;" UPDATED ****"
  148.      RETURN
  149.  
  150. GetFile:
  151. 5000 REM **** READING IN ALREADY CREATED INPUT FILE ******************
  152.  
  153.     if len(cpafile$) >0 then
  154.         G$=cpafile$
  155.         goto commndfile
  156.     end if
  157.  
  158. GetFile1:
  159. 5010 INPUT "Enter the name of the input file [.CPM] or Q to quit ";G$
  160.  
  161.      IF G$="Q" OR G$="q" THEN
  162.           close
  163.           chain "CPAMENU"
  164.      end if
  165.  
  166.  commndfile:
  167.       P=INSTR(1,G$,".")
  168.  
  169.      IF P<>0 THEN
  170.             F$=LEFT$(G$,INSTR(1,G$,".")-1)
  171.           ELSE F$=G$
  172.      end if
  173.  
  174.      IF LEN(F$)>8 THEN
  175.             PRINT "**** NOT A VALID PCPM FILE ****"
  176.             BEEP
  177.             GOTO GetFile1                  '5010
  178.      end if
  179.  
  180.       ON ERROR GOTO FileNotExist              '5300
  181.  
  182.      cpafile$=F$
  183.      cpafile$=fnucase$(cpafile$)
  184.      F$=cpafile$                
  185.      G$=F$+".CPM"
  186.      OPEN G$ FOR INPUT AS #3
  187.      INPUT #3,P$,T6$,DA$
  188.      I=0
  189.  
  190. 5070 I=I+1
  191.  
  192.      IF EOF(3) THEN
  193.             goto 5130
  194.      end if
  195.  
  196.      INPUT #3,D$(I),S(I),F(I),O2(I),D(I),A6(I),R3(I),B(I),C(I)
  197.  
  198.      IF I/10=INT(I/10) THEN
  199.             PRINT I;
  200.      end if
  201.  
  202.      GOTO 5070
  203.  
  204. 5130 N=I-1
  205.      M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  206.      CLOSE #3
  207.      PRINT " **** INPUT FILE READ ****"
  208.       RETURN
  209.  
  210. FileNotExist:
  211. 5300 PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****"
  212.      BEEP
  213.       GOTO GetFile                      '5000
  214.  
  215. FileHandlingErrs:
  216. 6500 REM ERRORS IN FILE HANDLING
  217.  
  218.      IF ERR=53 THEN
  219.             BEEP
  220.             PRINT "**** UPDATE FILE MUST BE CREATED FIRST AND EXIST ON THE DISK ****"
  221.             PRINT
  222.      end if
  223.  
  224.      IF ERR<>53 THEN
  225.             goto GeneralError                   '11000  GENEARAL ERROR
  226.      end if
  227.  
  228.       RESUME Back2MainMenu                    '320
  229.  
  230. GeneralError:
  231. 11000 PRINT "ERROR NUMBER";ERR;"AT LINE NUMBER";ERL
  232.       PRINT "**** PLEASE NOTE FOR FUTURE USE AND DEBUGGING ****"
  233.  
  234.         GOTO Back2MainMenu                     '320
  235. 
  236.