C
C         VEHICLE MAINTENANCE PRGM        by Bruce W. Roeckel
C       *--------------------------*                         
C           OPTION #3 - MILEAGE   
C
C
$STORAGE:2
C
C
      SUBROUTINE MILES
C
C          THIS ROUTINE HANDLES ALL THE MILEAGE UPDATING
C
      IMPLICIT INTEGER (A-Z)
      CHARACTER OPTION*25,ICODE*1
C
C           LIST ALL CARS, SELECT ONE TO WORK WITH
C
      SEL=0
      TYPE=1
      OPTION='Update Mileage Data'
      CALL HEADER(OPTION)
      CALL LISTEM(TYPE,SEL)
      IF(SEL.EQ.0) RETURN
      CALL RDMILE(SEL)
C
C           PRINT NAME AT TOP OF SCREEN
C
   50 CONTINUE
      CALL HEADER(OPTION)
      CALL DNAME(SEL)
C
C         DRAW SOLID LINE
C
      CALL MOVEIT(1,21)
      CALL BOLD
      CALL ULINE
         WRITE(*,'(80X)')
      CALL OFF
C
C          DRAW THE PROMPT LINE
C
   75 CONTINUE
      CALL MAP2
      CALL MOVEIT(1,23)
         WRITE(*,'(7X,A35,A35,\)') 
     A       '( )dd   ( )elete   ( )dit   ( )elp ',
     B       '  ( )uit       Option ==> [ ]      '
      CALL BOLD
      CALL UPTOP(11,23)
         WRITE(*,'(A1)') 'A'
      CALL UPTOP(19,23)
         WRITE(*,'(A1)') 'D'
      CALL UPTOP(30,23)
         WRITE(*,'(A1)') 'E'
      CALL UPTOP(39,23)
         WRITE(*,'(A1)') 'H'
      CALL UPTOP(48,23)
         WRITE(*,'(A1)') 'Q'
  100 CONTINUE
      CALL UPTOP(75,23)
      CALL OFF
      CALL CURLT(4)
      READ(*,'(A1)',ERR=100) ICODE
C
C            BRANCH ON REQUESTED OPTION
C
      IF(ICODE.EQ.'Q' .OR. ICODE.EQ.'q') THEN
         CALL MOVEIT(1,23)
         CALL WRMILE(SEL)
         RETURN
      ELSEIF(ICODE.EQ.'H' .OR. ICODE.EQ.'h') THEN
         ICODE='3'
         IUNIT=15
         CALL HELP(ICODE,IUNIT)
         GOTO 50 
      ELSEIF(ICODE.EQ.'A' .OR. ICODE.EQ.'a') THEN
         CALL ADDIT(SEL)
         GOTO 75 
      ELSEIF(ICODE.EQ.'D' .OR. ICODE.EQ.'d') THEN
         CALL DELETE(SEL)
         GOTO 75
      ELSEIF(ICODE.EQ.'E' .OR. ICODE.EQ.'e') THEN
         CALL EDITML(SEL)
         GOTO 75 
      ELSE
         CALL BELL
         GOTO 100
      ENDIF
      END
C
C
C
      SUBROUTINE MAP2
C
C             DISPLAY FULL-SCREEN-EDIT MAP
C
      CALL UPTOP(1,12)
      CALL BOLD
      WRITE(*,100)
  100 FORMAT(
     A  /,10X,'     Date Purchased:                           ',
     B  /,10X,'  Gallons Purchased:                           ',
     C  /,10X,'   Odometer Reading:                           ',
     D //,10X,'      Activity Code: Trip     City             ',
     E  /,10X,'Description of Trip:                           ')
      CALL OFF
C
      CALL UPTOP(33,13)
         WRITE(*,'(A8)') '__/__/__'
      CALL UPTOP(33,14)
         WRITE(*,'(A9)') '_________'
      CALL UPTOP(33,15)
         WRITE(*,'(A9)') '_________'
      CALL UPTOP(38,17)
         WRITE(*,'(A1)') '_'
      CALL UPTOP(47,17)
         WRITE(*,'(A1)') '_'
      CALL UPTOP(33,18)
         WRITE(*,'(A25)') '_________________________'
C
      RETURN 
      END
C
C
C
      SUBROUTINE ADDIT(SEL)
C
C        THIS ROUTINE ADDS A NEW ENTRY TO THE DATABASE
C
      IMPLICIT INTEGER (A-Z)
      CHARACTER TEST*8,RAMDSK*80
      REAL GALS
C
      COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
      CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
      CHARACTER RFILE(25)*11,MFILE(25)*11
