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 / vehic1.for < prev    next >
Text File  |  1995-05-28  |  8KB  |  378 lines
  1. C
  2. C         VEHICLE MAINTENANCE PRGM        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C           OPTION #1 - MASTER    
  5. C
  6. $STORAGE:2
  7. C
  8.       SUBROUTINE MASTER
  9. C
  10.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  11.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  12.       CHARACTER RFILE(25)*11,MFILE(25)*11
  13. C
  14.       COMMON/MAIN2/ COST,ODOM,VNUM
  15.       INTEGER VNUM
  16.       REAL COST(2,25),ODOM(2,25)
  17. C
  18.       CHARACTER OPTION*25,ICODE*1
  19. C
  20. C           DISPLAY HEADER 
  21. C
  22.    50 CONTINUE
  23.       OPTION='Master File Update'
  24.       CALL HEADER(OPTION)
  25. C
  26. C          DRAW THE PROMPT LINE
  27. C
  28.       CALL MOVEIT(1,21)
  29.       CALL BOLD
  30.       CALL ULINE
  31.          WRITE(*,'(80X)')
  32.       CALL OFF
  33. C
  34.    75 CONTINUE
  35.       CALL MAP
  36.       CALL MOVEIT(1,23)
  37.          WRITE(*,'(6X,A35,A35,\)') 
  38.      A       '( )uy   ( )ell   ( )dit   ( )elp   ',
  39.      B       '( )uit         Option ==> [ ]      '
  40.       CALL BOLD
  41.       CALL UPTOP(10,23)
  42.          WRITE(*,'(A1)') 'B'
  43.       CALL UPTOP(18,23)
  44.          WRITE(*,'(A1)') 'S'
  45.       CALL UPTOP(27,23)
  46.          WRITE(*,'(A1)') 'E'
  47.       CALL UPTOP(36,23)
  48.          WRITE(*,'(A1)') 'H'
  49.       CALL UPTOP(45,23)
  50.          WRITE(*,'(A1)') 'Q'
  51.   100 CONTINUE
  52.       CALL UPTOP(74,23)
  53.       CALL OFF
  54.       CALL CURLT(4)
  55.          READ(*,'(A1)',ERR=200) ICODE
  56.             IF(ICODE.EQ.' ') THEN
  57.                GOTO 200
  58.             ELSEIF(ICODE.EQ.'Q' .OR. ICODE.EQ.'q') THEN
  59.                RETURN
  60.             ELSEIF(ICODE.EQ.'H' .OR. ICODE.EQ.'h') THEN
  61.                ICODE='1'
  62.                IUNIT=15
  63.                CALL HELP(ICODE,IUNIT)
  64.                GOTO 50
  65.             ELSEIF(ICODE.EQ.'B' .OR. ICODE.EQ.'b') THEN
  66.                CALL BUYIT
  67.                GOTO 75 
  68.             ELSEIF(ICODE.EQ.'S' .OR. ICODE.EQ.'s') THEN
  69.                CALL SELLIT
  70.                GOTO 75 
  71.             ELSEIF(ICODE.EQ.'E' .OR. ICODE.EQ.'e') THEN
  72.                CALL EDITIT
  73.                GOTO 75 
  74.             ENDIF
  75.   200    CONTINUE
  76.          CALL BELL
  77.          GOTO 100
  78.       END
  79. C
  80. C
  81. C
  82.       SUBROUTINE MAP
  83. C
  84. C             DISPLAY FULL-SCREEN-EDIT MAP
  85. C
  86.       CALL UPTOP(1,7)
  87.       CALL BOLD
  88.       WRITE(*,100)
  89.   100 FORMAT(
  90.      A  /,10X,'Vehicle:                                     ',
  91.      B //,10X,'   ID #:                                     ',
  92.      C //,
  93.      D //,10X,'Purchased :           for  $            ',
  94.      D        'Mileage:         ',
  95.      E //,10X,'     Sold :           for  $            ',
  96.      E        'Mileage:         ')
  97.       CALL OFF
  98. C
  99.       CALL UPTOP(21,8)
  100.          WRITE(*,'(A20)') '____________________'
  101.       CALL UPTOP(21,10)
  102.          WRITE(*,'(A20)') '____________________'
  103.       CALL UPTOP(24,14)
  104.          WRITE(*,'(A8)') '__/__/__'
  105.       CALL UPTOP(41,14)
  106.          WRITE(*,'(A8)') '________'
  107.       CALL UPTOP(61,14)
  108.          WRITE(*,'(A9)') '_________'
  109.       CALL UPTOP(24,16)
  110.          WRITE(*,'(A8)') '__/__/__'
  111.       CALL UPTOP(41,16)
  112.          WRITE(*,'(A8)') '________'
  113.       CALL UPTOP(61,16)
  114.          WRITE(*,'(A9)') '_________'
  115. C
  116.       RETURN
  117.       END
  118. C
  119. C
  120. C
  121.       SUBROUTINE BUYIT
  122. C
  123.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  124.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  125.       CHARACTER RFILE(25)*11,MFILE(25)*11
  126. C
  127.       COMMON/MAIN2/ COST,ODOM,VNUM
  128.       INTEGER VNUM
  129.       REAL COST(2,25),ODOM(2,25)
  130. C
  131.       CHARACTER TEST*8,RAMDSK*80
  132.       REAL GALS
  133. C
  134.       VNUM=VNUM+1
  135.       IF(VNUM.GT.25) RETURN
  136.       CALL MOVEIT(1,23)
  137.       WRITE(*,'(7X,A30,A35)') 'Please Enter Data ...... Press',
  138.      A                        ' <RET> to Tab to Next Location     '
  139. C
  140. C           ASK FOR ALL DATA REQUIRED TO LOG A NEW PURCHASE
  141. C
  142.       RAMDSK=' '
  143.       CALL EDCHR(21,8,RAMDSK,20)
  144.       IF(NAME(VNUM).EQ.' ') THEN
  145.          VNUM=VNUM-1
  146.          RETURN
  147.       ELSE
  148.          NAME(VNUM)=RAMDSK
  149.          RAMDSK=' '
  150.          CALL EDCHR(21,10,RAMDSK,20)
  151.          IDNUM(VNUM)=RAMDSK
  152. C
  153.   200    CONTINUE
  154.          TEST=' '
  155.          CALL EDATE(24,14,TEST)
  156.          IF(TEST.EQ.' ') THEN
  157.             CALL BELL
  158.             GOTO 200
  159.          ELSE
  160.             DATE(1,VNUM)=TEST 
  161.          ENDIF
  162. C
  163.   300    CONTINUE
  164.          GALS=0.0
  165.          CALL EDREL(41,14,GALS,8)
  166.          IF(GALS.LE.0.0) THEN   
  167.             CALL BELL
  168.             GOTO 300
  169.          ELSE
  170.             COST(1,VNUM)=GALS 
  171.          ENDIF
  172. C
  173.          GALS=0.0
  174.          CALL EDREL(61,14,GALS,9)
  175.          ODOM(1,VNUM)=GALS 
  176.       ENDIF
  177. C
  178. C         INITIALIZE ALL OTHER VARIABLES
  179. C
  180.       COST(2,VNUM)=0.0
  181.       DATE(2,VNUM)=' '
  182.       ODOM(2,VNUM)=0.0
  183.       RFILE(VNUM)=' '
  184.       MFILE(VNUM)=' '
  185. C
  186.       RETURN
  187.       END
  188. C
  189. C
  190. C
  191.       SUBROUTINE SELLIT
  192. C
  193.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  194.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  195.       CHARACTER RFILE(25)*11,MFILE(25)*11
  196. C
  197.       COMMON/MAIN2/ COST,ODOM,VNUM
  198.       INTEGER VNUM
  199.       REAL COST(2,25),ODOM(2,25)
  200. C
  201.       INTEGER TYPE,SEL
  202.       CHARACTER TEST*8
  203.       REAL GALS
  204. C
  205. C           LIST ALL CARS ON FILE
  206. C
  207.       TYPE=1
  208.       CALL CLEAN
  209.       CALL LISTEM(TYPE,SEL)
  210.       CALL CLEAN
  211.       IF(SEL.EQ.0) GOTO 900
  212.  
  213.       CALL MAP
  214.       CALL MOVEIT(1,23)
  215.       WRITE(*,'(7X,A30,A35)') 'Please Enter Data ...... Press',
  216.      A                        ' <RET> to Tab to Next Location     '
  217. C
  218. C           DISPLAY ALL DATA FROM SELECTED CAR
  219. C
  220.    50 CONTINUE
  221.       IV=8
  222.       IH=21
  223.       CALL UPTOP(IH,IV)
  224.          WRITE(*,'(A20)') NAME(SEL)
  225.       IV=10
  226.       IH=21
  227.       CALL UPTOP(IH,IV)
  228.          WRITE(*,'(A20)') IDNUM(SEL)
  229.       IV=14
  230.       IH=24
  231.       CALL UPTOP(IH,IV)
  232.          WRITE(*,'(A8)') DATE(1,SEL)
  233.       IV=14
  234.       IH=41
  235.       CALL UPTOP(IH,IV)
  236.          WRITE(*,'(F8.2)') COST(1,SEL)
  237.       IV=14
  238.       IH=61
  239.       CALL UPTOP(IH,IV)
  240.       WRITE(*,'(F9.2)') ODOM(1,SEL)
  241. C
  242. C        ASK FOR ALL INFO TO LOG A SOLD CAR
  243. C
  244.   200 CONTINUE
  245.       TEST=' '
  246.       CALL EDATE(24,16,TEST)
  247.       IF(TEST.EQ.' ') THEN
  248.          CALL BELL
  249.          GOTO 200
  250.       ELSE
  251.          DATE(2,SEL)=TEST 
  252.       ENDIF
  253. C
  254.   300 CONTINUE
  255.       GALS=0.0
  256.       CALL EDREL(41,16,GALS,8)
  257.       IF(GALS.LE.0.0) THEN   
  258.          CALL BELL
  259.          GOTO 300
  260.       ELSE
  261.          COST(2,SEL)=GALS 
  262.       ENDIF
  263. C
  264.   400 CONTINUE
  265.       GALS=0.0
  266.       CALL EDREL(61,16,GALS,9)
  267.       ODOM(2,SEL)=GALS
  268. C
  269.   900 CONTINUE
  270.       RETURN
  271.       END
  272. C
  273. C
  274. C
  275.       SUBROUTINE EDITIT
  276. C
  277.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  278.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  279.       CHARACTER RFILE(25)*11,MFILE(25)*11
  280. C
  281.       COMMON/MAIN2/ COST,ODOM,VNUM
  282.       INTEGER VNUM
  283.       REAL COST(2,25),ODOM(2,25)
  284. C
  285.       INTEGER TYPE,SEL
  286.       CHARACTER TEST*8,RAMDSK*80
  287.       REAL GALS
  288. C
  289. C           LIST ALL CARS ON FILE
  290. C
  291.       TYPE=0
  292.       CALL CLEAN
  293.       CALL LISTEM(TYPE,SEL)
  294.       CALL CLEAN
  295.       IF(SEL.EQ.0) GOTO 900
  296.  
  297.       CALL MAP
  298.       CALL MOVEIT(1,23)
  299.       WRITE(*,'(7X,A30,A35)') 'Please Enter Data ...... Press',
  300.      A                        ' <RET> to Tab to Next Location     '
  301. C
  302. C           DISPLAY ALL DATA FOR SELECTED CAR          
  303. C
  304.    50 CONTINUE
  305.       IV=8
  306.       IH=21
  307.       CALL UPTOP(IH,IV)
  308.          WRITE(*,'(A20)') NAME(SEL)
  309.       IV=10
  310.       IH=21
  311.       CALL UPTOP(IH,IV)
  312.          WRITE(*,'(A20)') IDNUM(SEL)
  313.       IV=14
  314.       IH=24
  315.       CALL UPTOP(IH,IV)
  316.          WRITE(*,'(A8)') DATE(1,SEL)
  317.       IV=14
  318.       IH=41
  319.       CALL UPTOP(IH,IV)
  320.          WRITE(*,'(F8.2)') COST(1,SEL)
  321.       IV=14
  322.       IH=61
  323.       CALL UPTOP(IH,IV)
  324.       WRITE(*,'(F9.2)') ODOM(1,SEL)
  325.       IV=16
  326.       IH=24
  327.       CALL UPTOP(IH,IV)
  328.          WRITE(*,'(A8)') DATE(2,SEL)
  329.       IV=16
  330.       IH=41
  331.       CALL UPTOP(IH,IV)
  332.          WRITE(*,'(F8.2)') COST(2,SEL)
  333.       IV=16
  334.       IH=61
  335.       CALL UPTOP(IH,IV)
  336.       WRITE(*,'(F9.2)') ODOM(2,SEL)
  337. C
  338. C           NOW BACK TO THE TOP, AND EDIT STUFF
  339. C
  340.       RAMDSK=NAME(SEL)
  341.          CALL EDCHR(21,8,RAMDSK,20)
  342.       NAME(SEL)=RAMDSK
  343.       RAMDSK=IDNUM(SEL)
  344.          CALL EDCHR(21,10,RAMDSK,20)
  345.       IDNUM(SEL)=RAMDSK
  346.       TEST=DATE(1,SEL)
  347.          CALL EDATE(24,14,TEST)
  348.       DATE(1,SEL)=TEST 
  349.       GALS=COST(1,SEL)   
  350.          CALL EDREL(41,14,GALS,8)
  351.       COST(1,SEL)=GALS 
  352.       GALS=ODOM(1,SEL)
  353.          CALL EDREL(61,14,GALS,9)
  354.       ODOM(1,SEL)=GALS
  355.       TEST=DATE(2,SEL)
  356.          CALL EDATE(24,16,TEST)
  357.       DATE(2,SEL)=TEST 
  358.       GALS=COST(2,SEL)
  359.          CALL EDREL(41,16,GALS,8)
  360.       COST(2,SEL)=GALS 
  361.       GALS=ODOM(2,SEL)
  362.          CALL EDREL(61,16,GALS,9)
  363.       ODOM(2,SEL)=GALS
  364.   900 CONTINUE
  365.       RETURN
  366.       END
  367. C
  368. C
  369. C
  370.       SUBROUTINE CLEAN
  371. C
  372.       CALL UPTOP(1,5)
  373.       DO 100 K=1,15
  374.       WRITE(*,'(1X,A1,A3)') 27,'[2K'
  375.   100 CONTINUE
  376.       RETURN
  377.       END
  378.