Directory of image this file is from
This file as a plain text file

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