C
      COMMON/MAIN2/ COST,ODOM,VNUM
      INTEGER VNUM
      REAL COST(2,25),ODOM(2,25)
C
      COMMON/MILE1/ MDESC,MDATE
      CHARACTER MDESC(500)*25,MDATE(500)*8
C
      COMMON/MILE2/ MCODE,MCOST,MODOM,MNUM
      INTEGER MCODE(500),MNUM
      REAL MCOST(500),MODOM(500)
C
C        CALL FOR MAP, DRAW PROMPT LINE
C
      CALL MOVEIT(1,23)
      WRITE(*,'(7X,2A33)') 'Please Enter Requested Data .... ',
     A                     'Press <RET> to tab to next field ' 
C
C        REQUEST ALL DATA
C
      LM=MNUM+1
   50 CONTINUE
      MDATE(LM)=' '
      CALL EDATE(33,13,MDATE(LM))
      IF(MDATE(LM).EQ.' ') THEN
         CALL BELL
         GOTO 50
      ENDIF
C
   75 CONTINUE
      MCOST(LM)=0.0
      CALL EDREL(33,14,MCOST(LM),9)
      IF(MCOST(LM).LE.0.0) THEN
         CALL BELL
         GOTO 75
      ENDIF
C
  100 CONTINUE
      GALS=0.0
      CALL EDREL(33,15,GALS,9)
      IF(DATE(2,SEL).EQ.' ') THEN
         GALS = GALS + ODOM(2,SEL)
      ENDIF
      IF((GALS.LE.0.0).OR.(LM.GT.1.AND.GALS.LT.MODOM(LM-1))) THEN
         CALL BELL
         GOTO 100
      ELSE
         MODOM(LM)=GALS 
      ENDIF
C
C             NOW ASK WHAT CATAGORY (TRIP/CITY) THIS IS FOR
C
  400 CONTINUE
      TEST=' '
      CALL EDCHR(38,17,TEST,1)
      IF(TEST.NE.' ') THEN
         MCODE(LM)=1
  500    CONTINUE
         RAMDSK=' '
         CALL EDCHR(33,18,RAMDSK,25)
         MDESC(LM)=RAMDSK
         IF(MDESC(LM).EQ.' ') THEN
            CALL BELL
            GOTO 500
         ENDIF
      ELSE
         CALL EDCHR(47,17,TEST,1)
         IF(TEST.NE.' ') THEN
            MCODE(LM)=2
         ELSE
            CALL BELL
            GOTO 400
         ENDIF
      ENDIF
C
C              INCREMENT COUNTER, CREATE FILE NAME IF NECESSARY
C
      MNUM=LM
      IF(MNUM.EQ.1) THEN
         WRITE(RAMDSK,'(A5,I2.2,A4)') 'VEHIC',SEL,'.MIL'
         READ(RAMDSK,'(A11)') MFILE(SEL)
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE EDITML(SEL)
C
      IMPLICIT INTEGER (A-Z)
      CHARACTER TEST*8,RAMDSK*80
      REAL GALS
C
      COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
      CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
      CHARACTER RFILE(25)*11,MFILE(25)*11
C
      COMMON/MAIN2/ COST,ODOM,VNUM
      INTEGER VNUM
      REAL COST(2,25),ODOM(2,25)
C
      COMMON/MILE1/ MDESC,MDATE
      CHARACTER MDESC(500)*25,MDATE(500)*8
C
      COMMON/MILE2/ MCODE,MCOST,MODOM,MNUM
      INTEGER MCODE(500),MNUM
      REAL MCOST(500),MODOM(500)
C
C        CALL FOR MAP, DRAW PROMPT LINE
C
   50 CONTINUE
      CALL MOVEIT(1,23)
      WRITE(*,'(7X,2A33,\)') 'Please Enter Date of Record to be',
     A                       ' EDITed or <Return> for Menu     ' 
C
C        GET DATE, FIND MATCH
C
      TEST=' '
      CALL EDATE(33,13,TEST)
      IF(TEST.EQ.' ') THEN
         CALL BELL
         GOTO 900
      ENDIF
C
      DO 75 I=1,MNUM
      IF(TEST.EQ.MDATE(I)) GOTO 100
   75 CONTINUE
      CALL BELL
      CALL MOVEIT(1,23)
      WRITE(*,'(7X,2A33,\)') 'ERROR .... Record could not be lo',
     A                       'cated, press <Return> for Menu   ' 
      READ(*,'(A1)') TEST
      GOTO 900
