Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Pascal/Turbo Pascal » programa en pascal es urgente porfavor

Pascal/Turbo Pascal - programa en pascal es urgente porfavor

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

programa en pascal es urgente porfavor

Publicado por daniel (13 intervenciones) el 14/10/2013 20:13:42
porfavor necesito una ayuda urgente con esto porfavor lo necesito para el miercoles porfa asi sea algo sencillo pero q funcione gracias. feliz tarde

elaborar un programa que permita llevar el control de los examenes de una clinica para sus pacientes y para ello se requiere que manipule los siguientes archivos:

archivo 1: (secuencial): codigo paciente, resultado.
archivo 2: (secuencial):codigo paciente, codigo examen, datos personales.
archivo 3: (directo): codigo examen, datos del examen.

su programa debe estar en capacidad de agregar, modificar y eliminar datos en todos los archivos y ademas permitir consultar y elaborarr 2 reportes uno con los datos de los pacientes y examenes medicos y otro que totalice los diferentes examenes por paciente y por examenes. debe tomar en cuenta que no debe existir registros repetidos para evitar confunciones y ademas los resultados de los examenes deben ser precisos para cada paciente ya que eso peude ser catastrofico para dichos pacientes y a su vez le crea un problema de credibilidad a la clinica.

Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

programa en pascal es urgente porfavor

Publicado por ramon (2158 intervenciones) el 16/10/2013 19:27:17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
{Mira falta algo pero espero ayude}
 
