C C VEHICLE MAINTENANCE PRGM by Bruce W. Roeckel C *--------------------------* C OPTION #1 - MASTER C $STORAGE:2 C SUBROUTINE MASTER 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 CHARACTER OPTION*25,ICODE*1 C C DISPLAY HEADER C 50 CONTINUE OPTION='Master File Update' CALL HEADER(OPTION) C C DRAW THE PROMPT LINE C CALL MOVEIT(1,21) CALL BOLD CALL ULINE WRITE(*,'(80X)') CALL OFF C 75 CONTINUE CALL MAP CALL MOVEIT(1,23) WRITE(*,'(6X,A35,A35,\)') A '( )uy ( )ell ( )dit ( )elp ', B '( )uit Option ==> [ ] ' CALL BOLD CALL UPTOP(10,23) WRITE(*,'(A1)') 'B' CALL UPTOP(18,23) WRITE(*,'(A1)') 'S' CALL UPTOP(27,23) WRITE(*,'(A1)') 'E' CALL UPTOP(36,23) WRITE(*,'(A1)') 'H' CALL UPTOP(45,23) WRITE(*,'(A1)') 'Q' 100 CONTINUE CALL UPTOP(74,23) CALL OFF CALL CURLT(4) READ(*,'(A1)',ERR=200) ICODE IF(ICODE.EQ.' ') THEN GOTO 200 ELSEIF(ICODE.EQ.'Q' .OR. ICODE.EQ.'q') THEN RETURN ELSEIF(ICODE.EQ.'H' .OR. ICODE.EQ.'h') THEN ICODE='1' IUNIT=15 CALL HELP(ICODE,IUNIT) GOTO 50 ELSEIF(ICODE.EQ.'B' .OR. ICODE.EQ.'b') THEN CALL BUYIT GOTO 75 ELSEIF(ICODE.EQ.'S' .OR. ICODE.EQ.'s') THEN CALL SELLIT GOTO 75 ELSEIF(ICODE.EQ.'E' .OR. ICODE.EQ.'e') THEN CALL EDITIT GOTO 75 ENDIF 200 CONTINUE CALL BELL GOTO 100 END C C C SUBROUTINE MAP C C DISPLAY FULL-SCREEN-EDIT MAP C CALL UPTOP(1,7) CALL BOLD WRITE(*,100) 100 FORMAT( A /,10X,'Vehicle: ', B //,10X,' ID #: ', C //, D //,10X,'Purchased : for $ ', D 'Mileage: ', E //,10X,' Sold : for $ ', E 'Mileage: ') CALL OFF C CALL UPTOP(21,8) WRITE(*,'(A20)') '____________________' CALL UPTOP(21,10) WRITE(*,'(A20)') '____________________' CALL UPTOP(24,14) WRITE(*,'(A8)') '__/__/__' CALL UPTOP(41,14) WRITE(*,'(A8)') '________' CALL UPTOP(61,14) WRITE(*,'(A9)') '_________' CALL UPTOP(24,16) WRITE(*,'(A8)') '__/__/__' CALL UPTOP(41,16) WRITE(*,'(A8)') '________' CALL UPTOP(61,16) WRITE(*,'(A9)') '_________' C RETURN END C C C SUBROUTINE BUYIT 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 CHARACTER TEST*8,RAMDSK*80 REAL GALS C VNUM=VNUM+1 IF(VNUM.GT.25) RETURN CALL MOVEIT(1,23) WRITE(*,'(7X,A30,A35)') 'Please Enter Data ...... Press', A ' to Tab to Next Location ' C C ASK FOR ALL DATA REQUIRED TO LOG A NEW PURCHASE C RAMDSK=' ' CALL EDCHR(21,8,RAMDSK,20) IF(NAME(VNUM).EQ.' ') THEN VNUM=VNUM-1 RETURN ELSE NAME(VNUM)=RAMDSK RAMDSK=' ' CALL EDCHR(21,10,RAMDSK,20) IDNUM(VNUM)=RAMDSK C 200 CONTINUE TEST=' ' CALL EDATE(24,14,TEST) IF(TEST.EQ.' ') THEN CALL BELL GOTO 200 ELSE DATE(1,VNUM)=TEST ENDIF C 300 CONTINUE GALS=0.0 CALL EDREL(41,14,GALS,8) IF(GALS.LE.0.0) THEN CALL BELL GOTO 300 ELSE COST(1,VNUM)=GALS ENDIF C GALS=0.0 CALL EDREL(61,14,GALS,9) ODOM(1,VNUM)=GALS ENDIF C C INITIALIZE ALL OTHER VARIABLES C COST(2,VNUM)=0.0 DATE(2,VNUM)=' ' ODOM(2,VNUM)=0.0 RFILE(VNUM)=' ' MFILE(VNUM)=' ' C RETURN END C C C SUBROUTINE SELLIT 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 INTEGER TYPE,SEL CHARACTER TEST*8 REAL GALS C C LIST ALL CARS ON FILE C TYPE=1 CALL CLEAN CALL LISTEM(TYPE,SEL) CALL CLEAN IF(SEL.EQ.0) GOTO 900 CALL MAP CALL MOVEIT(1,23) WRITE(*,'(7X,A30,A35)') 'Please Enter Data ...... Press', A ' to Tab to Next Location ' C C DISPLAY ALL DATA FROM SELECTED CAR C 50 CONTINUE IV=8 IH=21 CALL UPTOP(IH,IV) WRITE(*,'(A20)') NAME(SEL) IV=10 IH=21 CALL UPTOP(IH,IV) WRITE(*,'(A20)') IDNUM(SEL) IV=14 IH=24 CALL UPTOP(IH,IV) WRITE(*,'(A8)') DATE(1,SEL) IV=14 IH=41 CALL UPTOP(IH,IV) WRITE(*,'(F8.2)') COST(1,SEL) IV=14 IH=61 CALL UPTOP(IH,IV) WRITE(*,'(F9.2)') ODOM(1,SEL) C C ASK FOR ALL INFO TO LOG A SOLD CAR C 200 CONTINUE TEST=' ' CALL EDATE(24,16,TEST) IF(TEST.EQ.' ') THEN CALL BELL GOTO 200 ELSE DATE(2,SEL)=TEST ENDIF C 300 CONTINUE GALS=0.0 CALL EDREL(41,16,GALS,8) IF(GALS.LE.0.0) THEN CALL BELL GOTO 300 ELSE COST(2,SEL)=GALS ENDIF C 400 CONTINUE GALS=0.0 CALL EDREL(61,16,GALS,9) ODOM(2,SEL)=GALS C 900 CONTINUE RETURN END C C C SUBROUTINE EDITIT 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 INTEGER TYPE,SEL CHARACTER TEST*8,RAMDSK*80 REAL GALS C C LIST ALL CARS ON FILE C TYPE=0 CALL CLEAN CALL LISTEM(TYPE,SEL) CALL CLEAN IF(SEL.EQ.0) GOTO 900 CALL MAP CALL MOVEIT(1,23) WRITE(*,'(7X,A30,A35)') 'Please Enter Data ...... Press', A ' to Tab to Next Location ' C C DISPLAY ALL DATA FOR SELECTED CAR C 50 CONTINUE IV=8 IH=21 CALL UPTOP(IH,IV) WRITE(*,'(A20)') NAME(SEL) IV=10 IH=21 CALL UPTOP(IH,IV) WRITE(*,'(A20)') IDNUM(SEL) IV=14 IH=24 CALL UPTOP(IH,IV) WRITE(*,'(A8)') DATE(1,SEL) IV=14 IH=41 CALL UPTOP(IH,IV) WRITE(*,'(F8.2)') COST(1,SEL) IV=14 IH=61 CALL UPTOP(IH,IV) WRITE(*,'(F9.2)') ODOM(1,SEL) IV=16 IH=24 CALL UPTOP(IH,IV) WRITE(*,'(A8)') DATE(2,SEL) IV=16 IH=41 CALL UPTOP(IH,IV) WRITE(*,'(F8.2)') COST(2,SEL) IV=16 IH=61 CALL UPTOP(IH,IV) WRITE(*,'(F9.2)') ODOM(2,SEL) C C NOW BACK TO THE TOP, AND EDIT STUFF C RAMDSK=NAME(SEL) CALL EDCHR(21,8,RAMDSK,20) NAME(SEL)=RAMDSK RAMDSK=IDNUM(SEL) CALL EDCHR(21,10,RAMDSK,20) IDNUM(SEL)=RAMDSK TEST=DATE(1,SEL) CALL EDATE(24,14,TEST) DATE(1,SEL)=TEST GALS=COST(1,SEL) CALL EDREL(41,14,GALS,8) COST(1,SEL)=GALS GALS=ODOM(1,SEL) CALL EDREL(61,14,GALS,9) ODOM(1,SEL)=GALS TEST=DATE(2,SEL) CALL EDATE(24,16,TEST) DATE(2,SEL)=TEST GALS=COST(2,SEL) CALL EDREL(41,16,GALS,8) COST(2,SEL)=GALS GALS=ODOM(2,SEL) CALL EDREL(61,16,GALS,9) ODOM(2,SEL)=GALS 900 CONTINUE RETURN END C C C SUBROUTINE CLEAN C CALL UPTOP(1,5) DO 100 K=1,15 WRITE(*,'(1X,A1,A3)') 27,'[2K' 100 CONTINUE RETURN END