LISTAGEM DO PROGRAMA
Um Programa para Cálculo e Interpretação do Equilíbrio Ácido-Básico
Celso S. Nascimento e Renato G.G. Terzi
1 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
4 ' Programado em BASICA por: Celso Nascimento
5 ' Orientacao: Prof.Dr. Renato G.G. Terzi e Prof.Dr. Renato M.E. Sabbatini
6 ' Fac.C.Medicas/UNICAMP e Nucleo de Informatica Biomedica/UNICAMP
8 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
10 DEFINT I-N:DEFSTR Z,W
12 TB=18:IC=3
15 ZC=STRING$(79,"_"):ZB=STRING$(79,"=")
25 '--------------------- Entrada de dados ---------------------------
29 CLS : PRINT TAB(TB);LEFT$(ZC,40)
35 PRINT TAB(TB);" ACIDBAS II 3.01 IBM-PC"
40 PRINT TAB(TB);" CALCULO DO EQUILIBRIO ACIDO - BASICO"
45 PRINT TAB(TB);LEFT$(ZC,40):PRINT
50 PRINT ZC:PRINT TAB(22);"E N T R A D A D E D A D O S":PRINT ZC
55 PRINT "APOS CADA DADO TECLE <ENTER>"
65 LOCATE 12,IC:PRINT "0. Nome do paciente (ate 40 caracteres):"
70 LOCATE 13,IC:PRINT "1. No. de registro:"
75 LOCATE 14,IC:PRINT "2. Data de hoje: DD/MM/AA"
80 LOCATE 15,IC:PRINT "3. Data da colheita do sangue: DD/MM/AA"
85 LOCATE 16,IC:PRINT "4. Hora da colheita: HH:MM"
90 LOCATE 17,IC:PRINT "5. Valor do PH da amostra:"
95 LOCATE 18,IC:PRINT "6. Pressao do gas carbonico (PCO2) no sangue arterial:"
100 LOCATE 19,IC:PRINT "7. Pressao do oxigenio (PO2) no sangue arterial:"
105 LOCATE 20,IC:PRINT "8. Valor da hemoglobina (HB) da amostra:"
110 LOCATE 21,IC:PRINT "9. Peso do paciente (em KG):"
115 FOR IL=12 TO 21:GOSUB 4430:NEXT
120 M$="DESEJA CORRECAO DE ALGUM DADO":GOSUB 3000
135 IF R$="S" THEN GOSUB 4400:GOTO 120
502 '---------------------- Calculos e interpretacao ------------------------
510 HCO3=.031*PCO2*10^(PH-6.1) : TCO2=.031*PCO2*HCO3
530 DB=(1-.0143*HB)*(HCO3-(9.5+1.63*HB)*(7.4-PH)-24)
540 NAHCO3= .3*PE*ABS(DB) : NH4CL= .3*PE*ABS(DB) : H2CO3= .031*PCO2
570 IF PH>=7.35 AND PH<=7.43 AND PCO2>=36 AND PCO2<=43 AND DB>=-5 AND DB<=5 THEN DG$="NORMAL":GOSUB 810:NIR=1:NFR=2:GOTO 810
580 IF PH<7.35 AND PCO2>43 AND DB<-5 THEN DG$="ACIDOSE MISTA RESPIRATORIA E METABOLICA":GOSUB 810:NIR=30:NFR=34:NIR=3:NFR=35:GOTO 810
590 IF PH<7.35 AND PCO2>43 AND DB>=-5 AND DB<=5 THEN DG$="ACIDOSE RESPIRATORIA PURA":GOSUB 810:NIR=86:NFR=88:NIR=40:NFR=98:GOTO 810
600 IF PH>=7.35 AND PH<=7.43 AND PCO2<36 AND DB<-5 THEN DG$="ACIDOSE METABOLICA E ALCALOSE RESPIRATORIA TOTALMENTE COMPENSADAS":GOSUB 810:NIR=100:NFR=127:GOTO 810
610 IF PH>7.43 AND PCO2<36 AND DB>5 THEN DG$="ALCALOSE MISTA METABOLICA E RESPIRATORIA":GOSUB 810:NIR=145:NFR=151:NIR=130:NFR=152:GOTO 810
620 IF PH>7.43 AND PCO2>=36 AND PCO2<=43 AND DB>5 THEN DG$="ALCALOSE METABOLICA PURA":GOSUB 810:NIR=169:NFR=173:NIR=155:NFR=174:GOTO 810
630 IF PH>7.43 AND PCO2<36 AND DB>=-5 AND DB<=5 THEN DG$="ALCALOSE RESPIRATORIA PURA":GOSUB 810:NIR=195:NFR=199:NIR=175:NFR=200:GOTO 810
640 IF PH<7.35 AND PCO2>=36 AND PCO2<=43 AND DB<-5 THEN DG$="ACIDOSE METABOLICA PURA":GOSUB 810:NIR=229:NFR=232:NIR=205:NFR=233:GOTO 810
650 IF PH>=7.35 AND PH<=7.43 AND PCO2>43 AND DB>5 THEN DG$="ALCALOSE METABOLICA E ACIDOSE RESPIRATORIA TOTALMENTE COMPENSADAS":GOSUB 810:NIR=235:NFR=258:GOTO 810
660 IF PH>7.43 AND PCO2>43 AND DB>5 THEN DG$="ALCALOSE METABOLICA PRIMARIA COM ACIDOSE RESPIRATORIA DE COMPENSACAO":GOSUB 810:NIR=278:NFR=281:NIR=260:NFR=282: GOTO 810
670 IF PH<7.35 AND PCO2>43 AND DB>5 THEN DG$="ACIDOSE RESPIRATORIA PRIMARIA COM ALCALOSE METABOLICA DE COMPENSACAO":GOSUB 810:NIR=285:NFR=306:GOTO 810
680 IF PH<7.35 AND PCO2<36 AND DB<-5 THEN DG$=" ACIDOSE METABOLICA PRIMARIA COM ALCALOSE RESPIRATORIA DE COMPENSACAO":GOSUB 810:NIR=337:NFR=340:NIR=310:NFR=340:GOTO 810
690 IF PH>7.43 AND PCO2<36 AND DB<-5 THEN DG$="ALCALOSE RESPIRATORIA PRIMARIA COM ACIDOSE METABOLICA DE COMPENSACAO":GOSUB 810:NIR=360:NFR=363:NIR=345:NFR=363:GOTO 810
700 IF PH>=7.35 AND PH<=7.43 AND PCO2<36 AND DB>=-5 AND DB<=5 THEN DG$="ALCALOSE RESPIRATORIA PURA SEM ALCALEMIA":GOSUB 810:NIR=365:NFR=374:GOTO 810
710 IF PH>=7.35 AND PH<=7.43 AND PCO2>43 AND DB>=-5 AND DB<=5 THEN DG$="ACIDOSE RESPIRATORIA PURA SEM ACIDEMIA":GOSUB 810:NIR=376:NFR=385:GOTO 810
720 IF PH<7.35 AND PCO2>=36 AND PCO2<=43 AND DB>=-5 AND DB<=5 THEN DG$="ACIDEMIA POR SOMACAO DE DESVIOS METABOLICOS E RESPIRATORIOS":GOSUB 810:NIR=388:NFR=396:GOTO 810
730 IF PH>7.43 AND PCO2>=36 AND PCO2<=43 AND DB>=-5 AND DB<=5 THEN DG$="ALCALEMIA POR SOMACAO DE DESVIOS METABOLICOS E RESPIRATORIOS":GOSUB 810:NIR=400:NFR=408:GOTO 810
750 PRINT:PRINT:PRINT SC$:PRINT TAB(24) "O B S E R V A C A O":PRINT SC$
760 PRINT:PRINT:PRINT "Queira nos desculpar mas esta situacao nao esta' prevista em nossa pro-"
770 PRINT "gramacao."
800 ' ------------------- Impressao dos resultados -----------------------
810 CLS:PRINT ZC:PRINT TAB(25) "ANALISE DO EQUILIBRIO ACIDO-BASICO":PRINT ZC
830 LOCATE 5,01:PRINT "Nome do paciente: ";N$
840 LOCATE 6,01:PRINT "Data de hoje: ";DH$
850 LOCATE 5,55:PRINT "Data da amostra: ";DC$
860 LOCATE 6,55:PRINT "Hora da colheita: ";H$;" h"
870 IC=5:IL=8:LOCATE IL,IC:PRINT "PH...................: ";:PRINT USING "#.##";PH;:PRINT TAB(42)"(NORMAL 7.35 A 7.43 )"
880 IF PH<7.35 THEN GOSUB 1650
890 IF PH>7.43 THEN GOSUB 1660
900 IL=9:LOCATE IL,IC:PRINT "PCO2.................:";:PRINT USING "###.#";PCO2;:PRINT TAB(36)"MMHG (NORMAL 36 A 43 )"
910 IF PCO2<36 THEN GOSUB 1650
920 IF PCO2>43 THEN GOSUB 1660
930 IL=10:LOCATE IL,IC:PRINT "BICARBONATO REAL.....:";:PRINT USING "###.#";HCO3;:PRINT TAB(34)"MMOL/L (NORMAL 20 A 28 )"
940 IF HCO3<20 THEN GOSUB 1650
950 IF HCO3>28 THEN GOSUB 1660
960 IL=11:LOCATE IL,IC:PRINT "DIFERENCA DE BASE....:";:PRINT USING "+##.#";DB;:PRINT TAB(34)"MMOL/L (NORMAL -5.0 A +5 )"
970 IF DB<-5 THEN GOSUB 1650
980 IF DB>5 THEN GOSUB 1660
990 IL=12:LOCATE IL,IC:PRINT "PO2 ARTERIAL.........:";:PRINT USING "###.#";PO2;:PRINT TAB(36)"MMHG (NORMAL 80 A 100 )"
1000 IF PO2<80 THEN GOSUB 1650
1010 IF PO2>100 THEN GOSUB 1660
1020 PRINT:PRINT TAB(35)"DIAGNOSTICO":T=40-(INT(LEN(DG$)/2))
1030 PRINT ZC:PRINT TAB(T);DG$:PRINT ZC
2100 M$="DESEJA EMISSAO DE RELATORIO IMPRESSO":GOSUB 3000
2105 IF R$="N" THEN 1080
2220 LOCATE 23,3:PRINT "AJUSTE SUA IMPRESSORA E TECLE <ENTER> ";
2230 WHILE INKEY$="":WEND:GOSUB 1180
1080 M$="MAIS ALGUMA ANALISE DE PACIENTE":GOSUB 3000:MA$=R$
1090 IF MA$="S" THEN 25
1110 CLOSE:END
1175 '---------------- Saida do relatorio na impressora ------------------
1180 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT ZB
1185 LPRINT TAB(31) "ACIDBAS II"
1187 LPRINT TAB(23)"ANALISE DO EQUILIBRIO ACIDO-BASICO":LPRINT ZB
1190 LPRINT:LPRINT TAB(2) "Nome do paciente: ";N$
1200 LPRINT TAB(2) "Data de hoje....: ";DH$
1210 LPRINT TAB(2) "Data da amostra.: ";DC$
1220 LPRINT TAB(2) "Hora da colheita: ";H$;" horas."
1225 LPRINT
1230 LPRINT TAB(5) "PH...................: ";:LPRINT USING "#.##";PH;:LPRINT TAB(42)"(NORMAL 7.35 A 7.43 )";
1240 IF PH<7.35 THEN GOSUB 1460
1250 IF PH>7.43 THEN GOSUB 1470
1260 IF PH>7.35 AND PH<7.43 THEN GOSUB 1480
1270 LPRINT TAB(5) "PCO2.................:";:LPRINT USING "###.#";PCO2;:LPRINT TAB(36)"MMHG (NORMAL 36 A 43 )";
1280 IF PCO2<36 THEN GOSUB 1460
1290 IF PCO2>36 AND PCO2<43 THEN GOSUB 1480
1300 IF PCO2>43 THEN GOSUB 1470
1310 LPRINT TAB(5) "BICARBONATO REAL.....:";:LPRINT USING "###.#";HCO3;:LPRINT TAB(34)"MMOL/L (NORMAL 20 A 28 )";
1320 IF HCO3<20 THEN GOSUB 1460
1330 IF HCO3>28 THEN GOSUB 1470
1340 IF HCO3>20 AND HCO3<28 THEN GOSUB 1480
1350 LPRINT TAB(5) "DIFERENCA DE BASE....:";:LPRINT USING "+##.#";DB;:LPRINT TAB(34)"MMOL/L (NORMAL -5.0 A +5.0 )";
1360 IF DB<-5 THEN GOSUB 1460
1370 IF DB>5 THEN GOSUB 1470
1380 IF DB>-5 AND DB<5 THEN GOSUB 1480
1390 LPRINT TAB(5) "PO2 ARTERIAL.........:";:LPRINT USING "###.#";PO2;:LPRINT TAB(36)"MMHG (NORMAL 80 A 100 )";
1400 IF PO2<80 THEN GOSUB 1460
1410 IF PO2>100 THEN GOSUB 1470
1420 IF PO2>80 AND PO2<100 THEN GOSUB 1480
1430 LPRINT:LPRINT TAB(35)"DIAGNOSTICO":T=40-(INT(LEN(DG$)/2))
1440 LPRINT ZB:LPRINT TAB(T);DG$:LPRINT ZB
1450 RETURN
1455 ' ----------- Subrotinas para interpretacao dos valores --------
1460 LPRINT TAB(64) "* DIMINUIDO":RETURN
1470 LPRINT TAB(64) "* AUMENTADO":RETURN
1480 LPRINT TAB(64) " ":RETURN
1650 LOCATE IL,64:PRINT "* DIMINUIDO":RETURN
1660 LOCATE IL,64:PRINT "* AUMENTADO":RETURN
1997 '------------ Subrotina de apagar parte da tela ---------------
2000 FOR YAP=IIAP TO IFAP:PRINT:LOCATE YAP,1:PRINT SPC(79);:NEXT
2030 RETURN
2270 '------------ Subrotina para resposta SIM/NAO -----------------
3000 LOCATE 23,1:PRINT SPACE$(79):LOCATE 23,1:PRINT M$;" (S/N) ? ";
3010 R$=UCASE$(INPUT$(1)):IF R$<>"S" AND R$<>"N" THEN 3000 ELSE RETURN
3990 '------------ Subrotina para alteracao de dado de entrada -----
4400 LOCATE 23,IC:PRINT "NUMERO DO DADO A SER ALTERADO ";
4410 ND$=INKEY$:IF ND$="" THEN 4410 ELSE ND=VAL(ND$):PRINT ND;
4420 IL=ND+12
4430 ON IL-11 GOTO 4440,4450,4460,4470,4480,4490,4500,4510,4520,4530
4440 PHZ=44:P$="G,35":GOSUB 9165:N$=W:RETURN
4450 PHZ=23:P$="G,06":GOSUB 9165:NR#=VAL(W):RETURN
4460 PHZ=20:P$="C":GOSUB 9165:DH$=W:RETURN
4470 PHZ=34:P$="C":GOSUB 9165:DC$=W:RETURN
4480 PHZ=24:P$="H":GOSUB 9165:H$=W:RETURN
4490 PHZ=30:P$="D4,2":GOSUB 9165:PH=VAL(W)
4495 IF PH<6.8 OR PH>7.8 THEN PRINT CHR$(7):GOTO 4490 ELSE RETURN
4500 PHZ=58:P$="D5,1":GOSUB 9165:PCO2=VAL(W)
4505 IF PCO2<10 OR PCO2>150 THEN PRINT CHR$(7):GOTO 4500 ELSE RETURN
4510 PHZ=52:P$="D5,1":GOSUB 9165:PO2=VAL(W)
4515 IF PO2<10 OR PO2>300 THEN PRINT CHR$(7):GOTO 4510 ELSE RETURN
4520 PHZ=44:P$="D4,1":GOSUB 9165:HB=VAL(W)
4525 IF HB<3 OR HB>30 THEN PRINT CHR$(7):GOTO 4520 ELSE RETURN
4530 PHZ=32:P$="D5,1":GOSUB 9165:PE=VAL(W)
4535 IF PE<.5 OR PE>300 THEN PRINT CHR$(7):GOTO 4530 ELSE RETURN
4540 IF CO$="S" OR CO$="s" THEN 120
4550 RETURN
9100 ' ----------- Subrotina para entrada de dados ------------------------
9165 PV=IL:PP=ASC(P$)-66:PRINT
9170 ON PP GOTO 9175,9180,9200,9200,9200,9205
9175 P=8:PF=P:P1=2:P2=5:WD="DD/MM/AA":WC="/":GOTO 9210
9180 P=VAL(MID$(P$,2,1)):PF=P:D=VAL(RIGHT$(P$,1)):P1=P-D-1:P2=P1
9185 WC=".":WD=STRING$(P1,95)+"."+STRING$(D,95):GOTO 9210
9200 P=VAL(RIGHT$(P$,2)):PF=1:P1=99:P2=P1:WD=STRING$(P,95):WC="":GOTO 9210
9205 P=5:PF=P:P1=2:P2=P1:WD="HH:MM":WC=":":GOTO 9210
9210 LOCATE PV,PHZ:PRINT WD;
9215 W="":WI="":PX=0
9220 IF PX=P THEN 9305
9225 LOCATE PV,PHZ
9226 FOR X=1 TO 100:WI=INKEY$:IF WI="" THEN NEXT:LOCATE PV,PHZ:PRINT " ";:FOR X=1 TO 100:WI=INKEY$:IF WI="" THEN NEXT:GOTO 9225
9230 PA=ASC(WI):IF PA=13 AND PX>=PF THEN 9305
9235 IF PA=8 AND PX>0 THEN 9290
9240 IF PP=5 THEN 9270
9245 IF PA<48 OR PA>57 THEN 9225 ELSE 9280
9270 IF PA<32 OR PA>122 THEN 9225 ELSE 9280
9280 LOCATE PV,PHZ:PRINT WI;
9282 PX=PX+1:W=W+WI:PHZ=PHZ+1
9283 IF PX=P1 OR PX=P2 THEN PX=PX+1:PHZ=PHZ+1:W=W+WC
9285 GOTO 9220
9290 LOCATE PV,PHZ:PRINT;:PHZ=PHZ-1:IF PX=1 THEN 9215 ELSE PX=PX-1
9295 IF PX=P1 OR PX=P2 THEN PHZ=PHZ-1:PX=PX-1
9300 W=LEFT$(W,PX):GOTO 9225
9305 LOCATE PV,PHZ:PRINT STRING$(P-LEN(W),32)
9310 ON PP GOTO 9320,9400,9400,9400,9400,9350
9320 D=VAL(LEFT$(W,2)):M=VAL(MID$(W,4,2)):A=VAL(RIGHT$(W,2))
9322 V=(M=4)+(M=6)+(M=9)+(M=11)
9330 V=V*(D>30)+(M=2)*((INT(A/4)=A/4)*(D>29)+(INT(A/4)<>A/4)*(D>28))
9335 V=V+((A<1)+(M<1)+(M>12)+(D<1)+(D>31)):GOTO 9370
9350 H=VAL(LEFT$(W,2)):M=VAL(RIGHT$(W,2))
9360 V=(H>24)+(M>59)
9370 IF V<>0 THEN PRINT CHR$(7);:PHZ=PHZ-LEN(W):GOTO 9210
9400 RETURN
Voltar ao artigo
Copyright (c) 1995 Renato M.E. Sabbatini