program qsx cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c QSX - Accounting file fixup program c c This program scans the accounting file created by the KMS c accounting system and fixes up erroneous records. c c Author: Don Rubin Version: 1.0 January 1982 c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c integer*2 ibuf(13),today(3),stdate(3),stpdat(3) integer*2 curtim(3),curdat(3),uics(2,50),zero(3) integer*4 iqios,cputim logical*1 totals,sumday,termid(2),uic(2),q,ok,infile(24) c common uics c c -- start record c equivalence (irec,ibuf(1)) equivalence (ihr,ibuf(2)) equivalence (imin,ibuf(3)) equivalence (isec,ibuf(4)) equivalence (iyear,ibuf(5)) equivalence (imonth,ibuf(6)) equivalence (iday,ibuf(7)) c c -- hel/bye record c equivalence (termid,ibuf(5)) equivalence (iacnt,ibuf(6)) equivalence (uic,ibuf(7)) equivalence (cputim,ibuf(8)) ! i*4 word matches 2 bfr words equivalence (iqios,ibuf(10)) ! i*4 word matches 2 bfr words equivalence (irunct,ibuf(12)) equivalence (insct,ibuf(13)) c c prompt for and open input file c type 99 99 format('$Enter input filename ') accept 81,j,infile if(j.le.0)call exit infile(J+1)=0 c open(unit=1, ! open default file - file = infile, ! - form = 'UNFORMATTED', ! - status = 'OLD', ! - access = 'SEQUENTIAL', ! - err = 9000) ! c open(unit=2, ! open output file - file = 'FIXED.FIL', ! - form = 'UNFORMATTED', ! - status = 'NEW', ! - access = 'SEQUENTIAL', ! - err = 9000) ! c type 90 90 format('$Enter bad date (in the form DD,MM,YY) ') accept 80,stdate c type 91 91 format('$Enter correct date (in the form DD,MM,YY) ') accept 80,stpdat c type 92 92 format('$How many changes should be made ') accept 80,ichang c c loop for each record in the input file c 111 read(1,end=150,err=9100)ibuf c if(iabs(irec).ne.1)goto 100 call atday(ibuf,stdate,ok) !check to see if not at date if(.not.ok)goto 100 ! skip it c if(jrec.ge.ichang)goto 100 !we've changed enough records jrec=jrec+1 type*,'change made from',ibuf(2),ibuf(3),ibuf(4),'to',stpdat iyear=stpdat(3) imonth=stpdat(2) iday=stpdat(1) c 100 write(2)ibuf goto 111 c c end of file c 150 close (unit=1) close (unit=2) call exit 80 format(3i5) 81 format(q,24a1) 9100 stop 'error during read' 9000 stop 'error during open' end subroutine atday(ibuf,date,ok) c c This routine compares two dates c integer*2 ibuf(1),date(1) logical*1 ok c if(ibuf(5).ne.date(3))goto 2 if(ibuf(6).ne.date(2))goto 2 if(ibuf(7).ne.date(1))goto 2 ok=.true. return 2 ok=.false. end