Hi Jeff, the entire program is a loop prompting the user for input ... once it has all of the input it writes a record to the output file, then it prompts the user for input again .... and so on.
the following is the program:
program time4tax
implicit none
integer i,j,add1,k,cnt,l,m,i1,i2,taxcn,taxvn,addn,err,iostat,cerr,ivn,icn,ian,id4,id5
integer derr,verr,terr,aerr,serr,perr,dparsl,vparsl,vpars1l,ir,ist
character vparsc(8),vparst(16),vparsa(5),vparss(30),v13
integer ispace,isave1,isave2,scol,vi,cstart,db
integer isave3,isave4,isave5,isave6,vparscl,vparstl,vparsal,vparssl
character line(80)*1, date(5),vendor(20),cost(8),taxcat(20),vline(16)
character vndr(20),vndrs(25,20),v(50,20),taxcatg(25,20),taxadd(25,20)
character addres(20),desc(20),idate(5),dpars(5),vpars(16),vpars1(16),digng(12)
character c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,cc(10),b3*3,dte,iomsg*50,d3*3
character*50 erroro,errorc
common date,vendor,cost,b3,cstart,digng,taxvn,taxcatg,taxcat,taxadd,vndrs,db,addn,addres,desc,taxcn
digng(1)="1"
digng(2)="2"
digng(3)="3"
digng(4)="4"
digng(5)="5"
digng(6)="6"
digng(7)="7"
digng(8)="8"
digng(9)="9"
digng(10)="0"
digng(11)="."
digng(12)="$"
open(unit=120,file="taxout1.txt",position="append",action="write",IOMSG=erroro,err=125,iostat=ir)
open(unit=107,file="taxvnd.txt",recl=80)
open(unit=108,file="taxcat.txt",recl=80)
open(unit=109,file="taxadd.txt",recl=80)
rewind 107
rewind 108
rewind 109
!If db = 0 all debug msgs are off if db = 1 all msgs are on
db=0
! blank out the 3 arrays
do 5 i=1,25
do 6 j=1,20
vndrs(i,j)=" "
taxcatg(i,j)=" "
if (j.le.5) taxadd(i,j)=" "
6 CONTINUE
5 continue
! reading the tax.vndrs file into vndrs(i,j)
do i=1,25
do j=1,20
vndrs(i,j)=" "
end do
end do
do i=1,25
read (unit=107,fmt=227,end=903,err=919) (vndrs(i,j),j=1,20)
227 format (20a1)
end do
903 ivn=I-1
taxvn=i-1
! do 332 i=1,taxvn
! 332 print *,"main vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
!332 write (*,866) (vndrs(i,j),j=1,20)
!866 format (20o4)
! reading the tax.catg file into taxcatg(i,j)
do i=1,25
do j=1,20
taxcatg(i,j)=" "
end do
end do
do i=1,25
read (unit=108,fmt=228,end=904,err=919) (taxcatg(i,j),j=1,20)
228 format (20a1)
end do
904 icn=i-1
taxcn=i-1
do i=1,25
do j=1,20
taxadd(i,j)=" "
end do
end do
! reading the tax.add file into taxadd(i,j)
do i=1,25
read (unit=109,fmt=229,end=905,err=919) (taxadd(i,j),j=1,20)
229 format (20a1)
end do
905 ian=i-1
addn=i-1
! read user entry, OUTPUT file format is --> DATE Vendor COST TAX CATEGORY ADDRESS DESCRIPTION OF EXPENSE
! 5 cols 20 cols 8 cols 2016 cols 20 cols 20 co
print *," "
print *,"Time4tax written by Imre Varga, July 2018. Brought to you by Fun Software CopyWrite Aug. 2018 "
print *," "
print *,"Please enter receipt information in the following input format."
print *,"5 20 8 20 20 20"
Print *,"11111 22222222222222222222 33333333 44444444444444444444 55555555555555555555 66666666666666666666"
print *,"Date Vendor Cost Tax Category Address Description"
print *,"07/04 OSH 42 01 1147 New frontdoor lockset"
print *,"06-10 17 $4.79 05 410 New toilet flapper"
print *,"0523 3 12.89 10 917 Two drill bits"
print *,"0802 Ace Hardware $300 8 729 Sunnyvale dumps"
print*," "
print *,"There are ",ivn," vendors."
print *,"There are ",icn," tax categories."
print *,"There are ",ian," addresses."
print *," "
print *,"Enter 'quit' or 'exit' to terminate program, '?' for help. "
print *," "
print *," "
Print *," "
111 continue
derr=0
verr=0
cerr=0
terr=0
aerr=0
serr=0
811 print *," "
print *,"Date Vendor Cost Tax Category Address Description"
read (*,1) line
1 format(80a1)
! if (line(1).eq."?") call sethlp
! if (line(1).eq."?") go to 999
if (line(1).ne."?") go to 711
write (*,101)
101 format (///,"Tax Categories Addresses Vendors")
do i=1,25
write (*,102) (taxcatg(i,j),j=1,20),(taxadd(i,j),j=1,20),(vndrs(i,j),j=1,20)
102 format (20a1,5x,20a1,7x,20a1)
END DO
go to 811
711 continue
if ((line(1).eq."d").and.(line(2).eq."b").and.(line(3).eq."0")) db=0
if ((line(1).eq."d").and.(line(2).eq."b").and.(line(3).eq."1")) db=1
! if (db.eq.0) print *,"Debug mode is off"
! if (db.eq.1) print *,"Debug mode is on"
if ((line(1).eq."d").and.(line(2).eq."b").and.(line(3).eq."0")) go to 811
if ((line(1).eq."d").and.(line(2).eq."b").and.(line(3).eq."1")) go to 811
if ((line(1).eq."q").and.(line(2).eq."u").and.(line(3).eq."i").and.(line(4).eq."t")) go to 999
if ((line(1).eq."e").and.(line(2).eq."x").and.(line(3).eq."i").and.(line(4).eq."t")) go to 999
25 if (line(1) .eq. " ") go to 31
goto 30
31 continue
cnt=80
do i=1,79
line(i)= line(i+1)
cnt=cnt-1
end do
go to 25
30 continue
do i=1,79
36 if ((line(i) .eq. " ") .and. (line(i+1) .eq. " ")) go to 33
go to 34
33 continue
j=1
do j=i,79
line(j)=line(j+1)
end do
do k=i,80
if (line(k) .ne. " ") go to 36
end do
34 end do
! do 3322 i=1,taxvn
!3322 print *,"b4 call parsim vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
! do 3326 i=1,taxvn
! 3326 print *,"main vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
!3326 write (*,8661) (vndrs(i,j),j=1,20)
!8661 format (10x,20o4)
call parsin(line,perr,dpars,dparsl,vpars,vparsl,vparsc,vparscl,vparst,vparstl,vparsa,vparss,isave1,v13,vi)
! print *,"after sub parsin=",cost,"XX"
! write (*,2299) vendor,cost,date
!2299 format("octal vendor=",20o4,5x,8o4,5x,5o4)
! do 3323 i=1,taxvn
! 332 print *,"main vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
!3323 write (*,8664) (vndrs(i,j),j=1,20)
!8664 format (20x,20o4)
8877 continue
print *,"Writing: ",date," ",vendor," ",cost," ",taxcat," ",addres," ",desc
write (unit=120,fmt=123,err=125,iostat=ist) date,vendor,cost,taxcat,addres,desc
123 format (5a1,1x,20a1,1x,8a1,1x,20a1,1x,20a1,1x,20a1)
564 go to 111
909 print *,"read end EOF"
go to 999
125 print *,"Write err to file tax.data"
go to 999
919 print *,"read err"
91 continue
print *,("Open error on unit 120, err="),err
999 continue
close (unit=120,iomsg=errorc)
130 if (err.ne.0) print *,"Error occured closing unit 120 err=",err
if (iostat.ne.0) print *,"Iostat error inn closing unit 4,iostat=",iostat
end program time4tax
!===========================================================================
subroutine parsin (line,perr,dpars,dparsl,vpars,vparsl,vparsc,vparscl,vparst,vparstl,vparsa,vparss,isave1,v13,vi)
character line(80)*1,dpars(5),vpars(16),vpars1(16),digng(12),v13,date(5),vendor(20),cost(8),taxcd1,taxcd2
character vparsc(8),vparst(16),vparsa(5),vparss(30),taxcatg(25,20),taxcat(20),txcd1,txcd2,b3*3
character taxadd(25,20),vndrs(25,20),desc(20)
integer perr,dparsl,vparsl,vpars1l,ispace,isave1,isave2,scol,vi,cstart,taxcn,taxst,taxvn
integer isave3,isave4,isave5,isave6,vparscl,vparstl,vparsal,vparssl,bc,addn,addrs
common date,vendor,cost,b3,cstart,digng,taxvn,taxcatg,taxcat,taxadd,vndrs,db,addn,addres,desc,taxcn
character s1(20),s2(20),s3(20),s4(20),s5(20),s6(20),s7(20),s1tmp(5),s2tmp(2),addres(20),s4tmp(2)
integer s1len,s2len,s3len,s4len,s5len,s6len,s7len,s1st,s2st,s3st,s4st,s5st,s6st,s7st
integer s1end,s2end,s3end,s4end,s5end,s6end,s7end,idate,db
! do 3321 i=1,taxvn
! !3321 print *,"just in parsim vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
! do 3320 i=1,taxvn
! 332 print *,"main vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
!3320 write (*,866) (vndrs(i,j),j=1,20)
!866 format ("in parsin beging ",20o4)
! do 3329 ijk=1,taxvn
! write (*,3328) (vndrs(ijk,ix),ix=1,20)
!3328 format ("write 3328 stmnt=",20a1)
!3329 continue
do 4 i=1,20
s1(i)=" "
s2(i)=" "
s3(i)=" "
s4(i)=" "
s5(i)=" "
s6(i)=" "
vendor(i)=" "
taxcat(i)=" "
addres(i)=" "
desc(i)=" "
if (i.le.5) date(i)=" "
4 if (i.le.8) cost(i)=" "
do 1087 i=1,132
if (line(i).ne." ") go to 1087
s1st =1
s1end = i-1
s1len = s1end-s1st+1
iii=1
do 11 ii=s1st,s1end
s1(iii)=line(ii)
11 iii=iii+1
go to 12
1087 continue
12 continue
s2st=i+1
do 23 i=i+1,132
if (line(i).ne." ") go to 23
s2end = i-1
s2len = s2end-s2st+1
iii=1
do 21 ii=s2st,s2end
s2(iii)=line(ii)
21 iii=iii+1
go to 22
23 continue
22 continue
s3st=i+1
do 30 i=i+1,132
if (line(i).ne." ") go to 30
s3end = i-1
s3len = s3end-s3st+1
iii=1
do 31 ii=s3st,s3end
s3(iii)=line(ii)
31 iii=iii+1
go to 32
30 continue
32 continue
s4st=i+1
do 40 i=i+1,132
if (line(i).ne." ") go to 40
s4end = i-1
s4len = s4end-s4st+1
iii=1
do 41 ii=s4st,s4end
s4(iii)=line(ii)
41 iii=iii+1
go to 42
40 continue
42 continue
s5st=i+1
do 50 i=i+1,132
if (line(i).ne." ") go to 50
s5end = i-1
s5len = s5end-s5st+1
iii=1
do 51 ii=s5st,s5end
s5(iii)=line(ii)
51 iii=iii+1
go to 52
50 continue
52 continue
s6st=i+1
do 60 i=i+1,132
if (line(i).ne." ") go to 60
s6end = i-1
s6len = s6end-s6st+1
iii=1
do 61 ii=s6st,s6end
s6(iii)=line(ii)
61 iii=iii+1
go to 62
60 continue
62 continue
! do 3032 i=1,taxvn
! !3032 print *,"492 vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
! print *," "
! print *,"s1st=",s1st," s1end=",s1end," s1len=",s1len," s1=",s1
! print *,"s2st=",s2st," s2end=",s2end," s2len=",s2len," s2=",s2
! print *,"s3st=",s3st," s3end=",s3end," s3len=",s3len," s3=",s3
! print *,"s4st=",s4st," s4end=",s4end," s4len=",s4len," s4=",s4
! print *,"s5st=",s5st," s5end=",s5end," s5len=",s5len," s5=",s5
! print *,"s6st=",s6st," s6end=",s6end," s6len=",s6len," s6=",s6
! Lets do some data type checking
! Date - check if all digits are 0-9 and an optional -or / quick chk of month and day, 5 digits max
! Vendor - any character string ok, if a vendor is manually entered it can be 2 words
! eachword can be up to 10 characters, a 2 digit vendor code can be entered
! which must have a match in taxvnd.txt
! Cost - needs to have digits 0-9 a period . and an optional $ sign, 10 digits max
! Tax category - 1 or 2 numeric digits, entry must be in taxcat.txt
! Address - any thing ok, but has to be a matching entry in taxadd.txt, 5 digits max
! Description - any character stringm up to 20 chars long
! Start date check
! print *,"start date chk",s1len,s1(1)
if (s1len.ge.6 .or. s1len.le.3) print *,"Invalid Date"
if (s1len.ge.6 .or. s1len.le.3) go to 410
do 880 i=1,5
880 s1tmp(i)=s1(i)
! print *,"s1tmp+",s1tmp
if (s1len.eq.5) s1tmp(3)=s1(4)
if (s1len.eq.5) s1tmp(4)=s1(5)
do 882 i=1,4
888 do 881 j=1,10
! print *,"s1tmp(i)=",s1tmp(i)," digng(j)=",digng(j)," ",i," ",j
! write (*,222) s1(i),digng(j)
!222 format (o3,3x,o3)
if(s1tmp(i).eq.digng(j)) go to 415
881 continue
print *,"invalid date"
go to 410
415 continue
882 continue
516 continue
if (s1tmp(1).ne."0" .and. s1tmp(1).ne."1") print *,"Invalid date"
if (s1tmp(1).ne."0" .and. s1tmp(1).ne."1") go to 410
if (s1len.eq.4.and.s1tmp(1).ne."0".and.s1tmp(1).ne."1".and.s1tmp(1).ne."2".and.s1tmp(1).ne."3") print *,"invalid Date"
if (s1len.eq.4.and.s1tmp(1).ne."0".and.s1tmp(1).ne."1".and.s1tmp(1).ne."2".and.s1tmp(1).ne."3") go to 410
date(1)=s1tmp(1)
date(2)=s1tmp(2)
date(3)="/"
date(4)=s1tmp(3)
date(5)=s1tmp(04)
! !! print *,"date=",date,"XX s1tmp=",s1tmp,"XX s1=",s1,"XX"
! Date check done
!Start vendor check
!410 continue error exit record
!417 continue fake out blank entry, put 3rd string as 4th string
!418 continue just an fyi, contiue
!Come to 420 if a 1 or 2 digit vendor code was entered
418 continue
417 continue
if (s2len.eq.1) s2tmp(1)="0"
if (s2len.eq.1) s2tmp(2)=s2(1)
if (s2len.eq.2) s2tmp(1)=s2(1)
if (s2len.eq.2) s2tmp(2)=s2(2)
! print *,"s2len=",s2len," s2tmp(1)",s2tmp(1)," s2tmp(2)=",s2tmp(2)," s2(1)=",s2(1),s2(2)," s2st=",s2st
do i=1,10
if (s2tmp(1).eq.digng(I)) go to 425
end do
Print *,"Invalid vendor code."
go to 410
425 continue
do i=1,10
! print *,s2tmp(1),"xx",digng(i),"XX",s2tmp(2),"XX"
if (s2tmp(2).eq.digng(I)) go to 4251
end do
Print *,"Invalid Vendor code"
go to 410
4251 continue
! Vendor check done
! do 33002 i=1,taxvn
! 33002 print *,"4251 vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
! Start cost check
do 443 i=1,s3len
do 444 j=1,11
! print *,"s3(i)=",s3(i)," digng(j)=",digng(j)," i=",i," j=",j,j
if (s3(i).eq.digng(j)) go to 443
444 continue
print *,"Invalid cost was entered"
go to 410
443 continue
cost(1)="$"
do 3021 i=2,8
3021 cost(i)=" "
do 456 i=1,8-s3len
456 cost(i)=" "
do 457 j=1,s3len
! print *,"j=",j," s3len=",s3len," s3(j)=",s3(j)," Cost(8-s3len+j)=",cost(8-s3len+j)
457 cost(8-s3len+j)=s3(j)
! print *,"COST=",cost," s3len=",s3len," s3st=",s3st
426 continue
422 continue
410 continue
! cost chk done
!go to 765
! get the vendor descriptopn from the vendor code
! do 332 i=1,taxvn
! 332 print *,"332 vndrs=",(vndrs(i,j),j=1,20)," i j=",i,j
! write (*,665)vendor
!665 format(20o4)
do 887 jj=1,20
887 vendor(jj)=" "
!! write (*,987) vendor
do i=1,taxvn
! write (*,665) vendor
!0 print *,"s5(s5st)=", s5(s5st)," vndrs(i,1)=",vndrs(i,1)," s5(s5st+1)=",s5(s5st+1)," vndrs(i,2)=",vndrs(i,2)
! print *," s2(1)=",s2(1)," vndrs(i,1)=",vndrs(i,1)," s2(2)=",s2(2)," vndrs(i,2)=",vndrs(i,2)," i=",i
if (s2tmp(1).eq.vndrs(i,1) .and. s2tmp(2).eq.vndrs(i,2)) go to 389
end do
print * ,"The specified vendor num does not have an entry in the vendor file, vendor num will be used =>",vendor(1),vendor(2)
go to 765
389 do j=1,17
vendor(j)=vndrs(i,j+3)
end do
390 continue
! print *, "VENDOR=",vendor
! write(*,987) vendor
! 987 format (20o3)
! write (*,665) vendor
! lets get the tax category
if (s4len.eq.1) s4tmp(1)="0"
if (s4len.eq.1) s4tmp(2)=s4(1)
if (s4len.eq.2) s4tmp(1)=s4(1)
if (s4len.eq.2) s4tmp(2)=s4(2)
do i=1,10
! print *,"s4tmp(1)=",s4tmp(1)," digng(i)=",digng(i)
if (s4tmp(1).eq.digng(I)) go to 4125
end do
Print *,"Invalid vendor code."
go to 410
4125 continue
do i=1,10
! print *,"in 4125 loop s4tmp(2)=",s4tmp(2),"xx digng(i)=",digng(i),"XX",s2tmp(2),"XX"
if (s4tmp(2).eq.digng(I)) go to 4253
end do
Print *,"Invalid Vendor code"
go to 410
4253 continue
! print *,"XXXXXXXXXXXXXXXXXXXXXX taxcn=",taxcn
do i=1,taxcn
! print *,"s4tmp(1)=",s4tmp(1)," s4tmp(2)=",s4tmp(2)," taxcatg(i,1)=",taxcatg (i,1)," taxcatg(i,2)=",taxcatg(i,2)
if (s4tmp(1).eq.taxcatg(i,1) .and. s4tmp(2).eq.taxcatg(i,2)) go to 3897
end do
print * ,"The specified tax category num does not have an entry in the tax category file, schedule e 1040"
go to 3907
3897 do j=1,17
! print *,"taxcat(j)=",taxcat(j)," taxcatg(i,j+3)=", taxcatg(i,j+3)
taxcat(j)=taxcatg(i,j+3)
end do
3907 continue
! print *,"taxcat===",taxcat
! set up descriptiom
do i=1,20
desc(i)=s6(i)
end do
! check to make sure address is valid
! do i=1,25
! write (*,776) (taxadd(i,j),j=1,20)
! 776 format ("house num",20a1)
! end do
do 549 k=1,addn
j=0
do 1009 i=1,s5len
! print *,"taxadd(k,i)=",taxadd(k,i)," s5(i)=",s5(i)," i=",i," k=",k," s5len=",s5len
if (taxadd(k,i).eq.s5(i)) j=j+1
1009 if (j.eq.s5len) go to 15
549 continue
print *,"Address not found,enter ? for list of valid addresses"
15 continue
! write (*,1611) s5
!1611 format("FINAL VALUE OF ADDRES(1-5)=",20a1)
addres(1)=s5(1)
addres(2)=s5(2)
addres(3)=s5(3)
addres(4)=s5(4)
addres(5)=s5(5)
765 continue
8888 continue
699 continue
822 continue
return
end