home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB117 / vehic2.for < prev    next >
Text File  |  1995-05-28  |  6KB  |  214 lines
  1. C
  2. C         VEHICLE MAINTENANCE PRGM        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C           OPTION #2 - REPAIRS   
  5. C
  6. C
  7. $STORAGE:2
  8. C
  9. C
  10.       SUBROUTINE REPAIR
  11. C
  12.       COMMON/MONTHS/ IMON
  13.       CHARACTER*4 IMON(13)
  14. C
  15.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  16.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  17.       CHARACTER RFILE(25)*11,MFILE(25)*11
  18. C
  19.       COMMON/MAIN2/ COST,ODOM,VNUM
  20.       INTEGER VNUM
  21.       REAL COST(2,25),ODOM(2,25)
  22. C
  23.       COMMON/REPAR1/ RDESC,RDATE
  24.       CHARACTER RDESC(500)*25,RDATE(500)*8
  25. C
  26.       COMMON/REPAR2/ RCODE,RCOST,RODOM,RNUM
  27.       INTEGER RCODE(500),RNUM
  28.       REAL RCOST(500),RODOM(500)
  29. C
  30.       INTEGER SEL,ICODE,TYPE,OLD
  31.       CHARACTER TEST*8,OPTION*25,RAMDSK*80,CHOICE(2)*1
  32.       REAL GALS
  33. C
  34. C           LIST ALL CARS, SELECT ONE TO WORK WITH
  35. C
  36.       SEL=0
  37.       TYPE=1
  38.       OPTION='Update Repair Log   '
  39.       CALL HEADER(OPTION)
  40.       CALL LISTEM(TYPE,SEL)
  41.       IF(SEL.EQ.0) RETURN
  42.       CALL RDREPS(SEL)
  43. C
  44. C           DISPLAY SELECTED CAR                        
  45. C
  46.    25 CONTINUE
  47.       CALL HEADER(OPTION)
  48.       CALL DNAME(SEL)
  49. C
  50. C           DRAW A SOLID LINE
  51. C
  52.       CALL MOVEIT(1,21)
  53.       CALL BOLD
  54.       CALL ULINE
  55.          WRITE(*,'(80X)')
  56.       CALL OFF
  57. C
  58. C           ASK FOR DATA
  59. C
  60.    50 CONTINUE
  61.       LM=RNUM
  62.       CALL UPTOP (1,10) 
  63.       CALL OFF
  64.          WRITE(*,100)
  65.   100    FORMAT(//,18X,'1. Oil Change w/Filter      6. Alignment     ',
  66.      A           /,18X,'2. Lubrication              7. Front Brakes  ',
  67.      B           /,18X,'3. Air Filter               8. Rear Brakes   ',
  68.      C           /,18X,'4. Dist. Points             9. Tire Rotation ',
  69.      D           /,18X,'5. Spark Plugs             98. Special Repair',
  70.      E           /,18X,'                                             ',
  71.      F         ///,18X,'                                             ')
  72.   150 CONTINUE
  73.       CALL MOVEIT(1,23) 
  74.          CALL BOLD
  75.          WRITE(*,'(9X,A33,\)') 'Enter Choice (H=Help, Q=Quit) : '
  76.          READ(*,'(2A1)',ERR=150) (CHOICE(K),K=1,2)
  77.          CALL OFF
  78.          IF(CHOICE(1).EQ.'Q' .OR. CHOICE(1).EQ.'q') THEN
  79.             CALL WRREPS(SEL)
  80.             GOTO 900
  81.          ELSEIF(CHOICE(1).EQ.'H' .OR. CHOICE(1).EQ.'h') THEN
  82.             CHOICE(1)='2'
  83.             IUNIT=15
  84.             CALL HELP(CHOICE(1),IUNIT)
  85.             GOTO 25
  86.          ELSEIF(CHOICE(1).EQ.'1' .OR. CHOICE(1).EQ.'2' .OR.
  87.      A          CHOICE(1).EQ.'3' .OR. CHOICE(1).EQ.'4' .OR.
  88.      B          CHOICE(1).EQ.'5' .OR. CHOICE(1).EQ.'6' .OR.
  89.      C          CHOICE(1).EQ.'7' .OR. CHOICE(1).EQ.'8' .OR.
  90.      D          CHOICE(1).EQ.'9') THEN
  91.             WRITE(RAMDSK,'(A1)') CHOICE(1)
  92.             READ(RAMDSK,'(I1)') ICODE
  93.             LM=RNUM+1
  94. C
  95. C              IF CATAGORY 1 THRU 9, THEN UPDATE THAT ENTRY WITH DATA
  96. C
  97.             IF(CHOICE(2).EQ.' ') THEN
  98.                DO 155 JL=1,RNUM
  99.                IF(RCODE(JL).EQ.ICODE) LM=JL
  100.   155          CONTINUE
  101.             ELSEIF(CHOICE(1).EQ.'9' .AND. CHOICE(2).EQ.'8') THEN
  102.                ICODE = 98
  103.             ELSE
  104.                CALL BELL
  105.                GOTO 150
  106.             ENDIF
  107. C
  108. C              POINT TO SELECTION, PROMPT FOR ALL DATA
  109. C
  110.             RCODE(LM)=ICODE
  111.             IF(ICODE.LE.5) THEN
  112.                LH=16
  113.                LV=11+ICODE
  114.             ELSEIF(ICODE.EQ.98) THEN
  115.                LH=43
  116.                LV=16
  117.             ELSE
  118.                LH=44
  119.                LV=11+(ICODE-5)
  120.             ENDIF
  121.             CALL UPTOP(LH,LV)
  122.             CALL BOLD
  123.             CALL BLINK
  124.             WRITE(*,'(A3)') '==>'
  125.             CALL OFF
  126. C
  127. C              REPAIR DATE
  128. C
  129.   160       CONTINUE
  130.             CALL MOVEIT(1,23) 
  131.             CALL BOLD
  132.             WRITE(*,'(5X,A30,\)') ' Date Repaired ? (MM/DD/YY) : '
  133.             CALL OFF
  134.             TEST=' '
  135.             CALL EDATE(38,23,TEST)
  136.             IF(TEST.EQ.' ') THEN
  137.                GOTO 50
  138.             ELSE
  139.                RDATE(LM)=TEST 
  140.             ENDIF
  141. C
  142. C               NOW ASK FOR A DESCRIPTION IF SPECIAL TYPE
  143. C
  144.             IF(ICODE.EQ.98) THEN
  145.   175          CALL MOVEIT(1,23) 
  146.                CALL BOLD
  147.                WRITE(*,'(5X,A30,\)') 'Enter Description of Repair : '
  148.                CALL OFF
  149.                RAMDSK=' '
  150.                CALL EDCHR(38,23,RAMDSK,25)
  151.                RDESC(LM)=RAMDSK
  152.             ELSE
  153.   180          CALL MOVEIT(1,23) 
  154.                CALL BOLD
  155.                WRITE(*,'(5X,A30,\)') '   Any Notes About Repair ? : '
  156.                CALL OFF
  157.                RAMDSK=' '
  158.                CALL EDCHR(38,23,RAMDSK,25)
  159.                RDESC(LM)=RAMDSK
  160.             ENDIF
  161. C
  162. C               NOW THE COST
  163. C
  164.             ITRY=0
  165.   200       CONTINUE
  166.             CALL MOVEIT(1,23) 
  167.             CALL BOLD
  168.             WRITE(*,'(5X,A30,\)') '       Cost of the Repair ? : '
  169.             CALL OFF
  170.             GALS=0.0
  171.             CALL EDREL(38,23,GALS,8)
  172.             IF(GALS.LE.0.0 .AND. ITRY.EQ.0) THEN
  173.                ITRY=1
  174.                CALL BELL
  175.                GOTO 200
  176.             ENDIF
  177.             IF(LM.LE.RNUM) THEN
  178.                RCOST(LM)=RCOST(LM) + GALS
  179.             ELSE
  180.                RCOST(LM)=GALS 
  181.             ENDIF
  182. C
  183. C               AND LAST, THE ODOMETER READING
  184. C
  185.   300       CONTINUE
  186.             CALL MOVEIT(1,23) 
  187.             CALL BOLD
  188.             WRITE(*,'(5X,A30,\)') '           Odometer Reading : '
  189.             CALL OFF
  190.             GALS=0.0
  191.             CALL EDREL(38,23,GALS,8)
  192.             IF(GALS.LE.0.0) THEN
  193.                CALL BELL
  194.                GOTO 300
  195.             ENDIF
  196.             IF(DATE(2,SEL).EQ.' ') GALS=GALS+ODOM(2,SEL)
  197.             RODOM(LM)=GALS 
  198. C
  199. C              INCREMENT COUNTER, CREATE FILE NAME IF NECESSARY
  200. C
  201.             IF(LM.GT.RNUM) RNUM=RNUM+1
  202.             IF(RNUM.EQ.1) THEN
  203.                WRITE(RAMDSK,'(A5,I2.2,A4)') 'VEHIC',SEL,'.REP'
  204.                READ(RAMDSK,'(A11)') RFILE(SEL)
  205.             ENDIF
  206.          ELSE
  207.             CALL BELL
  208.             GOTO 150
  209.          ENDIF
  210.          GOTO 50
  211.   900 CONTINUE
  212.       RETURN
  213.       END
  214.