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 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 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 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 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 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