program clinica;
 uses
    crt;
 type
    resultado = record
           codigop : longint;
         resultado : integer;
           end;
 
    datosperson = record
                  nombre : string[100];
                  numdni : longint;
                  direcc : string[100];
                    edad : integer;
                 end;
 
    datospers = record
             codigop : longint;
             codiexam : longint;
             datosp : datosperson;
           end;
 
    datosexamen = record
            codigop : longint;
            codiexam : longint;
         datosexamen : string;
              end;
 
 
 
  var
    f1 : file of resultado;
    f2 : file of datospers;
    f3 : file of datosexamen;
    da1 : resultado;
    da2 : datospers;
    da3 : datosexamen;
    co : longint;
 
  function existe(co : longint) : boolean;
  var
    paso : longint;
    siest : boolean;
    daa : resultado;
    f : file of resultado;
  begin
     paso := 0;
     siest := false;
     assign(f,'result.dat');
  {$I-} reset(f); {$I+}
  if ioresult = 0 then
  begin
   repeat
       seek(f,paso);
       read(f,daa);
       if daa.codigop = co then
       siest := true
     else
       paso := paso + 1;
   until (paso > filesize(f) - 1) or (siest = true);
   if siest = true then
   existe := true
 else
   existe := false;
   close(f);
  end;
 end;
 
 
  procedure agregar(cual : char);
  begin
    if upcase(cual) = 'R' then
    begin
      assign(f1,'result.dat');
   {$I-} reset(f1); {$I+}
   if ioresult <> 0 then
   begin
      rewrite(f1);
      seek(f1,0);
      write(f1,da1);
      close(f1);
   end
 else
     begin
       seek(f1,filesize(f1));
       write(f1,da1);
       close(f1);
     end;
   end;
   if upcase(cual) = 'D' then
   begin
    assign(f2,'datopers.dat');
   {$I-} reset(f2); {$I+}
   if ioresult <> 0 then
   begin
      rewrite(f2);
      seek(f2,0);
      write(f2,da2);
      close(f2);
   end
 else
     begin
       seek(f2,filesize(f2));
       write(f2,da2);
       close(f2);
     end;
   end;
   if upcase(cual) = 'E' then
   begin
      assign(f3,'examens.dat');
   {$I-} reset(f3); {$I+}
   if ioresult <> 0 then
   begin
      rewrite(f3);
      seek(f3,0);
      write(f3,da3);
      close(f3);
   end
 else
     begin
       seek(f3,filesize(f3));
       write(f3,da3);
       close(f3);
     end;
   end;
  end;
 
 
 
  procedure modificar(cual : char);
  var
    code : longint;
    pa : longint;
    encont : boolean;
    tca : char;
  begin
     clrscr;
     encont := false;
     writeln('**** Modificacion de datos ****');
     writeln;
     write('   Entre Codigo : ');
     readln(code);
     if upcase(cual) = 'R' then
     begin
        assign(f1,'result.dat');
   {$I-} reset(f1); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          pa := 0;
        repeat
           seek(f1,pa);
           read(f1,da1);
           if da1.codigop = code then
           begin
              encont := true;
           end
         else
            pa := pa + 1;
        until (pa > filesize(f1) - 1) or (encont = true);
        if encont = true then
        begin
           clrscr;
           writeln('>>>> Modificacion Resultados <<<<');
           writeln;
           writeln('   0 Todo');
           writeln('   1 Codigo    = ',da1.codigop);
           writeln('   2 Resultado = ',da1.resultado);
           writeln('   3 Nada');
           repeat
               tca := readkey;
           until tca in['0','1','2','3'];
       case tca of
    '0' : begin
             write('   Codigo    : ');
             readln(da1.codigop);
             write('   Resultado : ');
             readln(da1.resultado);
             seek(f1,pa);
             write(f1,da1);
             close(f1);
          end;
    '1' : begin
             write('   Codigo    : ');
             readln(da1.codigop);
             seek(f1,pa);
             write(f1,da1);
             close(f1);
          end;
    '2' : begin
             write('   Resultado : ');
             readln(da1.resultado);
             seek(f1,pa);
             write(f1,da1);
             close(f1);
          end;
    '3' : close(f1);
      end;
    end;
   end;
  end;
     if upcase(cual) = 'D' then
     begin
     assign(f2,'datopers.dat');
   {$I-} reset(f2); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          pa := 0;
        repeat
           seek(f2,pa);
           read(f2,da2);
           if da2.codigop = code then
           begin
              encont := true;
           end
         else
            pa := pa + 1;
        until (pa > filesize(f2) - 1) or (encont = true);
        if encont = true then
        begin
           clrscr;
           writeln('>>>> Modificacion De Datos <<<<');
           writeln;
           writeln('   0 Todo');
           writeln('   1 Codigo      = ',da2.codigop);
           writeln('   2 Codigo Exam = ',da2.codiexam);
           writeln('   3 Nombre      = ',da2.datosp.nombre);
           writeln('   4 Num DNI     = ',da2.datosp.numdni);
           writeln('   5 Direccion   = ',da2.datosp.direcc);
           writeln('   6 Edad        = ',da2.datosp.edad);
           writeln('   7 Nada');
           repeat
               tca := readkey;
           until tca in['0','1','2','3','4','5','6','7'];
       case tca of
    '0' : begin
             write('   Codigo      : ');
             readln(da2.codigop);
             write('   Codigo Exam : ');
             readln(da2.codiexam);
             write('   Nombre      : ');
             readln(da2.datosp.nombre);
             write('   Num DNI     : ');
             readln(da2.datosp.numdni);
             write('   Direccion   : ');
             readln(da2.datosp.direcc);
             write('   Edad        : ');
             readln(da2.datosp.edad);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '1' : begin
             write('   Codigo      : ');
             readln(da2.codigop);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '2' : begin
             write('   Codigo Exam : ');
             readln(da2.codiexam);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '3' : begin
             write('   Nombre      : ');
             readln(da2.datosp.nombre);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '4' : begin
             write('   Num DNI     : ');
             readln(da2.datosp.numdni);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '5' : begin
             write('   Direccion   : ');
             readln(da2.datosp.direcc);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '6' : begin
             write('   Edad        : ');
             readln(da2.datosp.edad);
             seek(f2,pa);
             write(f2,da2);
             close(f2);
          end;
    '7' : close(f2);
      end;
        end;
       end;
     end;
     if upcase(cual) = 'E' then
     begin
     assign(f3,'examens.dat');
   {$I-} reset(f3); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          pa := 0;
        repeat
           seek(f3,pa);
           read(f3,da3);
           if da3.codigop = code then
           begin
              encont := true;
           end
         else
            pa := pa + 1;
        until (pa > filesize(f3) - 1) or (encont = true);
        if encont = true then
        begin
          clrscr;
           writeln('>>>> Modificacion Datos Examen <<<<');
           writeln;
           writeln('   0 Todo');
           writeln('   1 Codigo        = ',da3.codigop);
           writeln('   2 Codigo Examen = ',da3.codiexam);
           writeln('   3 Datos Examen  = ',da3.datosexamen);
           writeln('   4 Nada');
           repeat
               tca := readkey;
           until tca in['0','1','2','3','4'];
       case tca of
    '0' : begin
             write('   Codigo       : ');
             readln(da3.codigop);
             write('   Codigo Exam  : ');
             readln(da3.codiexam);
             write('   Datos Examen : ');
             readln(da3.datosexamen);
             seek(f3,pa);
             write(f3,da3);
             close(f3);
          end;
    '1' : begin
             write('   Codigo       : ');
             readln(da3.codigop);
             seek(f3,pa);
             write(f3,da3);
             close(f3);
          end;
    '2' : begin
             write('   Codigo Exam  : ');
             readln(da3.codiexam);
             seek(f3,pa);
             write(f3,da3);
             close(f3);
          end;
    '3' : begin
             write('   Datos Examen : ');
             readln(da3.datosexamen);
             seek(f3,pa);
             write(f3,da3);
             close(f3);
          end;
    '4' : close(f1);
      end;
     end;
    end;
  end;
 end;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

