c ******************************************************************* c DADES.FOR c SUBRUTINES QUE ENS ELABOREN LES DADES IMPORTANTS A PARTIR DELS c PUNTS SIGNIFICATIUS TROBATS EN PUNTS.FOR, I ENS LES MOSTREN c Eudald Bogatell (1-6-1991) c David Vigo Anglada (9-1992) c ******************************************************************* C ----------------------------------------------------------------------- C Copyright (C) 2002 Pablo Laguna C C This program is free software; you can redistribute it and/or modify it C under the terms of the GNU General Public License as published by the C Free Software Foundation; either version 2 of the License, or (at your C option) any later version. C C This program is distributed in the hope that it will be useful, but C WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU C General Public License for more details. C C You should have received a copy of the GNU General Public License along C with this program; if not, write to the Free Software Foundation, Inc., C 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. C C You may contact the author by e-mail (laguna@posta.unizar.es) or postal C mail (Dpt. Ingenieria Electrónica y Comunicaciones, Grupo de Tecnología C de las Comunicaciones (GTC), Centro Politécnico Superior. Universidad C de Zaragoza, María de Luna, 3 (Pol. Actur), Edificio A, Despacho 3.16, C 50015 Zaragoza. Spain). For updates to this software, please visit C PhysioNet (http://www.physionet.org/). C _______________________________________________________________________ subroutine dades_sig (ecg, ipbeg, ippos, ipend, iqbeg, & iqpos, iqend, irpos, irrpos, isbeg, ispos, isend, & itbeg, itpos, itend, iqrs, jqrs, ifm, rmax, max, f, ns, & basel, morf, amprr, ampr, ampq, amps, ampp, ampt, durpic, & qrsint, durr, durrr, durq, durs, durp, durt, rrint, print, & ppint, qtint, qtpint, ritme, rrmed, tip, pendr, itpos2, & idis, nep, qtcint, qtpcint, k, kder, ST_am, ST_pe, & ST_in, ST_ar, freV, desV) c Aquesta subrutina es cridada desde ecgmain com una opcio, i ens exposa c les dades de manera que s'en puguin treure conclusions directament dimension irpos(8000),ecg(100000),iqrs(8000),pendr(8000) dimension itpos(8000) dimension ipbeg(8000),ippos(8000),ipend(8000),iqbeg(8000) dimension iqpos(8000),ispos(8000),isend(8000),itbeg(8000) dimension itend(8000), itpos2(8000), irrpos(8000) dimension iqend(8000) dimension isbeg(8000), morf(5,8000),i_base(8000) dimension ST_am(8000),ST_pe(8000),ST_in(8000),ST_ar(8000) dimension amprr(8000), ampr(8000), ampq(8000), amps(8000) dimension durq(8000) dimension ampp(8000), ampt(8000), durp(8000), durt(8000) dimension durpic(8000),qrsint(8000),durr(8000),durrr(8000) dimension durs(8000),rrint(8000),print(8000),ppint(8000) dimension qtint(8000) dimension qtpint(8000),basel(8000),idis(3,20),freV(8000) dimension desV(8000) dimension qtcint(8000), qtpcint(8000) character*12 f character*4 tip(8000) c ecg: senyal ECG c jqrs: nombre de qrs detectats i confirmats que tractarem c samp: interval de mostreig en ms c iqrs: posicio dels complexes QRS detectats i confirmats c irpos: vector que conti la posicio de l'ona R c ipbeg, ippos, ipend: inici, pic i final de l'ona P c iqbeg, iqpos, iqend: inici, pic i final de l'ona Q c isbeg, ispos, isend: inici, pic i final de l'ona S c itbeg, itpos, itpos2, itend: inici, pics i final de l'ona T c basel: conte les linies de base de cada QRS c idis: conte els posibles episodis de VT i VF c nep: nombre d'episodis de VT i VF c ampq, ampr, amps, amprr: amplituds de les ones Q, R, S i S' c durq, durr, durs, durrr: durades de les ones Q, R, S i R' c rrint, ppint, print: intervals RR, PP i PR c qtint, qtpint: intervals QT i QT de pic c qtcint, qtpcint: intervals QT i QT de pic corretgits. c durpic i pendr: duracio i pendent de la primera pujada de la R c morf: vector d'enters que ens informa de la morfologia del bateg c morf(1,j) -bateg 0: rr normal c 1: rr llarg c 2: rr curt c 3: primer bateg c c morf(2,j) -complex QRS 0: qRs c 1: qR c 2: Rs c 3: R c 4: rS c 5: RS c 6: rsR' c 7: QS c 8: notched R ,NR c 9: WQS c 10:Taquicardia ventricular (VT) c 11:Fibrilacio ventricular (VF) c c morf(3,j) -ona P 0: existeix, normal c 1: " , invertida c 2: no existeix c c morf(4,j) -ona T 0: existeix, normal c 1: " , invertida c 2: " , nomes pujada c 3: " , nomes baixada c 4: bifasica -+ c 5: " +- c 6: no existeix c conv: factor de conversio a volts conv= 1. samp=1000.0/ifm jep=1 c ritme: ritme cardiac en pulsacions per min ritme= 60*ifm/rrmed call baseline(jqrs,ippos,ecg,basel,samp,ipbeg,ipend,iqbeg, & isend,i_base) do i=1, jqrs c anem omplint el vector de morfologia, al mateix temps que trobem c algunes dades importants c si el qrs cau dins dun episodi de VT o VF no hi busquem cap complexe c QRS if (nep.gt.0.and.iqrs(i).ge.(idis(1,jep)+is)*ifm-ifm*0.3.and. & jep.le.nep) then if (iqrs(i).le.(idis(2,jep)+is)*ifm) then if (idis(3,jep).eq.1) then morf(2,i)=10 tip(i)=' VT ' else if(idis(3,jep).eq.2) then morf(2,i)=11 tip(i)=' VF ' end if morf(3,i)=2 morf(4,i)=6 go to 500 else jep=jep+1 end if end if if (ippos(i).eq.0) then morf(3,i)=2 else if (ecg(ippos(i)).lt.ecg(ipbeg(i)).and. & ecg(ippos(i)).lt.ecg(ipend(i))) then morf(3,i)=1 else morf(3,i)=0 end if end if c definim la morfologia de l'ona T c JA LA TENIM DEFINIDA c if(itpos(i).eq.0) then c morf(4,i)=4 c else c if (itbeg(i).eq.0) then c if (ecg(itpos(i)).gt.ecg(itend(i))) then c morf(4,i)=3 c else c morf(4,i)=2 c end if c else c if (ecg(itpos(i)).lt.ecg(itbeg(i)).or. c & ecg(itpos(i)).lt.ecg(itend(i))) then c morf(4,i)=1 c else c morf(4,i)=0 c end if c end if c end if c busquem les amplituts de les ones del QRS que mes tard ens serviran c per definir la morfologia del QRS if (irrpos(i).ne.0) then amprr(i)=abs((ecg(irrpos(i))-basel(i))*conv) else amprr(i)=0. end if ampr(i)=(ecg(irpos(i))-basel(i))*conv if (iqpos(i).eq.0) then ampq(i)=0. else ampq(i)=abs((ecg(iqpos(i))-basel(i))*conv) end if if (ispos(i).eq.0) then amps(i)=0. else amps(i)=abs((ecg(ispos(i))-basel(i))*conv) end if c busquem les amplituds de les ones P : if (ippos(i).eq.0) then amps(i)=0. else ampp(i)=abs((ecg(ippos(i))-basel(i))*conv) end if c i per l'ona T: if (morf(4,i).eq.0.or.morf(4,i).eq.1) then ampt(i)=abs((ecg(itpos(i))-ecg(itend(i)))*conv) else if (morf(4,i).eq.2.or.morf(4,i).eq.3) then if (ispos(i).ne.0) then iaux=isend(i) else iaux=basel(i) end if ampt(i)=abs((ecg(itend(i))-ecg(iaux))*conv) else if (morf(4,i).eq.4.or.morf(4,i).eq.5) then ampt(i)=abs((ecg(itpos(i))-ecg(itend(i)))*conv) iaux=abs((ecg(itpos2(i))-ecg(itend(i)))*conv) if (iaux.gt.ampt(i)) ampt(i)=iaux else ampt(i)=0. end if c definim la morfologia del QRS tip(i)='????' if (amprr(i).gt.0) then if (amps(i).le.0.) then morf(2,i)=8 tip(i)='NR' else morf(2,i)=6 tip(i)='rsRp' end if else if (ampr(i).le.0.) then if (ampq(i).gt.0..and.amps(i).gt.0.0) then morf(2,i)=9 tip(i)=' WQS' end if if(ampq(i).le.0..and.amps(i).gt.0..or.ampr(i).lt.0) then morf(2,i)=7 tip(i)=' QS' end if else if(ampq(i).gt.0..and.amps(i).gt.0.) then morf(2,i)=0 tip(i)=' qRs' end if if(amps(i).le.0..and.ampq(i).le.0.) then morf(2,i)=3 tip(i)=' R' end if if(amps(i).le.0..and.ampq(i).gt.0.) then morf(2,i)=1 tip(i)=' qR' end if if(amps(i).gt.0..and.ampq(i).le.0.) then if(amps(i)*2.lt.ampr(i)) then morf(2,i)=2 tip(i)=' Rs' else if(ampr(i)*2.lt.amps(i)) then morf(2,i)=4 tip(i)=' rS' else morf(2,i)=5 tip(i)=' RS' end if end if end if end if end if c busquem altres intervals de interes qrsint(i)=(isend(i)-iqbeg(i))*samp durpic(i)=(irpos(i)-iqbeg(i))*samp c durada de les ones del qrs if (morf(2,i).eq.6) then durr(i)=(iqend(i)-iqbeg(i))*samp durs(i)=(isbeg(i)-iqend(i))*samp durrr(i)=(isend(i)-isbeg(i))*samp durq(i)=0. else if(iqend(i).ne.0.and.isbeg(i).ne.0) then durr(i)=(isbeg(i)-iqend(i))*samp durq(i)=(iqend(i)-iqbeg(i))*samp durs(i)=(isend(i)-isbeg(i))*samp else if(iqend(i).eq.0.and.isbeg(i).ne.0) then durr(i)=(isbeg(i)-iqbeg(i))*samp durq(i)=0. durs(i)=(isend(i)-isbeg(i))*samp else if(iqend(i).ne.0.and.isbeg(i).eq.0) then durr(i)=(isend(i)-iqend(i))*samp durq(i)=(iqend(i)-iqbeg(i))*samp durs(i)=0. else if(iqend(i).eq.0.and.isbeg(i).eq.0) then durr(i)=(isend(i)-iqbeg(i))*samp durq(i)=0. durs(i)=0. end if end if c durada de les ones P i T if (ippos(i).ne.0) then durp(i)=(ipend(i)-ipbeg(i))*samp else durp(i)=0. end if if (itpos(i).ne.0) then durt(i)=(itend(i)-itbeg(i))*samp else durt(i)=0. end if c pendent de la ona R if (ampr(i).gt.0) then if ( (irpos(i)-iqbeg(i)-nint(10/samp)).ne.0) then pendr(i)=(ecg(irpos(i))-ecg(iqbeg(i)+nint(10/samp)))/ & (irpos(i)-iqbeg(i)-nint(10/samp))*conv/samp*1000. else pendr(i)=(ecg(irpos(i))-ecg(iqbeg(i)+nint(10/samp)))/ & (irpos(i)-iqbeg(i))*conv/samp*1000. end if end if c morfologia del ritme if (i.eq.1) then morf(1,1)=3 rrint(1)=0 else morf(1,i)=0 rrint(i)=(irpos(i)-irpos(i-1))*samp end if c fem les correccions necesaries pel cas complexe QS if (ampr(i).lt.0.and.morf(2,i).eq.7) then durs(i)=durr(i) durr(i)=0 pendr(i)=0 ispos(i)=irpos(i) amps(i)=abs(ampr(i)) ampr(i)=0 durpic(i)=0 end if c intervals PR i PP if (morf(3,i).eq.2) then print(i)=0. ppint(i)=0. else print(i)=(iqbeg(i)-ipbeg(i))*samp if (i.eq.1.or.morf(3,i-1).eq.2) then ppint(i)=0. else ppint(i)=(ippos(i)-ippos(i-1))*samp end if end if c intervals QT if (morf(4,i).eq.6.or.iqbeg(i).eq.0.or.itend(i).eq.0) then qtint(i)=0. qtpint(i)=0. qtcint(i)=0. qtpcint(i)=0. else if (morf(4,i).eq.3) then qtpint(i)=(itpos2(i)-iqbeg(i))*samp else qtpint(i)=(itpos(i)-iqbeg(i))*samp end if qtint(i)=(itend(i)-iqbeg(i))*samp c si el interval rr esta acotat busquem el qt corretgit if(rrint(i).gt.0.8*rrmed*samp.and. & rrint(i).lt.1.2*rrmed*samp) then qtcint(i)=qtint(i)/sqrt(rrint(i)/1000) qtpcint(i)=qtpint(i)/sqrt(rrint(i)/1000) else qtcint(i)=0. qtpcint(i)=0. end if end if 500 continue end do call impr_dat(f,ifm,ns,jqrs,morf,amprr,ampr,ampq,amps,ampp,ampt, & durpic,qrsint,durr,durrr,durq,durs,durp,durt,rrint,print, & ppint, qtint, qtpint, samp, ritme, rrmed*samp, tip, & irpos,pendr,k,kder,ST_am,ST_pe,ST_in,ST_ar,freV,desV) call impr_qt(f(1:lnblnk(f))//'.qtc',jqrs,qtcint, qtpcint) return end c--------------------------------------------------------------------------- c--------------------------------------------------------------------------- subroutine impr_qt( tit,jqrs,qtcint, qtpcint) c ens escriu en un fitxer els intervals QT i QTP corretgits dimension qtcint(8000), qtpcint(8000) character*16 tit open(unit=1, file=tit) write(1,*) ' INTERVALS QT I QT PIC CORREGITS ' do i=1,jqrs write(1,*) i, qtcint(i), qtpcint(i) end do close (unit=1) return end c--------------------------------------------------------------------------- subroutine mos_dat(f,ifm,ns,jqrs,morf,amprr,ampr,ampq,amps,ampp, & ampt,durpic,qrsint,durr,durrr,durq,durs,durp,durt,rrint, & print,ppint,qtint,qtpint,ritme,rrmed, tip, irpos, pendr, & qtcint, qtpcint, ST_am, ST_pe, ST_in, ST_ar) c aquesta subrutina ens ofereix les opcions de mostrar les dades dimension morf(5,8000),ST_am(8000),ST_pe(8000),ST_in(8000) dimension ST_ar(8000) dimension amprr(8000),ampr(8000),ampq(8000),amps(8000) dimension pendr(8000) dimension durpic(8000),qrsint(8000),durr(8000),durrr(8000) dimension durq(8000) dimension durs(8000),rrint(8000),print(8000),ppint(8000) dimension qtint(8000) dimension qtpint(8000), irpos(8000),ampp(8000),ampt(8000) dimension qtpcint(8000), qtcint(8000),durp(8000),durt(8000) character*12 f character*4 tip(8000) character*1 op logical nofi samp=1000./ifm write (6,30) 30 format (///,t20,'OPCIONS MOSTRAR DADES',///) write(6,35) 35 format (t20,'1 Pantalla',//,t20,'2 Impresora',//, & t20,'3 Extret per pantalla',///,t20,'0 sortir') 39 write(6,40) 40 format(////,'$',t20,'OPCIO: ') read(5,41,err=39) k 41 format(I2) if (k.eq.0) then return else if(k.eq.1) then write(6,50) 50 format(//,'$',t20,'Segon inicial [0.0]: ') read(5,*) segi c 51 format(f4.1) call visualitzar(f,ifm,ns,jqrs,morf,amprr,ampr,ampq,amps,ampp, & ampt,durpic,qrsint,durr,durrr,durq,durs,durp,durt,rrint, & print,ppint,qtint,qtpint,samp, ritme, rrmed, tip, irpos, & segi, pendr, qtcint, qtpcint) else if(k.eq.2) then open(unit=31, file=f(1:lnblnk(f))//'.inf') 90 write(6,100) 100 format(/,'$',t10,'Seleccio de bategs [s]: ') read(5,110) op 110 format(a) call imp_capc(f, ifm, ns, jqrs, ritme, rrmed*samp) if(op.eq.'n'.or.op.eq.'N') then do i=1,jqrs call imprimir(i,morf,amprr,ampr,ampq,amps,ampp,ampt,irpos, & ifm,durpic,qrsint,durr,durrr,durq,durs,durp,durt,rrint, & print,ppint,qtint, qtpint,tip, pendr, qtcint, qtpcint, & ST_am, ST_pe, ST_in, ST_ar) end do else nofi=.true. do while(nofi) write(6,120) 120 format(/,'$',t10,'Instant anterior al bateg en seg. ', & '[ per sortir]:') read(5,*,err=140) segi c 130 format(f4.1) go to 150 140 nofi=.false. c trobem a partir del segon anterior el bateg a mostrar 150 j=1 if (nofi) then do while(irpos(j).lt.nint(segi*ifm).and.j.le.jqrs) j=j+1 end do call imprimir(j,morf,amprr,ampr,ampq,amps,ampp,ampt,irpos,ifm, & durpic,qrsint,durr,durrr,durq,durs,durp,durt,rrint, & print,ppint, qtint, qtpint,tip, pendr, qtcint, qtpcint, & ST_am, ST_pe, ST_in, ST_ar) end if end do end if close(unit=31) else if (k.eq.3) then call vis_dat(f, ifm, ns, jqrs, morf, amprr, ampr, ampq, amps, & durpic, qrsint, durr, durrr, durq, durs, rrint, print, & ppint, qtint, qtpint, samp, ritme, rrmed*samp, tip, & irpos, pendr) end if return end c-------------------------------------------------------------------------- subroutine imprimir(i,morf,amprr,ampr,ampq,amps,ampp,ampt, & irpos,ifm,durpic,qrsint,durr,durrr,durq,durs,durp,durt, & rrint,print,ppint,qtint,qtpint,tip,pendr,qtcint,qtpcint, & ST_am, ST_pe, ST_in, ST_ar) c aquesta subroutina ens mostra per impresora les dades obtingudes c aixi com algunes clasificacions respecte les morfologies dimension morf(5,8000), irpos(8000), pendr(8000) dimension amprr(8000),ampr(8000),ampq(8000),amps(8000) dimension durpic(8000),qrsint(8000),durr(8000),durrr(8000) dimension durq(8000) dimension durs(8000),rrint(8000),print(8000),ppint(8000) dimension qtint(8000) dimension durt(8000) dimension qtpint(8000),ampp(8000),ampt(8000),durp(8000) dimension qtcint(8000), qtpcint(8000) dimension ST_am(8000),ST_pe(8000),ST_in(8000),ST_ar(8000) character*4 tip(8000) character*12 noe noe='no existeix' write(31,50) i, tip(i) 50 format(/,15x,'BATEG: ',i3,t47,'Tipus de complexe qrs: ',a4) c instant del bateg en segons seg=1.*irpos(i)/ifm if (morf(3,i).eq.0) then write(31,63) seg 63 format(15x,'Instant:',f6.2,' seg',t47,'La ona P es normal') else if (morf(3,i).eq.1) then write(31,64) seg 64 format(15x,'Instant:',f6.2,' seg',t47,'La ona P es invertida') else if (morf(3,i).eq.2) then write(31,65) seg 65 format(15x,'Instant:',f5.1,t47,'La ona P no existeix') end if go to (500, 501, 502, 503, 504, 505, 506), morf(4,i)+1 500 write(31,66) 66 format(t47,'La ona T es normal') go to 510 501 write(31,67) 67 format(t47,'La ona T es invertida') go to 510 502 write(31,68) 68 format(t47,'Ona T de pujada') go to 510 503 write(31,69) 69 format(t47,'Ona T de baixada') go to 510 504 write(31,70) 70 format(t47,'Ona T bifasica -+') go to 510 505 write(31,71) 71 format(t47,'Ona T bifasica +-') go to 510 506 write(31,72) 72 format(t47,'La ona T no existeix') 510 continue if (morf(1,i).eq.3) then write(31,74) 'primer bateg' 74 format(5x,'Amplada interval RR = ',a12) else write(31,75) nint(rrint(i)) 75 format(5x,'Amplada interval RR =',i5,' ms') end if write(31,80) nint(qrsint(i)) 80 format(5x,'Amplada interval QRS=',i5,' ms') if (morf(4,i).eq.6) then write(31,85) noe, noe 85 format(5x,'Amplada interval QT =',a12, & t47,'Interval QTC =',a12) write(31,90) noe, noe 90 format(5x,'Amplada interval QTP=',a12, & t47,'Interval QTPC =',a12) else if (qtcint(i).eq.0) then write(31,95) nint(qtint(i)) 95 format(5x,'Amplada interval QT =',i5,' ms', & t47,'QTC = interval rr fora de limits') write(31,96) nint(qtpint(i)) 96 format(5x,'Amplada interval QTP=',i5,' ms', & t47,'QTPC = interval rr fora de limits') else write(31,98) nint(qtint(i)),nint(qtcint(i)) 98 format(5x,'Amplada interval QT =',i5,' ms', & t47,'Interval QTC =',i5) write(31,99) nint(qtpint(i)),nint(qtpcint(i)) 99 format(5x,'Amplada interval QTP=',i5,' ms', & t47,'Interval QTPC =',i5) end if end if if (morf(3,i).eq.2) then write(31,105) noe 105 format(5x,'Amplada interval PR =',a12) write(31,110) noe 110 format(5x,'Amplada interval PP =',a12) else write(31,115) nint(print(i)) 115 format(5x,'Amplada interval PR =',i5,' ms') if (morf(1,i).eq.3) then write(31,116) 'primer bateg' 116 format(5x,'Amplada interval PP = ',a12) else if (morf(3,i-1).eq.2) then write(31,117) noe 117 format(5x,'Amplada interval PP =',a12) else write(31,120) nint(ppint(i)) 120 format(5x,'Amplada interval PP =',i5,' ms') end if end if end if write(31,*) write(31,123) ampp(i), nint(durp(i)) 123 format(5x,'Amplitut de la ona P =',f8.3,' mV', & t47,'Duracio de la ona P =',i4,' ms') write(31,125) ampr(i), nint(durr(i)) 125 format(5x,'Amplitut de la ona R =',f8.3,' mV', & t47,'Duracio de la ona R =',i4,' ms') write(31,130) ampq(i), nint(durq(i)) 130 format(5x,'Amplitut de la ona Q =',f8.3,' mV', & t47,'Duracio de la ona Q =',i4,' ms') write(31,135) amps(i),nint(durs(i)) 135 format(5x,'Amplitut de la ona S =',f8.3,' mV', & t47,'Duracio de la ona S =',i4,' ms') write(31,137) ampt(i), nint(durt(i)) 137 format(5x,'Amplitut de la ona T =',f8.3,' mV', & t47,'Duracio de la ona T =',i4,' ms') if (morf(2,i).eq.6) then write(31,140) amprr(i), nint(durrr(i)) 140 format(5x,'Amplitut de la ona R',1h','=',f8.3,' mV', & t47,'Duracio de la ona R',1h','=',i4,' ms') end if write(31,148) nint(pendr(i)),nint(durpic(i)) 148 format(5x,'Pendent de la ona R =',i8,' mV',1h/,'seg', & t47,'Duracio pic de ona R=',i4,' ms',/) write(31,150) ST_pe(i),ST_am(i),ST_ar(i),ST_in(i) 150 format(5x,'Pendent segment ST =',f7.3,' mV/seg', & t47,'Amplitud segment ST =',f7.3,' mV',/ & 5x,'Area segment ST =',f7.2,' uV*seg', & t47,'Index segment ST =',f7.3,/) write (31,160) 160 format (5x,'-------------------------------------------------- &-------------------------') return end c-------------------------------------------------------------------------- subroutine visualitzar(f,ifm,ns,jqrs,morf,amprr,ampr,ampq,amps, & ampp,ampt,durpic,qrsint,durr,durrr,durq,durs,durp,durt, & rrint,print,ppint,qtint,qtpint,samp,ritme,rrmed,tip,irpos, & segi, pendr, qtcint, qtpcint) c aquesta subroutina ens mostra per pantalla les dades obtingudes c aixi com algunes clasificacions respecte les morfologies dimension morf(5,8000),ampp(8000),ampt(8000),durp(8000) dimension durt(8000) dimension amprr(8000),ampr(8000),ampq(8000),amps(8000) dimension pendr(8000) dimension durpic(8000),qrsint(8000),durr(8000),durrr(8000) dimension durq(8000) dimension durs(8000),rrint(8000),print(8000),ppint(8000) dimension qtint(8000) dimension qtpint(8000), irpos(8000) dimension qtpcint(8000), qtcint(8000) character*12 f, noe character*4 tip(8000) character*1 op c trobem a partir del segon inicial el primer bateg a mostrar j=1 do while(irpos(j).lt.nint(segi*ifm).and.j.le.jqrs) j=j+1 end do noe=' no existeix' do i=j, jqrs c write(6,45) c 45 format('1') write(6,*) call capcalera (f, ifm, ns, jqrs, ritme, rrmed*samp) write(6,701) i, tip(i) 701 format(15x,'BATEG: ',i3,t47,'Tipus de complexe qrs: ',a4) c instant del bateg en segons seg=1.*irpos(i)/ifm if (morf(3,i).eq.0) then write(6,631) seg 631 format(15x,'Instant:',f6.2,' seg',t47,'La ona P es normal') else if (morf(3,i).eq.1) then write(6,641) seg 641 format(15x,'Instant:',f6.2,' seg',t47,'La ona P es invertida') else if (morf(3,i).eq.2) then write(6,651) seg 651 format(15x,'Instant:',f5.1,t47,'La ona P no existeix') end if go to (800, 801, 802, 803, 804, 805, 806), morf(4,i)+1 800 write(6,661) 661 format(t47,'La ona T es normal') go to 810 801 write(6,67) 67 format(t47,'La ona T es invertida') go to 810 802 write(6,68) 68 format(t47,'Ona T de pujada') go to 810 803 write(6,69) 69 format(t47,'Ona T de baixada') go to 810 804 write(6,70) 70 format(t47,'Ona T bifasica -+') go to 810 805 write(6,71) 71 format(t47,'Ona T bifasica +-') go to 810 806 write(6,72) 72 format(t47,'La ona T no existeix') 810 continue if (morf(1,i).eq.3) then write(6,740) 'primer bateg' 740 format(5x,'Amplada interval RR = ',a12) else write(6,750) nint(rrint(i)) 750 format(5x,'Amplada interval RR =',i5,' ms') end if write(6,840) nint(qrsint(i)) 840 format(5x,'Amplada interval QRS=',i5,' ms') if (morf(4,i).eq.6) then write(6,850) noe, noe 850 format(5x,'Amplada interval QT =',a12, & t47,'Interval QTC =',a12) write(6,950) noe, noe 950 format(5x,'Amplada interval QTP=',a12, & t47,'Interval QTPC =',a12) else if (qtcint(i).eq.0) then write(6,951) nint(qtint(i)) 951 format(5x,'Amplada interval QT =',i5,' ms', & t47,'QTC = interval rr fora de limits') write(6,961) nint(qtpint(i)) 961 format(5x,'Amplada interval QTP=',i5,' ms', & t47,'QTPC = interval rr fora de limits') else write(6,981) nint(qtint(i)),nint(qtcint(i)) 981 format(5x,'Amplada interval QT =',i5,' ms', & t47,'Interval QTC =',i5) write(6,991) nint(qtpint(i)),nint(qtpcint(i)) 991 format(5x,'Amplada interval QTP=',i5,' ms', & t47,'Interval QTPC =',i5) end if end if if (morf(3,i).eq.2) then write(6,105) noe 105 format(5x,'Amplada interval PR =',a12) write(6,110) noe 110 format(5x,'Amplada interval PP =',a12) else write(6,115) nint(print(i)) 115 format(5x,'Amplada interval PR =',i5,' ms') if (morf(1,i).eq.3) then write(6,116) 'primer bateg' 116 format(5x,'Amplada interval PP = ',a12) else if (morf(3,i-1).eq.2) then write(6,117) noe 117 format(5x,'Amplada interval PP =',a12) else write(6,120) nint(ppint(i)) 120 format(5x,'Amplada interval PP =',i5,' ms') end if end if end if write(6,*) write(6,123) ampp(i), nint(durp(i)) 123 format(5x,'Amplitut de la ona P =',f8.3,' mV', & t47,'Duracio de la ona P =',i4,' ms') write(6,125) ampr(i), nint(durr(i)) 125 format(5x,'Amplitut de la ona R =',f8.3,' mV', & t47,'Duracio de la ona R =',i4,' ms') write(6,130) ampq(i), nint(durq(i)) 130 format(5x,'Amplitut de la ona Q =',f8.3,' mV', & t47,'Duracio de la ona Q =',i4,' ms') write(6,135) amps(i),nint(durs(i)) 135 format(5x,'Amplitut de la ona S =',f8.3,' mV', & t47,'Duracio de la ona S =',i4,' ms') write(6,137) ampt(i), nint(durt(i)) 137 format(5x,'Amplitut de la ona T =',f8.3,' mV', & t47,'Duracio de la ona T =',i4,' ms') if (morf(2,i).eq.6) then write(6,140) amprr(i), nint(durrr(i)) 140 format(5x,'Amplitut de la ona R',1h','=',f8.3,' mV', & t47,'Duracio de la ona R',1h','=',i4,' ms') end if write(6,148) nint(pendr(i)),nint(durpic(i)) 148 format(5x,'Pendent de la ona R =',i8,' mV',1h/,'seg', & t47,'Duracio pic de ona R=',i4,' ms',/) 290 write(6,300) 300 format(10x,/,'$Pitja per continuar per sortir: ') read(5,310,err=290) op 310 format(a) if(op.eq.'q'.or.op.eq.'Q') return end do return end c------------------------------------------------------------------------------- subroutine capcalera (f, ifm, ns, jqrs, ritme, rrmit) c ens mostra per pantalla la capgalera a cada bateg character*12 f write (6,10) 10 format (5x,'-------------------------------------------------- &--------------------') write (6,20) f, ifm write (6,30) ns, jqrs write (6,40) nint(ritme), nint(rrmit) 20 format (10x,'nom del pacient: ',a12, & t47,'frequ. de mostreig:',i5,' Hz') 30 format (10x,'long. de registre:',i5,' seg', & t47,'bategs detectats: ',i5) 40 format (10x,'ritme cardiac: ',i5,' puls min', & t47,'interval RR mitg: ',i5,' ms') write (6,10) return end c------------------------------------------------------------------------- subroutine imp_capc(f, ifm, ns, jqrs, ritme, rrmit) c ens imprimeig la capgalera al inici del llistat character*12 f write (31,10) 10 format (5x,'-------------------------------------------------- &-------------------------') write (31,20) f, ifm write (31,30) ns, jqrs write (31,40) nint(ritme), nint(rrmit) 20 format (10x,'nom del pacient: ',a12, & t47,'frequ. de mostreig:',i5,' Hz') 30 format (10x,'long. de registre:',i5,' seg', & t47,'bategs detectats: ',i5) 40 format (10x,'ritme cardiac: ',i5,' puls min', & t47,'interval RR mitg: ',i5,' ms') write (31,10) return end c------------------------------------------------------------------------- subroutine baseline(jqrs,ippos,ecg,basel,samp,ipbeg,ipend, & iqbeg,isend,i_base) c------------------------------------------------------------------------- dimension basel(8000),ipend(8000),iqbeg(8000),ippos(8000) dimension ecg(100000),i_base(8000),isend(8000),ipbeg(8000) c busquem la linea de base com la mitjana dels punts del segment PR nqui=nint(15./samp) ntre=nint(30./samp) ntre_q = nint(10./samp) nqui_q = nint(5./samp) if (iqbeg(1).eq.0) then inic=2 else inic=1 end if do i=inic,jqrs if (ippos(i).ne.0) then sum=0. if (iqbeg(i)-ipend(i).gt.33/samp) then do k=ipend(i)+nqui, iqbeg(i)-nqui sum=sum+ecg(k) end do baselin=sum/(iqbeg(i)-nqui-nqui-ipend(i)+1) pos_base=(iqbeg(i)+ipend(i))/2. else if (iqbeg(i)-ipend(i).le.33/samp) then c else if (iqbeg(i).eq.ipend(i).gt.25) then if(iqbeg(i).eq.ipend(i)) then baselin=ecg(iqbeg(i)) pos_base=iqbeg(i) else do k=ipend(i), iqbeg(i) sum =sum+ecg(k) end do baselin= sum/(iqbeg(i)-ipend(i)+1) pos_base=(iqbeg(i)+ipend(i))/2. end if c else c continue c do k=ipbeg(i)-33/samp-nqui,ipbeg(i)-nqui c sum=sum+ecg(k) c end do c baselin=sum/(33/samp) c pos_base=(ipbeg(i)+(17/samp)) c end if else if (iqbeg(i).gt.0) then sum=0. if(iqbeg(i)-nqui_q.gt.1) then k=iqbeg(i)-nqui_q do while(k.ge.iqbeg(i)-ntre_q-nqui_q.and.k.gt.0) sum=sum+ecg(k) k=k-1 end do if(k.eq.0)then baselin=sum/(iqbeg(i)-nqui_q) pos_base=(iqbeg(i)-nqui_q)/2. else baselin=sum/(ntre_q+1) pos_base=iqbeg(i)-nqui_q-ntre_q/2. end if else do k=1,iqbeg(i) sum=sum+ecg(k) end do baselin=sum/iqbeg(i) pos_base=iqbeg(i)/2. end if else baselin=0 end if end if basel(i)=baselin i_base(i)=int(pos_base+0.5) end do c Si iqbeg(1) est` a la primera mostra, senyal de que no s'ha pogut c detectar bi; llavors fem basel(1)= al nivell de isend(1), per evitar c que la pimera mostra sigui alterada if (iqbeg(1).le.1) basel(1)=ecg(isend(1)) if (iqbeg(1).le.1) i_base(1)=isend(1) return end c-------------------------------------------------------------------------- subroutine impr_dat(f,ifm,ns,jqrs,morf,amprr,ampr,ampq,amps, & ampp,ampt,durpic,qrsint,durr,durrr,durq,durs,durp,durt, & rrint,print,ppint,qtint,qtpint,samp,ritme,rrmit,tip, & irpos,pendr,k,kder,ST_am,ST_pe,ST_in,ST_ar,freV,desV) c Aquesta subrutina ens treu totes les dades en un fitxer .DAT per a c ser impres per la printronix, o be per a ser llegit desde un altre c programa dimension morf(5,8000),pendr(8000),durp(8000),durt(8000) dimension amprr(8000),ampr(8000),ampq(8000),amps(8000) dimension durpic(8000),qrsint(8000),durr(8000),durrr(8000) dimension durq(8000) dimension durs(8000),rrint(8000),print(8000),ppint(8000) dimension qtint(8000) dimension qtpint(8000),irpos(8000),ampp(8000),ampt(8000) dimension ST_am(8000),ST_pe(8000),ST_in(8000),ST_ar(8000) dimension freV(8000),desV(8000) character*12 f, noe, fd character*4 tip(8000) character*3 fderiv character*1 op c Obrim fitxer de sortida. Si hem arribat aqui per l'opcis 18 de c tractament multiderivacional nomis s'ha d'obrir el primer cop per la c primera derivacis. if (k.eq.18) then fd=f fderiv=fd(9:11) f=fd(1:7) end if if (k.ne.18) then open(unit=30, file=f(1:lnblnk(f))//'.dad') write(30,10) f, ns, nint(ritme), nint(rrmit), ifm, jqrs 10 format(//,1x,'Pacient:',a11,2x,'longitut:',i4,' seg',12x,'ritme:' & ,i3,' pul',1h/,'min',4x,'RR mitg:',i4,' ms',3x,'freq mos:',i4, & 'Hz',3x,'batecs:',i4,/) write(30,12) 12 format(1x,'CODI DE MORFOLOGIES: ona P: 0=normal, 1=invertida, & 2=no existeix; batec: 0=normal, 3=primer batec',/, &1x,'ona T: 0=normal, 1=invertida, 2=nomes pujada, 3=nomes baixada,, & 4=bifasica -+, 5=bifasica +-, 6=no existeix',/) else if (kder.eq.1) then open(unit=30, file=f(1:lnblnk(f))//'.dad') write(30,15) f, ns, ifm, jqrs 15 format(//,1x,'Pacient:',a11,2x,'longitut:',i4,' seg',2x, & 3x,'freq mos:',i4,'Hz', & 3x,'batecs:',i4,/) write(30,16) 16 format(1x,'CODI DE MORFOLOGIES: ona P: 0=normal, 1=invertida, & 2=no existeix; batec: 0=normal, 3=primer batec',/, &1x,'ona T: 0=normal, 1=invertida, 2=nomes pujada, 3=nomes baixada,, & 4=bifasica -+, 5=bifasica +-, 6=no existeix',/) end if end if if (k.eq.18) then write(30,17) fderiv,nint(ritme),nint(rrmit) 17 format(//1x,'Derivacio: ',a3,10x,'ritme:',i3,' pul',1h/, & 'min',10x,'RR mitg:',i4,' ms'/) end if write(30,20) 20 format(/18x,'I N T E R V A L S (ms)',15x,'A M P L I T U T S (mv)', & 17x,'D U R A C I O N S (ms)') write(30,25) 25 format(15x,28('-'),4x,40('-'),5x,32('-')) write(30,30) 30 format(' Batec seg. RR QRS QT QTP PR PP P ', & 'Q R S T R',1H',' P Q R S', & ' T R',1H',' PicR' /) iau=0 do i=1,jqrs if ((tip(i-1).eq.' VT '.and.tip(i+1).eq.' VT ').or.(tip(i-1) & .eq.' VF '.and.tip(i+1).eq.' VF ')) go to 45 iau=iau+1 seg=1.*irpos(i)/ifm write(30,40) i,seg,nint(rrint(i)),nint(qrsint(i)),nint(qtint(i)), & nint(qtpint(i)),nint(print(i)),nint(ppint(i)),ampp(i),ampq(i), & ampr(i),amps(i),ampt(i),amprr(i),nint(durp(i)),nint(durq(i)), & nint(durr(i)),nint(durs(i)),nint(durt(i)),nint(durrr(i)), & nint(durpic(i)) 40 format(1x,i3,3x,f5.2,1x,6(1x,i4), & 4x,6(f6.3,1x),1x,6(i4,1x),1x,i3) if(iau.eq.5) then iau=0 write(30,*) end if 45 continue end do write(30,50) 50 format (///,14x,'PEND-R MORFOLOGIES S E G M E N T ' & ,' ST ARRITMIES') write(30,55) 55 format(14x,6('-'),2x,13('-'),3x,32('-'),2x,15('-')) write(30,60) 60 format(' Batec seg. mV/s QRS P T Bat ampl. pend.', & ' index area ventricular'/37x, & ' (mV) (mV/seg) (uV*seg) freq(Hz) sd(mV)') iau=0 do i=1,jqrs if ((tip(i-1).eq.' VT '.and.tip(i+1).eq.' VT ').or.(tip(i-1) & .eq.' VF '.and.tip(i+1).eq.' VF ')) go to 75 iau=iau+1 seg=1.*irpos(i)/ifm write(30,70) i,seg,nint(pendr(i)),tip(i),morf(2,i),morf(3,i), & morf(4,i),morf(1,i),ST_am(i),ST_pe(i),ST_in(i),ST_ar(i), & freV(i),desV(i) 70 format (1x,i3,3x,f5.2,2x,i3,4x,a4,i2,1x,i1,1x,i1,1x,i1,3x, & f7.3,2x,f7.3,2x,f7.3,2x,f7.2,3x,f5.2,2x,f7.4) if(iau.eq.5) then iau=0 write(30,*) end if 75 continue end do if (k.ne.18.or.kder.eq.15) then close(unit=30) end if return end c--------------------------------------------------------------------------- subroutine vis_dat(f, ifm, ns, jqrs, morf, amprr, ampr, ampq, amps, & durpic, qrsint, durr, durrr, durq, durs, rrint, print, & ppint, qtint, qtpint, samp, ritme, rrmit, tip,irpos,pendr) c Aquesta subrutina ens mostra totes les dades per pantalla dimension morf(5,8000),pendr(8000) dimension amprr(8000),ampr(8000),ampq(8000),amps(8000) dimension durpic(8000),qrsint(8000),durr(8000),durrr(8000) dimension durq(8000) dimension durs(8000),rrint(8000),print(8000),ppint(8000) dimension qtint(8000) dimension qtpint(8000), irpos(8000) character*12 f, noe character*4 tip(8000) character*1 op character*2 FRMT write(6,5) 5 format(5x,'Canviar el format a 132 columnes i pitjar ') FRMT = 'i1' read(5,FRMT,err=6) ret 6 write(6,10) f, ns, nint(ritme), nint(rrmit), ifm, jqrs 10 format(//,1x,'Pacient:',a8,2x,'longitut:',i4,' seg',2x,'ritme:',i3, & ' pul',1h/,'min',2x,'RR mitg:',i4,' ms',3x,'freq mos:',i4,'Hz', & 3x,'bategs:',i4,/) write(6,15) 15 format(1x,'CODI DE MORFOLOGIES: ona P: 0=normal, 1=invertida, & 2=no existeix; bateg: 0=normal, 3=primer bateg',/, &1x,'ona T: 0=normal, 1=invertida, 2=nomes pujada, 3=nomes baixada,, & 4=bifasica -+, 5=bifasica +-, 6=no existeix',/) write(6,20) 20 format(19x,'I N T E R V A L S (ms)',13x,'A M P L I T U T S (mV)', & 7x,'D U R A C I O N S (ms)',2x,'PEND-R',2x,'MORFOLOGIES') write(6,30) 30 format(' bateg seg. RR QRS QT QTP PR PP Q', & ' R S R',1H',' Q R S R',1H', & ' PicR mV',1h/,'seg QRS P T Bat') iau=0 do i=1,jqrs iau=iau+1 seg=1.*irpos(i)/ifm write(6,40) i,seg,nint(rrint(i)),nint(qrsint(i)),nint(qtint(i)), & nint(qtpint(i)),nint(print(i)),nint(ppint(i)),ampq(i),ampr(i), & amps(i),amprr(i),nint(durq(i)),nint(durr(i)),nint(durs(i)), & nint(durrr(i)),nint(durpic(i)),nint(pendr(i)),tip(i), & morf(2,i),morf(3,i),morf(4,i),morf(1,i) 40 format(1x,i3,1x,f6.2,2x,i5,1x,i5,1x,i5,1x,i5,1x,i5,1x,i5, & 4x,f6.3,1x,f6.3,1x,f6.3,1x,f6.3,4x,i4,1x,i4,1x,i4,1x,i4,1x,i4, & 3x,i4,3x,a4,i2,1x,i1,1x,i1,1x,i1) if(iau.eq.5) then iau=0 write(6,*) end if end do write(6,50) 50 format(5x,'Canviar el format a 80 columnes i pitjar ') read(5,FRMT,err=60) ret 60 return end c-----------------------------------------------------------------------