LISTAGEM DO PROGRAMA
Um Programa para Apoio ao Diagnóstico do Infarto do Miocárdio
Renato M.E. Sabbatini
150 ' Programado por Renato M.E. Sabbatini, PhD
170 ' Para computadores da linha IBM-PC (Microsoft BASICA)
230 DIM Q$(7),B(7),I$(6),NOME$(5),ENTRADA$(5)
250 GOSUB 1030 :'le dados das questoes
260 GOSUB 1510 :'rotina de inicializacao
280 ON ERROR GOTO 2260 :'preparar-se para erros
290 GOSUB 1790 :'mostrar menu principal
300 ON OPCAO GOSUB 340,1280,2290:GOTO 290 :'desvia para a opcao desejada
320 ' ------ ENTRADA DE DADOS
340 MODUL$="DADOS INDIVIDUAIS":GOSUB 2000
360 PRINT:LINE INPUT "NOME : ";NOME$
370 PRINT:LINE INPUT "NO.REGISTRO : ";RG$
380 PRINT:LINE INPUT "IDADE : ";ID$
390 PRINT:LINE INPUT "CLINICA : ";CL$
400 PRINT:LINE INPUT "MEDICO : ";DR$
405 PRINT:PRINT SEPS$:PRINT "Os dados acima estao corretos";:GOSUB 950
406 IF XI=2 THEN GOTO 350
410 MODUL$="SINTOMAS E EXAME FISICO":GOSUB 2000
430 CP = 0:PRINT:PRINT
490 FOR I=1 TO 7
500 PRINT Q$(I);:GOSUB 950
520 CP = CP + B(I) * XI
530 NEXT I
535 PRINT:PRINT SEPS$:PRINT "Os dados acima estao corretos";:GOSUB 950
536 IF XI=2 THEN GOTO 420
540 MODUL$="AVALIACAO LABORATORIAL":GOSUB 2000
550 PRINT:PRINT:PRINT "Foram medidas enzimas sericas (CK,GOT) e LDH ";
560 GOSUB 950: LB=XI: IF XI=2 THEN 680
570 PRINT "Responda com 0 se o valor nao foi determinado"
580 PRINT:PRINT:PRINT:INPUT "Nivel de CK (em U/l) ";CK
600 IF CK<0 OR CK>5000 THEN PRINT "**** Valor Invalido":GOTO 590
610 PRINT:INPUT "Nivel de LDH (U/l) ";LD
620 IF LD<0 OR LD>900 THEN PRINT "**** Valor Invalido":GOTO 610
630 PRINT:INPUT "Nivel de GOT (U/l) ";G0
640 IF G0<0 OR G0>300 THEN PRINT "**** Valor Invalido":GOTO 630
645 PRINT:PRINT SEPS$:PRINT "Os dados acima estao corretos";:GOSUB 950
646 IF XI=2 THEN GOTO 540
660 ' ----- CALCULO FINAL E SAIDA DOS RESULTADOS
680 P = 1 / (1 + EXP ( - 7.5698 + CP))
720 MODUL$="RESULTADOS":GOSUB 2000
735 PRINT "Paciente no. ";RG$;" : ";NOME$
736 PRINT "Idade : ";ID$;" Clinica : ";CL$;" Medico : ";DR$
740 PRINT:PRINT "PELOS DADOS CLINICOS:":PRINT
750 PRINT:PRINT "A probabilidade de que o paciente tenha infarto do miocardio"
760 PRINT "e' de ";INT(P*10000)/100; "%. ";
770 IF P<.5 THEN PRINT "A probabilidade nao e' significante":GOTO 790
780 PRINT "A probabilidade e' considerada significante"
790 IF LB=2 THEN 890
800 PRINT:PRINT "PELOS DADOS LABORATORIAIS:":PRINT:PRINT
810 IF CK=0 OR LD=0 THEN OP=6:GOTO 880
820 IF CK<160 AND LD<120 THEN OP=1:GOTO 880
830 IF CK<160 AND LD>120 THEN OP=2:GOTO 880
840 IF CK>160 AND LD<=120 THEN OP=6:GOTO 880
850 IF CK>160 AND LD>120 AND G0=0 THEN OP=5:GOTO 880
860 IF CK>160 AND LD>120 AND CK/G0>10 THEN OP=3:GOTO 880
870 IF CK>160 AND LD>120 AND CK/G0<10 THEN OP=4:GOTO 880
880 PRINT I$(OP)
890 PRINT SEPI$:PRINT "Pressione [ENTER] para continuar ";:A$=INPUT$(1):RETURN
930 ' ----- SUBROTINA DE RESPOSTAS
950 INPUT " (S/N) ";A$
960 IF A$="s" OR A$ = "S" THEN XI = 1: RETURN
970 IF A$="n" OR A$ = "N" THEN XI = 2: RETURN
980 PRINT "Responda S ou N"
990 I = I - 1: RETURN
1010 " ----- PERGUNTAS
1030 FOR I=1 TO 7: READ Q$(I):NEXT I
1040 DATA "O paciente sente dores no peito ou no braco esquerdo "
1050 DATA "Existe opressao, dor ou desconforto no peito "
1060 DATA "Existe historia previa de isquemia do miocardio "
1070 DATA "O paciente ja' usou nitroglicerina para alivio de dor no peito "
1080 DATA "Ha' depressao ou elevacao > 1 mm na onda ST "
1090 DATA "Ha' elevacao ou depressao >1 mm no segmento ST "
1100 DATA "Ha' presenca de onda T com pico ou inversao de mais de 1 mm "
1110 FOR I=1 TO 6: READ I$(I): NEXT I
1120 DATA "Nao ha' indicativo de que tenha ocorrido infarto."
1130 DATA "O quadro e' compativel com infarto ha' mais de 3/4 dias."
1140 DATA "O quadro e' compativel apenas com lesoes musculares esqueleticas."
1150 DATA "O quadro e' altamente indicativo de infarto recente do miocardio."
1160 DATA "Ha' indicativos (nao conclusivos) de ocorrencia de infarto."
1170 DATA "Os dados sao insuficientes para um diagnostico conclusivo."
1190 ' ----- PONDERACAO ESTATISTICA
1210 B(1) = .9988:B(2) = .7145:B(3) = .4187
1220 B(4) = .5091001:B(5) = .7682:B(6) = .8321
1230 B(7) = 1.1278: RETURN
1260 ' ----- IMPRESSAO DOS RESULTADOS
1280 LPRINT TAB(40-LEN(CLINICA$)/2);CLINICA$
1290 LPRINT TAB(40-LEN(ENDERECO$)/2);ENDERECO$
1300 LPRINT:LPRINT TAB(25);"AVALIACAO DE RISCO DE INFARTO"
1310 LPRINT:LPRINT STRING$(79,"-")
1312 LPRINT "Paciente no. ";RG$;" : ";NOME$:LPRINT
1314 LPRINT "Idade : ";ID$;" Clinica : ";CL$;" Medico : ";DR$
1320 LPRINT:LPRINT "PELOS DADOS CLINICOS:":LPRINT
1330 LPRINT:LPRINT "A probabilidade de que o paciente tenha infarto do miocardio"
1340 LPRINT "e' de ";INT(P*10000)/100; "%. ";
1350 IF P<.5 THEN LPRINT "A probabilidade nao e' significante":GOTO 1370
1360 LPRINT "A probabilidade e' considerada significante"
1370 IF LB=2 THEN 1400
1380 LPRINT:LPRINT "PELOS DADOS LABORATORIAIS:":LPRINT:LPRINT:LPRINT I$(OP)
1400 LPRINT STRING$(79,"-"):RETURN
1430 ' ----- SUBROTINA DE DECODIFICACAO
1450 FOR I=1 TO LEN(F$)
1460 MID$(F$,I,1)=CHR$(ASC(MID$(F$,I,1))-INT(24*RND(1)))
1470 NEXT I:RETURN
1490 ' ----- SUBROTINA DE INICIALIZACAO
1510 READ NC:FOR I=1 TO NC:READ ENTRADA$(I),NOME$(I):NEXT
1520 DATA 3, 1,Entrada de dados, 2,Impressao do resultado de exame
1550 DATA 3,FIM DO PROGRAMA
1580 ' ----- Definicao dos parametros da tela
1600 LARGTELA=78:LARGQUADR=60 :'largura da tela e do quadro, em colunas
1620 SEPI$=STRING$(LARGTELA,196):SEPS$=SEPI$
1660 CL$=CHR$(12) :'CLEAR SCREEN (Home)
1670 BEL$=CHR$(7) :'BELL
1680 TB=15
1700 ' ----- Preparar para erros, definir titulos do programa
1720 PROG$="INFARTO 4.01 PC": TITULO$="PROBABILIDADE DO INFARTO"
1740 LT=LEN(TITULO$):LS=LEN(SUBTITULO$) :'calcula comprimentos de ambos
1750 RETURN
1770 ' ----- SUBROTINA DE MOSTRAR MENU
1790 MODUL$="SELECAO DE FUNCOES":GOSUB 2000
1810 FOR NI=1 TO NC :'mais um na lista
1820 PRINT TAB(TB+AD);LEFT$(ENTRADA$(NI)+STRING$(3,32),3);
1830 PRINT TAB(TB+AD+4);NOME$(NI)
1840 NEXT NI:PRINT SEPI$
1870 '----- Entrada e teste da opcao do usuario
1890 PRINT:1900 PRINT TAB(18);"ENTRE O CODIGO DA FUNCAO DESEJADA : ";
1910 OPCAO$=INPUT$(1) :'aceita entrada do usuario
1920 FOR I=1 TO NC
1930 IF ENTRADA$(I)=OPCAO$ THEN 1960
1940 NEXT I
1950 PRINT BEL$; : GOTO 1900 :'ERRO: programa inexistente
1960 OPCAO=I:RETURN
1980 ' ----- SUBROTINA DE CABECALHO
2000 CLS:COLOR 0,7:PRINT PROG$;TAB(36);DH$;TAB(LARGTELA-LT);TITULO$:COLOR 7,0
2010 PRINT "(c) 1993 Dr.Renato M.E. Sabbatini";
2020 PRINT TAB(39);"Nucleo de Informatica Biomedica/UNICAMP"
2030 COLOR 0,7:PRINT CLINICA$;TAB(78-LEN(ENDERECO$));ENDERECO$:COLOR 7,0
2040 PRINT:PRINT TAB(39-LEN(MODUL$)/2);MODUL$:PRINT SEPS$:RETURN
2240 ' ----- SUBROTINA DE TRATAMENTO DE ERROS
2260 PRINT:PRINT Z$;"No.";ERR;"/";ERL;".":END
2280 PRINT:PRINT Z$;"SISTEMA INCOMPLETO NO DISCO"
2290 END
Voltar ao artigo
Copyright (c) 1995 Renato M.E. Sabbatini