programa en pascal es urgente porfavor

Publicado por ramon (2158 intervenciones) el 16/10/2013 19:28:26
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
{Segunda parte}
 
  procedure borrar;
  var
     encont : boolean;
     tt, borra, pa, code : longint;
     da4 : datospers;
     da5 : resultado;
     da6 : datosexamen;
     temp2 : file of datospers;
     temp1 : file of resultado;
     temp3 : file of datosexamen;
  begin
     clrscr;
     encont := false;
     writeln('**** Modificacion de datos ****');
     writeln;
     write('   Entre Codigo : ');
     readln(code);
     assign(f2,'datopers.dat');
   {$I-} reset(f2); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          pa := 0;
        repeat
           seek(f2,pa);
           read(f2,da2);
           if da2.codigop = code then
           encont := true
         else
          pa := pa + 1;
        until (pa > filesize(f2) - 1) or (encont = true);
        if encont = true then
        begin
           borra := 0;
           tt := 0;
           assign(temp2,'Temporal.sis');
           rewrite(temp2);
         repeat
           seek(f2,borra);
           read(f2,da2);
           if borra <> pa then
           begin
              da4 := da2;
              seek(temp2,tt);
              write(temp2,da4);
              tt := tt + 1;
           end;
           borra := borra + 1;
        until borra > filesize(f2) - 1;
        close(f2);
        close(temp2);
        erase(f2);
        rename(temp2,'datopers.dat');
      end;
    end;
        assign(f1,'result.dat');
      {$I-} reset(f1); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          borra := 0;
          encont := false;
       repeat
           seek(f1,borra);
           read(f1,da1);
           if da1.codigop = code then
           encont := true
         else
           borra := borra + 1;
       until (borra > filesize(f1) - 1) or (encont = true);
       if encont = true then
       begin
          assign(temp1,'tempor.sis');
          rewrite(temp1);
          pa := 0;
          tt := 0;
        repeat
           seek(f1,pa);
           read(f1,da1);
           if pa <> borra then
           begin
              da5 := da1;
              seek(temp1,tt);
              write(temp1,da5);
              tt := tt + 1;
           end;
           pa := pa + 1;
        until pa > filesize(f1) - 1;
        close(f1);
        close(temp1);
        erase(f1);
        rename(temp1,'result.dat');
        end;
       end;
      assign(f3,'examens.dat');
      {$I-} reset(f3); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          borra := 0;
          encont := false;
       repeat
           seek(f3,borra);
           read(f3,da3);
           if da3.codigop = code then
           encont := true
         else
           borra := borra + 1;
       until (borra > filesize(f3) - 1) or (encont = true);
       if encont = true then
       begin
          assign(temp3,'tempora.sis');
          rewrite(temp3);
          pa := 0;
          tt := 0;
        repeat
           seek(f3,pa);
           read(f3,da3);
           if pa <> borra then
           begin
              da6 := da3;
              seek(temp3,tt);
              write(temp3,da6);
              tt := tt + 1;
           end;
           pa := pa + 1;
        until pa > filesize(f3) - 1;
        close(f3);
        close(temp3);
        erase(f3);
        rename(temp3,'examens.dat');
        end;
      end;
   end;
 
  procedure consultar;
  var
    vux, code : longint;
    si : boolean;
  begin
     writeln('**** Modificacion de datos ****');
     writeln;
     write('   Entre Codigo : ');
     readln(code);
     assign(f2,'datopers.dat');
   {$I-} reset(f2); {$I+}
      if ioresult <> 0 then
      begin
         writeln;
         writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
         readkey;
      end
    else
       begin
          vux := 0;
          si := false;
        repeat
           seek(f2,vux);
           read(f2,da2);
           if da2.codigop = code then
           si := true
         else
           vux := vux + 1;
        until (vux > filesize(f2) - 1) or (si = true);
        if si = true then
        begin
          writeln('**** Consulta Personal ****');
          writeln;
          writeln('   Codigo     = ',da2.codigop);
          writeln('   Codigo Exm = ',da2.codiexam);
          writeln('   Nombre     = ',da2.datosp.nombre);
          writeln('   Numero DNI = ',da2.datosp.numdni);
          writeln('   Direccion  = ',da2.datosp.direcc);
          writeln('   Edad       = ',da2.datosp.edad);
          close(f2);
          assign(f1,'result.dat');
         {$I-} reset(f1); {$I+}
         if ioresult <> 0 then
         begin
            writeln;
            writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
            readkey;
         end
       else
          begin
             vux := 0;
             si := false;
          repeat
               seek(f1,vux);
               read(f1,da1);
               if da1.codigop = code then
               si := true
             else
               vux := vux + 1;
          until (vux > filesize(f1) - 1) or (si = true);
            if si = true then
            begin
          writeln('   Resultado  = ',da1.resultado);
            end;
          end;
           close(f1);
          assign(f3,'examens.dat');
         {$I-} reset(f3); {$I+}
         if ioresult <> 0 then
         begin
            writeln;
            writeln('<<<< El Archivo No Existe Pulse Una Tecla >>>>');
            readkey;
         end
       else
          begin
             vux := 0;
             si := false;
          repeat
               seek(f3,vux);
               read(f3,da3);
               if da3.codigop = code then
               si := true
             else
               vux := vux + 1;
          until (vux > filesize(f3) - 1) or (si = true);
            if si = true then
            begin
          writeln('   Codigo Exam.  = ',da3.codiexam);
          writeln('   Datos Exam.   = ',da3.datosexamen);
            end;
          end;
           close(f3);
          writeln;
       end;
    end;
  end;
 
  procedure reportepaciente;
  begin
 
  end;
 
  procedure totalexamen;
  begin
 
  end;
 
 
  procedure menu;
  var
    opc, teb : char;
    sal : boolean;
  begin
      sal := false;
    repeat
       clrscr;
       writeln('***** Menu Principal *****');
       writeln;
       writeln('  1 = Entradas Examenes');
       writeln('  2 = Borrado ');
       writeln('  3 = Modificacion');
       writeln('  4 = Consultar');
       writeln('  5 = Reportes');
       writeln('  6 = Salir');
       writeln;
       writeln('<<<<<< Elija Opcion >>>>>>');
       repeat
           teb := readkey;
       until teb in['1','2','3','4','5','6'];
       clrscr;
     case teb of
  '1' : begin
              write('   Entre Codigo : ');
           readln(co);
           if existe(co) = false then
           begin
              da1.codigop := co;
              write('   Resultado    : ');
              readln(da1.resultado);
              agregar('R');
              da2.codigop := co;
              write('   Codigo Exam. : ');
              readln(da2.codiexam);
              write('   Nombre       : ');
              readln(da2.datosp.nombre);
              write('   Num. DNI     : ');
              readln(da2.datosp.numdni);
              write('   Direccion    : ');
              readln(da2.datosp.direcc);
              write('   Edad         : ');
              readln(da2.datosp.edad);
              agregar('D');
              da3.codigop := co;
              da3.codiexam := da2.codiexam;
              write('   Datos Examen : ');
              readln(da3.datosexamen);
              agregar('E');
           end
         else
            begin
            writeln('???? El Codigo Entrado Ya Existe Pulse Una Tecla ????');
            readkey;
            end;
        end;
  '2' : borrar;
  '3' : begin
           clrscr;
   writeln('*** Modificar ***');
   writeln('Elija [R]=Resultados  [D]=Datos Personales   [E]=Examen');
         repeat
            opc := upcase(readkey);
         until opc in['R','D','E'];
         clrscr;
      case opc of
   'R' : modificar('R');
   'D' : modificar('D');
   'E' : modificar('E');
      end;
       end;
  '4' : consultar;
  '5' : begin
           writeln('**** Presentacion De Reportes ****');
           writeln('    Falta Implementar');
           writeln('<<<< Pulse Una Tecla >>>>');
           readkey;
        end;
  '6' : sal := true;
    end;
    until sal = true;
  end;
 
 
  begin
     menu;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar