File: EXTERN.FT of Disk: Disks/PDP8-Net/disk2-fortran
(Source file text)
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