File: OUTPUT.FT of Disk: Disks/PDP8-Net/disk2-fortran
(Source file text)
C
C OUTPUT.FT
SUBROUTINE OUTPUT(SCODE,IFLAG,PCODEA,IAGE,IDRUG)
C SUBROUTINE TO BE USED FOR OUTPUT OF EX AND EI DATA
C
CA UPDATE JAN/80 TAM
C
INTEGER ARR2(550,2),ARR22(50,12),SCODE,
* PCODEA(10),BLK,TITLE(80),DTOT(9),IAREA(10)
DIMENSION LNE(15),IAGE(6,7),IDRUG(9,3),IDATA(9,4)
COMMON ARR2,TITLE,ARR22,IAREA,KOUNT,TCOUNT,ICOUNT,TKOUNT
DATA LZER,BLK,LZER1,LZER2/'0000',' ','000','0'/
REWIND 9
DO 7 J=1,10
IF(PCODEA(J)-0)5,4,5
4 PCODE1(J)=0
5 IF(IAREA(J)-0)7,6,7
6 IAREA(J)=0
7 CONTINUE
IF(IFLAG-3)10,20,10
C
10 WRITE(3,100)(TITLE(I),I=1,80),SCODE,(PCODEA(I),I=1,10),
* (IAREA(I),I=1,10),TKOUNT,KOUNT
C WRITE(4,101) SCODE
101 FORMAT(2X,I4)
100 FORMAT('1',///,20X,80A1,//' STUDENT CODE NUMBER ',I4,
* /,' PRECEPTOR CODE NUMBERS ',
* 10(1X,I3),5X,'AREAS- ',10(1X,I1),//,3X,'TOTAL PATIENTS ',
* 'SEEN - ',I6,/,30X,'TOTAL DIAGNOSES - ',I6)
GOTO 21
20 WRITE(3,200)(TITLE(I),I=1,80),TKOUNT,KOUNT
200 FORMAT('1',///,20X,80A1,//,' ',T30,'SUMMARY OF DATA',
* /,' ',25X,'GRAND TOTAL OF PATIENTS ',I6,
* /,25X,'GRAND TOTAL OF DIAGNOSES ',I6)
21 WRITE(3,300)
300 FORMAT(' SEQUENCE CODE',10X,'DIAGNOSIS CODE',50X,
* 'PRIMARY',10X,'OBSERVER',10X,'TOTAL')
C
KTOTP=0
KTOTO=0
DO 40 J=1,500
ITOT=ARR2(J,1)+ARR2(J,2)
READ(9,400)NUM,(LNE(I),I=1,15)
400 FORMAT(5X,I5,15A4)
KTOTP=KTOTP+ARR2(J,1)
KTOTO=KTOTO+ARR2(J,2)
IF(ITOT.EQ.0)GOTO 40
PNUM=FLOAT(NUM)/100.
WRITE(3,450)J,PNUM,(LNE(I),I=1,15),ARR2(J,1),ARR2(J,2),ITOT
450 FORMAT(' ',5X,I3,10X,F6.2,15A4,4X,I5,10X,I5,15X,I5)
40 CONTINUE
KTOTT=KTOTP+KTOTO
WRITE(3,1450)
1450 FORMAT(' ',86X,'-------------------------------------------')
WRITE(3,452)KTOTP,KTOTO,KTOTT
452 FORMAT(' ',/' ',71X,'SUMMARY',10X,I5,12X,I5,13X,I5)
GOTO 70
C
GOTO 70
70 WRITE(3,500)
500 FORMAT('1',30X,'BREAKDOWN BY AGE',//,6X,'AGE',5X,
* 'MALE FEMALE',3X,'TOTAL ',5X,'TONOMETRY',5X,'FIELDS',5X,
* 'BIOMICROSCOPY',5X,'DILATION/CYCLOPLEGIA')
WRITE(3,550)((IAGE(K,J),J=1,7),K=1,6)
550 FORMAT(1X,' 0- 6',3X,I6,5X,I6,2X,I6,4(7X,I6),
* /,1X,' 7-17', 3X,I6,5X,I6,2X,I6,4(7X,I6),
* /,1X,'18-30', 3X,I6,5X,I6,2X,I6,4(7X,I6),
* /,1X,'31-40', 3X,I6,5X,I6,2X,I6,4(7X,I6),
* /,1X,'41-60', 3X,I6,5X,I6,2X,I6,4(7X,I6),
* /,1X,' 61+ ', 3X,I6,5X,I6,2X,I6,4(7X,I6))
DO 80 J=1,7
80 DTOT(J)=0
DO 85 J=1,7
DO 85 K=1,6
85 DTOT(J)=DTOT(J)+IAGE(K,J)
WRITE(3,560)(DTOT(I),I=1,7)
560 FORMAT(' ',//' TOTAL',3X,I6,5X,I6,2X,I6,4(7X,I6))
WRITE(3,600)
600 FORMAT(' ',///,20X,'PHARMACEUTICAL AGENTS',/,6X,
* 'DRUG',T20,'TOTAL TIMES USED',5X,'NO REACTION',5X,
* 'ADVERSE REACTION',5X,'EMERGENCY TX NEEDED')
DO 89 J=1,9
89 DTOT(J)=IDRUG(J,1)+IDRUG(J,2)+IDRUG(J,3)
DO 87 J=1,9
DO 87 K=1,3
KK=K+1
87 IDATA(J,KK)=IDRUG(J,K)
DO 88 J=1,9
88 IDATA(J,1)=DTOT(J)
WRITE(3,650) ((IDATA(J,K),K=1,4),J=1,8)
650 FORMAT(' 1. MYDRIATIC',T25,I6,3(10X,I6),
* /,' 2. MIOTIC',T25,I6,3(10X,I6),/,' 3. CYCLOPLEGIC',T25,I6,
* 3(10X,I6),/,' 4. ANESTHETIC',T25,I6,3(10X,I6),/,' 5. THERAPEUTIC',
* T25,I6,3(10X,I6),/,' 6. DIAG DYE',T25,I6,3(10X,I6),/,
* ' 7. COMBINATION',T25,I6,3(10X,I6),/,' 8. OTHER',T25,
* I6,3(10X,I6))
DO 90 J=1,4
90 DTOT(J)=0
DO 93 J=1,8
DTOT(1)=DTOT(1)+IDATA(J,1)
DTOT(2)=DTOT(2)+IDRUG(J,1)
DTOT(3)=DTOT(3)+IDRUG(J,2)
DTOT(4)=DTOT(4)+IDRUG(J,3)
93 CONTINUE
WRITE(3,670)(DTOT(I),I=1,4)
670 FORMAT(' ',/,' TOTALS',T25,I6,3(10X,I6))
C
WRITE(3,700)
700 FORMAT(' ',//,20X,'C.O.P.T. ANALYSIS',//,6X,
* 'DESCRIPTION',T50,'NUMBER',2X,
* 'TON BIO FLD MYD MIO CYC ANS THP ',
* 'DYE COM OTH')
DO 99 J=501,550
READ(9,400)NUM,(LNE(I),I=1,15)
JP=J-500
ICOPT=ARR2(J,1)+ARR2(J,2)
IF(ICOPT.LE.0)GOTO 99
WRITE(3,760)JP,NUM,(LNE(I),I=1,15),ICOPT,
* (ARR22(JP,K),K=10,12),(ARR22(JP,KK),KK=1,8)
760 FORMAT(' ',I2,2X,I4,15A4,T50,I6,11(1X,I4))
99 CONTINUE
RETURN
END