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

C
C	MAIN PROG EXTERN.FT
C
C THIS PROGRAM INPUT 6/5/78 SUMMARY OF PT DATA  C.R.
C
CA	PROGRAM UPDATE  JAN/80  TAM
C
	INTEGER ARR2(550,2),ARR22(50,12),SCODE1,SCODE2,EDCLAS,
     *	PCODE,MGMT(2),AGE(6,7),DRUG(3,3),DRUG2(9,3),
     *	IAREA(10),TITLE(80),IDIAG(5),PCODEA(10)
	COMMON ARR2,TITLE,ARR22,IAREA,KOUNT,TCOUNT,ICOUNT,TKOUNT
	DATA IFIVE/5/
	DATA IZER,LZER,IBLK/0,'0000',' '/
	REWIND 8
	REWIND 9
1	REWIND 7
C
C #7 - INPUT DATA #8 - STUDENT NUM.  #9 - COIT/COPT
C
	WRITE(4,9999)
9999	FORMAT(' TITLE (UP TO 80 CHARS.)')
	READ(4,110)(TITLE(I),I=1,80)
	WRITE(4,600)
600	FORMAT(' IS COMPLETE RUN DESIRED (0) OR SUMMARY (1)?')
	READ(4,601) IANS
CA   IFLAG=3 IS SUMMARY OR END OF A COMPLETE RUN
	IFLAG=1
	IF(IANS.EQ.1) IFLAG=3
601	FORMAT(I3)
C
CA   ARR22 - ARRAY FOR THE COPT CODE ANALYSIS
2	DO 10 J=1,50
	DO 10 JJ=1,12
10	ARR22(J,JJ)=0
C
CA   ARR2 - COIT CODE TALLY FOR PRIMARY AND SECONDARY EXPERIENCES
160	DO 161 J=1,550
	DO 161 K=1,2
161	ARR2(J,K)=0
	DO 163 J=1,6
	DO 163 K=1,7
163	AGE(J,K)=0
	DO 164 J=1,9
	DO 164 K=1,3
164	DRUG2(J,K)=0
	DO 166 J=1,10
166	IAREA(J)=0
CA   KOUNT - TOTAL # OF DIAGNOSIS
CA   ICOUNT - TOTAL OF SECONDARY EXPERIENCES
CA   TCOUNT - TOTAL NUMBER OF PATIENTS
CA   TKOUNT - NUMBER OF PRIMARY EXPERIENCES
C
	KOUNT=0
	ICOUNT=0
	TCOUNT=0
	TKOUNT=0
	JFLAG=0
	IF(IFLAG.EQ.3)JFLAG=1
	IF(IFLAG.EQ.3)GOTO 105
18	CALL CHKEOF(EOF)
  	READ(8,101)SCODE1
101	FORMAT(I4)
102	FORMAT(2X,I4)
	WRITE(4,102) SCODE1
	DO 19 J=1,10
19	PCODEA(J)=0
	IF(EOF.NE.0)IFLAG=3
105	REWIND 7
	READ(7,110)(TITLE(I),I=1,80)
110	FORMAT(80A1)
C
CA   IFLAG =1 IMPLIES INDIV. BRKDWN; IFLAG=3 IMPLIES SUMMARY
C
	JP=0
	JPP=1
	IP=0
CA   IPP - THE PRACTICE TYPE
C
	IPP=1
20	CALL CHKEOF(EOF)
CA   SCODE2=STUDENT ID ; PCODE=PRECEPTOR ID ; IA=PRACTICE TYPE
CA   PTNUM=PATIENT # ; EDCLAS=EDUC CLASS  ; IDIAG(X)=COPT I,II
CA   IDIAG(X)=COIT I,II,III
  	READ(7,120)SCODE2,PCODE,IA,PTNUM,EDCLAS,IDIAG(1),
     *	IDIAG(2),IAGE,ISEX,IRACE,ITON,IFIELD,IBIO,(IDIAG(I),
     *	I=3,5),MGMT(1),DRUG(1,1),DRUG(1,2),DRUG(2,1),
     *	DRUG(2,2),DRUG(3,1),DRUG(3,2)
	IF(EOF.NE.0.AND.JFLAG.EQ.0)GOTO 2
	IF(EOF.NE.0)GOTO 96
	IF(IA.EQ.IFIVE)GO TO 20
C	WRITE(3,911) SCODE2
911	FORMAT(2X,I4)
	IF(IFLAG.EQ.3)GOTO 31
	IF(SCODE2-SCODE1)20,211,20
211	JP=JP+1
	JFLAG=1
C	WRITE(4,101) SCODE2
	IF(JP.EQ.1)PCODEA(1)=PCODE
	IF(PCODEA(JPP)-PCODE)21,23,21
120	FORMAT(1X,I4,I3,I1,I6,I1,1X,2I3,I2,5I1,3X,3I3,7I1)
C
21	JPP=JPP+1
	IF(JPP.GT.10)JPP=10
	PCODEA(JPP)=PCODE
	GOTO 23