C
C         MATCH FOUND, DISPLAY ALL 
C
  100 CONTINUE
      LM=I
      CALL UPTOP(33,14)
      WRITE(*,'(F9.2)') MCOST(LM)
      CALL UPTOP(33,15)
      WRITE(*,'(F9.2)') MODOM(LM)
      IF(MCODE(LM).EQ.1) THEN
         CALL UPTOP(38,17)
         WRITE(*,'(A1)') 'X'
         CALL UPTOP(33,18)
         WRITE(*,'(A25)') MDESC(LM)
      ELSE
         CALL UPTOP(47,17)
         WRITE(*,'(A1)') 'X'
      ENDIF
C
C         NOW EDIT ENTRIES
C
      CALL EDREL(33,14,MCOST(LM),9)
      CALL EDREL(33,15,MODOM(LM),9)
  400 CONTINUE
      IF(MCODE(LM).EQ.1) THEN
         RAMDSK='X'
      ELSE
         RAMDSK=' '
      ENDIF
      CALL EDCHR(38,17,RAMDSK,1)
      IF(RAMDSK.NE.' ') THEN
         MCODE(LM)=1
         RAMDSK=MDESC(LM)
         CALL EDCHR(33,18,RAMDSK,25)
         MDESC(LM)=RAMDSK
      ELSE
         RAMDSK='X'
         CALL EDCHR(47,17,RAMDSK,1)
         IF(RAMDSK.NE.' ') THEN
            MCODE(LM)=2
            MDESC(LM)=' '
         ELSE
            CALL BELL
            GOTO 400
         ENDIF
      ENDIF
  900 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE DELETE(SEL)
C
      IMPLICIT INTEGER (A-Z)
      CHARACTER TEST*8,RAMDSK*80
      REAL GALS
C
      COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
      CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
      CHARACTER RFILE(25)*11,MFILE(25)*11
C
      COMMON/MAIN2/ COST,ODOM,VNUM
      INTEGER VNUM
      REAL COST(2,25),ODOM(2,25)
C
      COMMON/MILE1/ MDESC,MDATE
      CHARACTER MDESC(500)*25,MDATE(500)*8
C
      COMMON/MILE2/ MCODE,MCOST,MODOM,MNUM
      INTEGER MCODE(500),MNUM
      REAL MCOST(500),MODOM(500)
C
C        CALL FOR MAP, DRAW PROMPT LINE
C
   50 CONTINUE
      CALL MOVEIT(1,23)
      WRITE(*,'(7X,2A33,\)') 'Please Enter Date of Record to be',
     A                       ' DELETED or <Return> for Menu    ' 
C
C        GET DATE, FIND MATCH
C
      TEST=' '
      CALL EDATE(33,13,TEST)
      IF(TEST.EQ.' ') THEN
         CALL BELL
         GOTO 900
      ENDIF
C
      DO 75 I=1,MNUM
      IF(TEST.EQ.MDATE(I)) GOTO 100
   75 CONTINUE
      CALL BELL
      CALL MOVEIT(1,23)
      WRITE(*,'(7X,2A33,\)') 'ERROR .... Record could not be lo',
     A                       'cated, press <Return> for Menu   ' 
      READ(*,'(A1)') TEST
      GOTO 900
C
C         MATCH FOUND, DISPLAY ALL 
C
  100 CONTINUE
      LM=I
      CALL UPTOP(33,14)
      WRITE(*,'(F9.2)') MCOST(LM)
      CALL UPTOP(33,15)
      WRITE(*,'(F9.2)') MODOM(LM)
      IF(MCODE(LM).EQ.1) THEN
         CALL UPTOP(38,17)
         WRITE(*,'(A1)') 'X'
         CALL UPTOP(33,18)
         WRITE(*,'(A25)') MDESC(LM)
      ELSE
         CALL UPTOP(47,17)
         WRITE(*,'(A1)') 'X'
      ENDIF
C
C          FIND OUT IF THIS SHOULD BE DELETE
C
      CALL BELL
      CALL MOVEIT(1,23)
      WRITE(*,'(7X,2A28,\)') ' Is this the correct record ',
     A                       'you wish to DELETE (Y/N) ?? ' 
      READ(*,'(A1)') TEST
      IF(TEST.NE.'Y' .AND. TEST.NE.'y') GOTO 900
C
C          MOVE LAST ENTRY HERE, DECREMENT COUNTER
C
      MDATE(LM)=MDATE(MNUM)
      MCOST(LM)=MCOST(MNUM)
      MODOM(LM)=MODOM(MNUM)
      MCODE(LM)=MCODE(MNUM)
      MDESC(LM)=MDESC(MNUM)
      MNUM=MNUM-1
  900 CONTINUE
      RETURN
      END