23	IP=IP+1
	IF(IP.EQ.1)IAREA(1)=IA
	IF(IAREA(IPP)-IA)225,30,225
225	IPP=IPP+1
	IF(IPP.GT.10)IPP=10
	IAREA(IPP)=IA
	GOTO 30
CPAGE
30	CONTINUE
C 
C TCOUNT - PRIMARY EXPERIENCES
C ICOUNT - SECONDARY EXPERIENCES
31	IF(EDCLAS.EQ.1)TCOUNT=TCOUNT+1
	IF(EDCLAS.NE.1)ICOUNT=ICOUNT+1
CA   IF EDCLAS IS NOT 1 OR 2 CHALK IT UP AS A SECONDARY EXPERIENCE
	IF(EDCLAS.NE.1)EDCLAS=2
	DO 34 KI=1,2
	IF(IDIAG(KI).EQ.502)EDCLAS=2
	IF(IDIAG(KI).EQ.503)EDCLAS=2
	DO 33 K2=506,508
33	IF(IDIAG(KI).EQ.K2)EDCLAS=2
34	CONTINUE
CA   INCREMENT NUMBER OF PATIENTS SEEN
	TKOUNT=TKOUNT+1
	DO 77 I=1,5
	IF(IDIAG(I).LE.0.OR.IDIAG(I).GT.550) GOTO 77
	IF(I.LT.3) GOTO 75
	IF(IDIAG(I).GT.500)GO TO 77
CA   INCREMENT THE NUMBER OF COIT SEEN
	KOUNT=KOUNT+1
75	IF(I.LT.3.AND.IDIAG(I).LT.501)GO TO 77
	ARR2(IDIAG(I),EDCLAS)=ARR2(IDIAG(I),EDCLAS)+1
77	CONTINUE
	IF(IAGE.LE.6)IONE=1
	IF(IAGE.GT.6.AND.IAGE.LE.17)IONE=2
	IF(IAGE.GT.17.AND.IAGE.LE.30)IONE=3
	IF(IAGE.GT.30.AND.IAGE.LE.40)IONE=4
	IF(IAGE.GT.40.AND.IAGE.LE.60)IONE=5
	IF(IAGE.GT.60)IONE=6
C
	IF(ISEX.EQ.1)ITWO=1
	IF(ISEX.NE.1)ITWO=2
	AGE(IONE,ITWO)=AGE(IONE,ITWO)+1
	AGE(IONE,3)=AGE(IONE,3)+1
	IF(ITON.EQ.1)AGE(IONE,4)=AGE(IONE,4)+1
	IF(IFIELD.EQ.1)AGE(IONE,5)=AGE(IONE,5)+1
	IF(IBIO.EQ.1)AGE(IONE,6)=AGE(IONE,6)+1
C       PROCEEDURE/DRUG ANALYSIS FOR COPT SECTION
	DO 79 KR=1,2
	IF(IDIAG(KR).LE.500.OR.IDIAG(KR).GT.550)GOTO 79
	IF(IDIAG(KR).GT.500)IDIAG(KR)=IDIAG(KR)-500
	IF(ITON.EQ.1.AND.IDIAG(KR).NE.0)
     *	   ARR22(IDIAG(KR),10)=ARR22(IDIAG(KR),10)+1
	IF(IBIO.EQ.1.AND.IDIAG(KR).NE.0)
     *	   ARR22(IDIAG(KR),11)=ARR22(IDIAG(KR),11)+1
	IF(IFIELD.EQ.1.AND.IDIAG(KR).NE.0)
     *	   ARR22(IDIAG(KR),12)=ARR22(IDIAG(KR),12)+1
	DO 79 JKR=1,3
	IF(DRUG(JKR,1).NE.0.AND.IDIAG(KR).NE.0.AND.
     *	DRUG(JKR,1).LE.8)
     *	   ARR22(IDIAG(KR),DRUG(JKR,1))=
     *	          ARR22(IDIAG(KR),DRUG(JKR,1))+1
79	CONTINUE
C
	DO 80 J=1,3
	IF(DRUG(J,1).EQ.1.OR.DRUG(J,1).EQ.3)GOTO 83
C  DRUG(J,1...OR...3) ARE MYD. OR CYCLOP.
80	CONTINUE
	GOTO 85
83	AGE(IONE,7)=AGE(IONE,7)+1
85	DO 90 J=1,3
	IF(DRUG(J,1).EQ.0)GOTO 90
	IF(DRUG(J,2).GT.3.OR.DRUG(J,2).LT.1)DRUG(J,2)=1
	DRUG2(DRUG(J,1),DRUG(J,2))=DRUG2(DRUG(J,1),DRUG(J,2))+1
90	CONTINUE
	GOTO 20
95	IF(IFLAG.EQ.1)GOTO 96
C	WRITE(6,950) SCODE1
950	FORMAT(' ',A4)
	GOTO 160
96	CALL OUTPUT(SCODE1,IFLAG,PCODEA,AGE,DRUG2)
	IF(IFLAG.NE.3)GOTO 2
	STOP
	END