|
999 RETURN
10 ' ESTAD1 - Revision 19/4/89
20 GOSUB 1000
25 IF ITE>0 THEN CHAIN "ESTAD"+RIGHT$(STR$(ITE),1)
50 CHAIN "ESTAD"
200 ' EST91 Definicion de Variables
205 ' ---------------------------
210 GOSUB 500
215 IF NV=0 THEN 265
220 PRINT
225 GOSUB 730
255 INPUT " Definicion de Nuevas Variables ? (N) = ",A$
260 IF A$<>"S" AND A$<>"s" THEN RETURN
265 PRINT
270 K=0
273 IF KNV=0 THEN KNV=NC
275 WHILE K<=KNV-1
280 K=K+1 : NV=K
290 PRINT " Variable Nro.";K; : INPUT "= ",A$
295 IF LEN(A$)=0 AND K=1 THEN NV=0 : RETURN
300 IF LEN(A$)=0 THEN NV=K-1 : K=KNV : GOTO 320
305 J=VAL(A$)
310 IF J<1 OR J>NC THEN KE=4 : GOSUB 900 : GOTO 290
311 IF K=1 THEN 318
312 FOR M=1 TO K-1
313 IF J=JX(M) THEN PRINT CHR$(7) : PRINT :
INPUT "** VARIABLE REPETIDA",A$ : PRINT : GOTO 290
315 NEXT M
318 JX(K)=J
320 WEND
324 IF KDA=1 THEN JF=0 : KDA=0 : NX=NF : RETURN
325 PRINT
330 INPUT " Variable para Observaciones Agrupadas (No) = ",A$
335 IF LEN(A$)=0 THEN JF=0 : GOTO 350
340 JF=VAL(A$)
345 IF JF<1 OR JF>NC THEN KE=4 : GOSUB 900 : GOTO 330
347 IF JF=0 THEN NX=NF : RETURN
350 KE=0 : NX=0
355 FOR I=1 TO NF
370 ND=1 : IF JF>0 THEN ND=A(I,JF)
372 IF ND=XVF THEN 380
373 IF ND<0 THEN KE=1
375 NX=NX+ND
380 NEXT I
383 IF KE=1 THEN PRINT : PRINT CHR$(7) : PRINT "** VALOR <0 EN VARIABLE";JF; :
INPUT "",A$ : GOTO 325
385 RETURN
390 ' EST92 - Seleccion de Variable
395 ' ----------------------------
400 J=0
405 IF NC=0 OR KVA=1 THEN KVA=0 : GOTO 412
410 GOSUB 500
412 PRINT
415 INPUT " Posicion de Variable a utilizar = ",A$
420 IF LEN(A$)=0 THEN RETURN
425 X=VAL(A$)
430 IF X<1 OR X>NCM THEN KE=4 : GOSUB 900 : GOTO 415
435 IF LEN(TC$(X))=0 OR LEFT$(TC$(X),2)=" " THEN 455
440 PRINT : PRINT " Variable";X;" actual = ",TC$(X)
445 INPUT " Se utiliza ? (N) = ",A$
450 IF A$<>"S" AND A$<>"s" THEN 415
451 PRINT : INPUT " Borrado de Datos existentes ? (N) = ",A$
452 IF A$="S" OR A$="s" THEN FOR I=1 TO NFM : A(I,X)=0 : NEXT I
455 PRINT : PRINT " Nombre de la Variable";X; : INPUT " = ",A$
460 IF LEN(A$)=0 AND TC$(X)<>" " THEN 485
465 IF LEN(A$)=0 OR LEFT$(A$,8)=" " THEN 415
470 TC$(X)=LEFT$(A$,8)
485 IF NC<X THEN NC=X
490 J=X
495 RETURN
500 ' EST93 - Variables en memoria
505 ' ----------------------------
510 PRINT : PRINT " Variables en Memoria" : PRINT
515 I=1
520 FOR L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
545 PRINT
550 RETURN
555 ' EST94 Encabezamiento Pantallas y Resultados
560 ' -------------------------------------------
565 IF DS$="SCRN:" THEN PRINT CHR$(12);
570 PRINT#3,"Proceso : ";TP$;TAB(70);DATE$
575 IF TSP$>"" THEN PRINT#3,TAB(11);TSP$ ELSE PRINT
577 A$=NA$ : IF NF=0 THEN A$="No hay Datos en Memoria"
580 PRINT#3,"Datos : ";A$;" - ";N$
583 IF JF>0 THEN PRINT#3,TAB(11);"Variable para Observaciones Agrupadas = ";
JF;"-";TC$(JF)
585 IF CD$>"" THEN PRINT#3,TAB(11);"Condicion de Seleccion = ";CD$
590 IF NX>0 THEN PRINT#3,TAB(11);"Numero de Observac.: ";
595 IF NX>0 THEN PRINT#3,"Totales =";NX;
597 IF NXX>0 THEN PRINT#3," / Consideradas =";NXX ELSE PRINT#3,
600 KA=1 : KB=79 : GOSUB 695
605 PRINT#3,
610 RETURN
650 ' EST95 Seleccion de Dispositivo de Salida
655 ' ----------------------------------------
660 CLOSE#3 : KS=0 : DS$="SCRN:"
665 PRINT : INPUT "Salida por Impresora/I/ o a un Archivo/Nombre/ (No) = ",A$
670 IF LEN(A$)=0 THEN OPEN DS$ FOR OUTPUT AS #3 : RETURN
673 KS=1 : DS$="LPT1:"
675 IF A$="i" OR A$="I" THEN OPEN DS$ FOR OUTPUT AS#3 : RETURN
680 DS$=A$
685 OPEN DS$+".TXT" FOR APPEND AS #3
690 RETURN
695 ' EST96 Subrayado
700 ' ---------------
705 PRINT#3,TAB(KA);
710 FOR S=KA TO KB : PRINT#3,TAB(S);"-"; : NEXT S : PRINT#3,
715 RETURN
730 ' EST97 - Variables definidas
735 ' ---------------------------
740 I=1
743 IF KX=0 THEN PRINT#3," Variables ya Definidas" : PRINT#3,
745 IF KX=1 THEN PRINT#3," Variables Consideradas" : PRINT#3,
750 FOR K=1 TO NV
755 J=JX(K)
760 PRINT#3,TAB(15*I-11);J;"-";TC$(J);
765 I=I+1 : IF I>5 THEN I=1 : PRINT#3,
770 NEXT K
773 PRINT#3, : PRINT#3, : KX=0
775 RETURN
900 ' EST99 - SUBRUTINA DE MENSAJES
905 ' -----------------------------
910 PRINT CHR$(7) : PRINT
911 IF KE=1 THEN INPUT "** NO HAY DATOS EN MEMORIA ",A$ : KE=0 : RETURN
912 IF KE=2 THEN INPUT "** NUMERO DE VARIABLES NO ADECUADO PARA EL PROCESO ",A$
: KE=0 : RETURN
915 IF KE=3 THEN INPUT "** NUMERO DE OBSERVAC.INSUFICIENTE PARA EL PROCESO ",A$
: KE=0 : RETURN
928 IF KE=9 THEN INPUT "** PROCESO NO ADECUADO A LOS DATOS CONSIDERADOS ",A$ :
KE=0 : RETURN
929 IF KE=4 THEN INPUT "** VARIABLE NO EXISTENTE O SIN DATOS ",A$ :
KE=0 : RETURN
930 IF KE=5 THEN PRINT "** VALOR ERRONEO - Debe ser ";B$ : INPUT " ",A$ :
KE=0 : RETURN
931 IF KE=6 THEN INPUT "** CAPACIDAD INSUFICIENTE DE MEMORIA DE TRABAJO",A$ :
KE=0 : RETURN
934 INPUT "Valor Erroneo ",A$
935 RETURN
936 IF ERR<>53 THEN PRINT CHR$(7) : PRINT
937 IF ERR<>53 THEN KE=KE+1 : IF KE>1 THEN RESUME 948
938 IF ERR=25 OR ERR=57 OR ERR=68 OR ERR=70 OR ERR=71 THEN PRINT "** DISPOSITIVO ";XDDA$;
" NO DISPONIBLE O ERROR E/S"; : INPUT " ",A$ : RESUME NEXT
939 IF ERR=61 THEN PRINT "** DISCO ";XDDA$;" LLENO" : INPUT " ",A$ : RESUME
940 IF ERR=53 THEN KAR=1 : RESUME NEXT
941 IF ERR=62 THEN PRINT "** FIN DE GRABACION O LECTURA EN DISP. ";XDDA$; : INPUT "
",A$ : RESUME NEXT
942 IF ERR=2 OR ERR=22 THEN PRINT "** ERROR DE SINTAXIS EN FUNCION "; : INPUT "O
CONDICION",A$ : RESUME NEXT
943 IF ERR=24 OR ERR=27 THEN INPUT "** PROBLEMA EN IMPRESORA",A$ : RESUME NEXT
944 IF ERR=64 OR ERR=75 OR ERR=76 THEN INPUT "** NOMBRE INCORRECTO ARCHIVO",A$ : RESUME
947 PRINT "Error";ERR;"en linea";ERL :STOP
948 CHAIN"ESTAD"
950 ' EST98 - Descripcion Archivo
952 ' ---------------------------
954 LD=0
956 IF MID$(A$,2,1)<>":" THEN XDDA$=DDA$+":" : GOTO 964
958 B$=LEFT$(A$,1)
960 'IF INSTR("ABCabc",B$)=0 THEN GOSUB 900 : RETURN
962 XDDA$="" : LD=2
964 B$=RIGHT$(A$,4)
966 IF LEFT$(B$,1)<>"." THEN EXT$=XA$ ELSE EXT$="" : LD=LD+4
968 'IF LEN(A$)-LD>8 THEN GOSUB 900
970 KAR=0 : KE=0
972 OPEN XDDA$+A$+EXT$ FOR INPUT AS#1
974 CLOSE#1
978 RETURN
980 ' EST9. - Presentacion Menu
982 ' -------------------------
983 PRINT : ISP=0 : A$=""
984 FOR K=1 TO KL
986 PRINT " ";K;"- ";TF$(K)
988 NEXT K
990 PRINT : PRINT "Opcion Elegida = ";
991 B$=INPUT$(1) : PRINT B$;
992 IF B$=CHR$(13) THEN 996
993 IF B$=CHR$(27) THEN A$="" : GOTO 996
994 A$=A$+B$ : GOTO 991
996 IF LEN(A$)=0 THEN RETURN
997 ISP=INT(VAL(A$))
998 IF ISP<1 OR ISP>KL THEN PRINT CHR$(7) : GOTO 983
999 RETURN
1000 ' EST1 - Manejo de Datos
1005 ' ----------------------
1010 DEFINT I-N
1015 COMMON ITE,NFM,NCM,A(),TC$(),NC,NF,NX,DDA$,NDE,NV,JX(),P(),DA$,NA$,CD$,
PAR1,PAR2,XVF
1017 ON ERROR GOTO 936
1020 X=2*NFM : IF NCM>X THEN X=NCM
1025 Y=NFM : IF NCM>Y THEN Y=NCM
1030 DIM TCX$(200),TF$(8),VX(X),VY(Y),V(Y),NVC(2),VC(PAR1,2)
1033 DIM ARC$(3),IA(2),IB(2),NFT(2),NCT(2),NIJ(2),NVS(2)
1035 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
1040 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1045 WHILE KW=0
1050 TP$="MANEJO DE DATOS" : TSP$=""
1055 NXX=0
1060 GOSUB 555
1065 PRINT TAB(70);FRE(0)
1070 PRINT "PROCESOS"
1075 TF$(1)="Ingreso y Modificacion de Datos"
1080 TF$(2)="Creacion de Archivo de Datos"
1085 TF$(3)="Lectura de Archivo de Datos"
1090 TF$(4)="Union de Archivos"
1095 TF$(5)="Salida de Datos"
1100 TF$(6)="Seleccion de Datos"
1105 TF$(7)="Transformacion de Datos"
1110 TF$(8)="Cambio de Parametros"
1115 KL=8 : GOSUB 980
1119 IF ISP=0 AND ITE>1 THEN CHAIN "ESTAD"+RIGHT$(STR$(ITE),1)
1120 IF ISP=0 AND ITE=1 THEN CHAIN "ESTAD"
1125 IF (ISP=2 OR ISP=6 OR ISP=7) AND NF=0 THEN KE=1: GOSUB 900 : GOTO 1060
1130 ON ISP GOSUB 1145,2000,2500,3470,4005,4300,4475,7500
1135 WEND
1140 '
1145 ' EST11 - Ingreso de Datos
1150 ' ------------------------
1155 WHILE KW=0
1160 TSP$="Ingreso de Datos"
1165 GOSUB 555
1167 PRINT "PROCESOS"
1170 TF$(1)="Ingreso por Observacion"
1175 TF$(2)="Ingreso por Variable"
1180 TF$(3)="Insercion de Observaciones"
1185 TF$(4)="Eliminacion de Observaciones"
1190 KL=4 : GOSUB 980
1195 IF ISP=0 THEN RETURN
1200 IF ISP>2 OR NC=0 THEN 1215
1205 PRINT : INPUT "Borrado de Memoria de Trabajo ? (N) = ",A$
1210 IF A$="S" OR A$="s" THEN GOSUB 1250
1215 PRINT
1220 PRINT "Descripcion actual de los Datos = ";DA$
1225 INPUT "Nueva Descripcion (Idem) = ",A$
1230 IF LEN(A$)>0 THEN DA$=A$
1235 ON ISP GOSUB 1300,1510,1625,1855
1240 WEND
1245 '
1250 DA$="" : NA$=""
1255 NC=0 : NF=0 :NX=0
1260 FOR J=1 TO NCM
1265 TC$(J)=" "
1270 FOR I=1 TO NFM
1275 A(I,J)=XVF
1280 NEXT I
1285 NEXT J
1290 RETURN
1295 '
1300 ' EST 111 - Ingreso de Datos por Observacion
1305 ' ------------------------------------------
1310 TSP$=TSP$+" - Por Observacion"
1315 GOSUB 555
1320 IF NC>0 THEN GOSUB 500
1325 PRINT : INPUT "Variable Inicial a Ingresar = ",A$
1330 IF LEN(A$)=0 THEN RETURN
1335 JI=VAL(A$)
1340 IF JI<1 OR JI>NCM THEN KE=4 : GOSUB 900 : GOTO 1325
1345 PRINT : INPUT "Variable Final a Ingresar = ",A$
1350 IF LEN(A$)=0 THEN RETURN
1355 JJ=VAL(A$)
1360 IF JJ<JI OR JJ>NCM THEN KE=5 : B$=">="+STR$(JI)+" y <="+STR$(NCM) :
GOSUB 900 : GOTO 1345
1365 IF NC=0 THEN 1380
1370 PRINT : INPUT "Actualizacion Nombres de Variables ? (N) = ",A$
1375 IF A$<>"S" AND A$<>"s" THEN 1415
1380 PRINT
1385 FOR K=JI TO JJ
1390 PRINT " Nombre de la Variable";K;TAB(29);"(";TC$(K);TAB(38);")"; : INPUT " =
1395 IF LEN(A$)=0 THEN 1405
1400 TC$(K)=LEFT$(A$,8)
1405 NEXT K
1410 IF NC<JJ THEN NC=JJ
1415 WHILE KW=0
1420 PRINT: INPUT "Observacion Inicial a Ingresar = ",A$
1425 IF LEN(A$)=0 THEN RETURN
1430 I=VAL(A$)
1435 IF I<1 OR I>NFM THEN KE=5 : B$=">=1 y <="+STR$(NFM) :
GOSUB 900 : GOTO 1420
1440 WHILE I<=NFM
1445 PRINT: PRINT "Ingreso Observacion";I
1450 FOR J=JI TO JJ
1455 PRINT " ";J;" - ";TC$(J);TAB(18); : INPUT " = ",A$
1460 IF LEN(A$)=0 THEN I=NFM+1 : J=JJ : GOTO 1470
1465 A(I,J)= VAL(A$)
1470 NEXT J
1475 IF I>NF AND I<=NFM THEN NF=I
1480 IF I=NFM THEN PRINT : INPUT "Se alcanzo el Nro. Maximo de Observaciones"
1485 I=I+1
1490 WEND
1495 NX=NF
1500 WEND
1505 '
1510 ' EST112 - Ingreso de Datos por Variable
1515 ' --------------------------------------
1520 TSP$=TSP$+" - Por Variable"
1525 GOSUB 555
1527 JZ=0
1529 IF NC=0 THEN 1535
1530 GOSUB 500
1531 PRINT : INPUT " Variable de Referencia (No) = ",A$
1532 IF LEN(A$)=0 THEN 1535
1533 JZ=VAL(A$)
1534 IF JZ<1 OR JZ>NC THEN KE=4 : GOSUB 900 : GOTO 1531
1535 WHILE KW=0
1537 KVA=1
1538 GOSUB 390
1540 IF J=0 THEN RETURN
1545 PRINT: INPUT "Observacion Inicial a Ingresar (1) = ",A$
1550 IF LEN(A$)=0 THEN I=1 : GOTO 1565
1555 I=VAL(A$)
1560 IF I<1 OR I>NFM THEN KE=5 : B$=">=1 y <="+STR$(NFM) :
GOSUB 900 : GOTO 1545
1565 PRINT
1570 WHILE I<=NFM
1575 PRINT "Observacion";I;
1577 IF JZ>0 THEN PRINT TAB(17);"/";A(I,JZ);"/";
1578 INPUT " = ",A$
1580 IF LEN(A$)=0 THEN I=NFM+1 : GOTO 1605
1585 A(I,J)= VAL(A$)
1590 IF I>NF THEN NF=I
1595 IF I=NFM THEN PRINT : INPUT "Se alcanzo el Nro. Maximo de Observaciones"
1600 I=I+1
1605 WEND
1610 NX=NF
1615 WEND
1620 '
1625 ' EST113 - Insercion de Observaciones
1630 ' -----------------------------------
1635 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
1637 TSP$=TSP$+" - Insercion de Observaciones"
1638 GOSUB 555
1640 PRINT "Numero de observaciones en Memoria" : PRINT
1645 PRINT " Existentes = ";NF
1650 PRINT " Maximas Posibles =";NFM
1652 IF NF=NFM THEN INPUT " (No hay lugar en Memoria para la Insercion", A$ : RETURN
1655 PRINT : INPUT "Observacion donde se inicia la Insercion = ",A$
1660 IF LEN(A$)=0 THEN RETURN
1665 II=VAL(A$)
1670 IF II<1 OR II>NF+1 THEN KE=5 : B$=">=1 y <="+STR$(NF+1) :
GOSUB 900 : GOTO 1655
1675 PRINT : INPUT "Numero de Observaciones a Insertar = ",A$
1680 IF LEN(A$)=0 THEN RETURN
1685 NI=VAL(A$)
1690 IF NI<1 OR NI>NFM-NF THEN KE=5 : B$=">=1 y <="+STR$(NFM-NF) :
GOSUB 900 : GOTO 1675
1695 IF II=NF+1 THEN 1750
1700 FOR I=NF TO II STEP -1
1705 FOR J=1 TO NCM
1710 A(I+NI,J)=A(I,J)
1715 NEXT J
1720 NEXT I
1725 FOR I=II TO II+NI-1
1730 FOR J=1 TO NCM
1735 A(I,J)=XVF
1740 NEXT J
1745 NEXT I
1755 IF NC>0 THEN GOSUB 500
1760 PRINT : PRINT "Variable Inicial a Ingresar (1)"; : INPUT " = ",A$
1765 IF LEN(A$)=0 THEN KI=1 : GOTO 1780
1770 KI=VAL(A$)
1775 IF KI<1 OR KI>NCM THEN KE=5 : B$=">=1 y <="+STR$(NCM) :
GOSUB 900 : GOTO 1760
1780 PRINT : PRINT "Variable Final a Ingresar (";NC;")"; : INPUT " = ",A$
1785 IF LEN(A$)=0 THEN KF=NC : GOTO 1800
1790 KF=VAL(A$)
1795 IF KF<1 OR KF>NCM THEN KE=5 : B$=">=1 y <="+STR$(NCM) :
GOSUB 900 : GOTO 1780
1800 I=II
1805 FOR I=II TO II+NI-1
1810 PRINT: PRINT "Ingreso Observacion";I
1815 FOR J=KI TO KF
1820 PRINT " ";J;" - ";TC$(J);TAB(18); : INPUT " = ",A$
1825 IF LEN(A$)=0 THEN J=KF : I=II+NI-1 : GOTO 1835
1830 A(I,J)= VAL(A$)
1835 NEXT J
1840 NEXT I
1843 NF=NF+NI : NX=NF
1844 PRINT : INPUT "Insercion Terminada - Enter ",A$
1845 RETURN
1850 '
1855 ' EST114 - Eliminacion de Observaciones
1860 ' -------------------------------------
1865 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
1867 TSP$=TSP$+" - Eliminacion de Observaciones"
1868 GOSUB 555
1870 PRINT "Numero de Observaciones en Memoria = ";NF
1885 PRINT : INPUT "Observacion Inicial a Eliminar = ",A$
1890 IF LEN(A$)=0 THEN RETURN
1895 II=VAL(A$)
1900 IF II<1 OR II>NF THEN KE=5 : B$=">=1 y <="+STR$(NF) :
GOSUB 900 : GOTO 1885
1905 PRINT : INPUT "Observacion Final a Eliminar = ",A$
1910 IF LEN(A$)=0 THEN RETURN
1915 IJ=VAL(A$)
1920 IF IJ<II OR IJ>NF THEN KE=5 : B$=">="+STR$(II)+"<="+STR$(NF) :
GOSUB 900 : GOTO 1885
1925 PRINT : PRINT "Observaciones a Eliminar ";II;"a";IJ; : INPUT "? (N) = ",A$
1930 IF A$<>"S" AND A$<>"s" THEN 1865
1935 FOR I=IJ+1 TO NF
1940 FOR J=1 TO NCM
1945 A(I-IJ+II,J)=A(I,J)
1950 A(I,J)=XVF
1955 NEXT J
1960 NEXT I
1965 NF=NF-IJ+II-1 : NX=NF
1970 PRINT : INPUT "Eliminacion Terminada - Enter ",A$
1975 RETURN
1980 '
2000 ' EST12 - Creacion de Archivo de Datos
2005 ' ------------------------------------
2010 TSP$="Creacion de Archivo de Datos"
2015 GOSUB 555
2017 PRINT "VARIABLES A GRABAR"
2020 TF$(1)="Todas las Variables"
2025 TF$(2)="Variables Seleccionadas"
2030 KL=2 : GOSUB 980
2035 IF ISP=0 THEN RETURN
2040 WHILE ISP=1
2045 FOR J=1 TO NC : VX(J)=J : NEXT J : NCK=NC
2050 ISP=0
2055 WEND
2060 WHILE ISP=2
2065 NCX=NC
2075 GOSUB 500
2080 PRINT : GOSUB 2405
2085 IF NCK=0 THEN RETURN
2090 ISP=0
2095 WEND
2100 KC=0 : IF CD$="" THEN 2120
2105 PRINT : INPUT "Se considera Condicion de Seleccion ? (N) = ",A$
2110 IF A$="S" OR A$="s" THEN KC=1
2120 NFX=NF : M=1
2125 GOSUB 2390
2155 NZ=0
2160 FOR I=IA(1) TO IB(1)
2165 IF KC=1 AND A(I,0)=1 THEN 2175
2170 NZ=NZ+1
2175 NEXT I
2180 PRINT : PRINT "TIPO DE ARCHIVO A CREAR"
2185 TF$(1)="Archivo ESTAD (.EST)"
2190 TF$(2)="Archivo LOTUS (.PRN)"
2195 TF$(3)="Archivo ASCII (.ASF)"
2200 KL=3 : GOSUB 980
2205 IF ISP=0 THEN RETURN
2210 IF ISP=1 THEN XA$=".EST"
2215 IF ISP=2 THEN XA$=".PRN"
2220 IF ISP=3 THEN XA$=".ASF"
2225 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
2226 PRINT : FILES DDA$+":*"+XA$
2230 IF KAR=1 THEN PRINT " No Existen" : KAR=0
2235 PRINT : INPUT "Nombre del Archivo a Crear = ",A$
2240 IF LEN(A$)=0 THEN RETURN
2245 KE=0
2250 GOSUB 950
2253 XNA$=A$
2255 IF KAR=0 THEN PRINT : INPUT "Archivo Existente - Se Reemplaza ? (N) = ",A$
2260 IF KAR=0 AND (A$<>"S" AND A$<>"s") THEN 2235
2265 IF KE=1 THEN 2235
2267 IF ISP>1 THEN 2275
2269 PRINT : PRINT "Descripcion actual de los Datos = ";DA$
2270 PRINT : INPUT "Nueva Descripcion (Idem) = ",A$
2271 IF LEN(A$)>0 THEN DAX$=A$ ELSE DAX$=DA$
2275 IF ISP=1 THEN 2290
2280 PRINT : INPUT "Nombres de Variables en Primer Registro ? (N) = ",A$
2285 KNM=0 : IF A$="S" OR A$="s" THEN KNM=1
2290 OPEN XDDA$+XNA$+EXT$ FOR OUTPUT AS #1
2295 IF ISP=1 THEN PRINT#1,DAX$ : PRINT#1,NZ,NCK
2300 K=0
2305 FOR J= 1 TO NCK
2310 IF ISP=1 THEN PRINT#1,TC$(VX(J))
2315 IF ISP=2 AND KNM=1 THEN K=K+1:PRINT#1,TAB(14*K-13);CHR$(34);TC$(VX(J));
CHR$(34);
2317 IF ISP=3 AND KNM=1 THEN PRINT#1," ";TC$(VX(J));
2320 NEXT J
2325 IF (ISP=2 OR ISP=3) AND KNM=1 THEN PRINT#1,
2330 IF NF=0 THEN 2380
2335 FOR I=IA(1) TO IB(1)
2340 IF KC=1 AND A(I,0)=1 THEN 2375
2350 FOR J=1 TO NCK
2355 IF (ISP=1 OR ISP=3) THEN PRINT#1,A(I,VX(J));
2360 IF ISP=2 THEN PRINT#1,TAB(14*J-13);A(I,VX(J));
2365 NEXT J
2370 PRINT#1,
2375 NEXT I
2380 CLOSE#1
2382 IF NA$="" THEN NA$=XNA$
2384 PRINT : INPUT "Grabacion Terminada - Enter ",A$
2386 RETURN
2389 '
2390 ' Definicion de Observaciones a Considerar
2392 PRINT : INPUT "Observacion Inicial a Considerar (Todas) = ",A$
2393 IF LEN(A$)=0 THEN IA(M)=1 :IB(M)=NFX : RETURN
2394 IA(M)=VAL(A$)
2395 IF IA(M)<1 OR IA(M)>NFX THEN KE=5 : B$=">=1 y <="+STR$(NFX) :
GOSUB 900 : GOTO 2392
2396 PRINT : PRINT "Observacion Final a Considerar (";NFX;")"; : INPUT " = ",A$
2397 IF LEN(A$)=0 THEN IB(M)=NFX : RETURN
2398 IB(M)=VAL(A$)
2399 IF IB(M)<IA(M) OR IB(M)>NFX THEN KE=5 : B$=">="+STR$(IB(M))+ " y
<="+STR$(NFX) : GOSUB 900 : GOTO 2396
2400 RETURN
2404 '
2405 ' EST121 - Definicion de Variables
2410 ' --------------------------------
2415 L=0 : NCK=0
2420 WHILE KW=0
2425 INPUT " Variable a Seleccionar = ",A$
2430 IF LEN(A$)=0 THEN RETURN
2435 K=VAL(A$) : KS=0 : IF K<0 THEN KS=1 : K=-K
2440 IF K<1 OR K>NCX THEN KE=5 : B$=">=1 y <="+STR$(NCX) :
GOSUB 900 : GOTO 2425
2445 IF KS=1 AND (K<=L OR L=0) THEN KE=5 : B$=">0": GOSUB 900: GOTO 2425
2450 IF KS=0 THEN NCK=NCK+1 : VX(NCK)=K : GOTO 2470
2455 FOR N=L+1 TO K
2460 NCK=NCK+1 : VX(NCK)=N
2465 NEXT N
2470 L=K
2475 WEND
2480 '
2500 ' EST13 - Lectura de Archivo de datos
2505 ' -----------------------------------
2510 TSP$="Lectura de Archivo de Datos
2515 GOSUB 555
2516 IF NC=0 THEN 2519
2517 PRINT : INPUT "Borrado de Memoria de Trabajo ? (N) = ",A$
2518 IF A$="S" OR A$="s" THEN GOSUB 1250
2519 PRINT
2520 PRINT "TIPO DE ARCHIVO A LEER"
2525 TF$(1)="Archivo ESTAD (.EST)"
2530 TF$(2)="Archivo LOTUS (.PRN)"
2535 TF$(3)="Archivo ASCII (.ASF)"
2540 KL=3 : GOSUB 980
2545 IF ISP=0 THEN RETURN
2547 IKP=ISP
2550 IF IKP=1 THEN XA$=".EST"
2555 IF IKP=2 THEN XA$=".PRN"
2560 IF IKP=3 THEN XA$=".ASF"
2565 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
2570 PRINT : FILES DDA$+":*"+XA$
2575 IF KAR=1 THEN PRINT " No Existen" : KAR=0
2580 PRINT: INPUT "Nombre del Archivo a Leer = ",A$
2585 IF LEN(A$)=0 THEN RETURN
2590 KE=0
2595 GOSUB 950
2600 IF KAR=1 THEN PRINT : PRINT CHR$(7) : INPUT "** ARCHIVO NO EXISTENTE",A$ : KAR=0 :
GOTO 2580
2605 IF KE=1 THEN 2580
2610 NA$=A$ : NCK=0
2615 WHILE IKP=1
2617 ARC$(1)=NA$
2620 PRINT : PRINT "ARCHIVO A LEER"
2625 M=1 : GOSUB 3240
2627 IF ISP=0 OR NCK=0 THEN CLOSE#1 : RETURN
2775 IF IB(1)-IA(1)>NFM THEN KE=6 : GOSUB 900 : CLOSE#1 : GOTO 2625
2780 WHILE ISP=1
2795 NC=NCX
2800 FOR J=1 TO NC : TC$(J)=TCX$(J) : NEXT J
2803 IX=0
2805 FOR I=1 TO NFX
2807 KX=0
2810 FOR J=1 TO NC
2815 INPUT#1,X
2816 IF I<IA(1) OR I>IB(1) THEN 2820
2817 IF KX=0 THEN IX=IX+1 : KX=1
2818 A(IX,J)=X
2820 NEXT J
2825 NEXT I
2830 ISP=0
2835 WEND
2840 WHILE ISP=2
2850 FOR J=1 TO NCM : VY(J)=0 : NEXT J
2870 PRINT : PRINT "POSICIONES DE MEMORIA A INGRESAR VARIABLES"
2875 IF NC>0 THEN GOSUB 500
2880 PRINT
2883 KX=0
2885 FOR K=1 TO NCK
2890 J=VX(K)
2895 PRINT " Posicion a ubicar Variable";J;" - ";TCX$(J);TAB(45);
2900 INPUT " = ",A$
2905 IF LEN(A$)=0 THEN 2950
2910 L=VAL(A$)
2915 IF L<1 OR L>NCM THEN KE=5 : B$=">=1 Y <="+STR$(NCM) :
GOSUB 900 : GOTO 2895
2920 IF LEN(TC$(L))=0 OR LEFT$(TC$(L),2)=" " THEN 2940
2925 PRINT : PRINT "Variable";L;" actual = ",TC$(L)
2930 INPUT " Se utiliza ? (N) = ",A$
2935 IF A$<>"S" AND A$<>"s" THEN 2895
2940 TC$(L)=TCX$(J)
2945 VY(J)=L : KX=1
2950 NEXT K
2955 IF KX=0 THEN RETURN
2957 IX=0
2960 FOR I=1 TO NFX
2963 KX=0
2965 FOR J=1 TO NCX
2970 INPUT#1,X
2975 IF I<IA(1) OR I>IB(1) THEN 2995
2980 K=VY(J)
2983 IF KX=0 THEN IX=IX+1 : KX=1
2985 IF K>0 THEN A(IX,K)=X
2990 IF K>NC THEN NC=K
2995 NEXT J
3000 NEXT I
3015 ISP=0
3020 WEND
3022 DA$=DAX$
3023 NF=IB(1)-IA(1)+1 : NX=NF
3025 IKP=0
3030 WEND
3035 WHILE IKP>=2
3040 PRINT : INPUT "Nombre de Variables en Primer Registro ? (N) = ",A$
3045 KNM=0 : NFX=0 : IF A$="S" OR A$="s" THEN KNM=1 : NFX=1
3050 OPEN XDDA$+NA$+EXT$ FOR INPUT AS #1
3055 NCX=0 : KM=0 : C$=""
3060 LINE INPUT#1,A$
3065 IL=LEN(A$) : KX=0
3070 FOR I=1 TO IL
3075 B$=MID$(A$,I,1)
3077 IF B$="," THEN B$=" "
3080 IF KNM=1 AND B$=" " AND KM=1 THEN KM=0: TC$(NCX)=LEFT$(C$,8) :
C$="" : GOTO 3105
3085 IF KNM=0 AND B$=" " AND KM=1 THEN KM=0: A(NFX,NCX)=VAL(C$) :
C$="" : GOTO 3105
3090 IF B$=" " OR B$=CHR$(34) THEN 3105
3095 IF KM=0 THEN KM=1 : IF NCX<NCM THEN NCX=NCX+1 ELSE KX=1
3100 C$=C$+B$
3105 NEXT I
3107 IF KX=1 THEN KE=6 : GOSUB 900 : RETURN
3110 IF C$>"" AND KNM=1 THEN TC$(NCX)=LEFT$(C$,8)
3115 IF C$>"" AND KNM=0 THEN A(NFX,NCX)=VAL(C$)
3120 NC=NCX : N=0
3125 WHILE NOT EOF(1)
3130 INPUT#1,X
3135 IF N<NCX THEN N=N+1 : GOTO 3145
3140 IF N=NCX THEN N=1 : NFX=NFX+1 : IF NFX>NFM THEN KE=6 : GOSUB 900 :
RETURN
3145 A(NFX,N)=X
3185 WEND
3190 NF=NFX : NX=NF
3195 IKP=0
3200 WEND
3205 CLOSE#1
3210 JF=0 : CD$="" : NV=0 : NVC(1)=0 : NVC(2)=0
3215 FOR I=1 TO NF : A(I,0)=0 : NEXT I
3220 FOR I=NC+1 TO NCM : TC$(I)=" " : NEXT I
3225 PRINT : INPUT "Lectura Terminada - Enter ",A$
3230 RETURN
3235 '
3240 ' EST131 - Definicion Datos Archivo a Leer
3245 ' ----------------------------------------
3250 OPEN XDDA$+ARC$(M)+EXT$ FOR INPUT AS #M
3255 LINE INPUT#M,DAX$
3260 INPUT#M,NFX,NCX
3270 FOR J=1 TO NCX
3275 INPUT#M,TCX$(J)
3280 NEXT J
3285 PRINT : PRINT
3287 PRINT "CARACTERISTICAS DEL ARCHIVO" : PRINT
3290 PRINT " NOMBRE = ";ARC$(M);" - ";DAX$ : PRINT
3295 PRINT " Numero de Variables = ";NCX
3300 PRINT " Numero de Observaciones = ";NFX
3305 PRINT
3310 I=1
3315 FOR L=1 TO NCX
3320 IF LEFT$(TCX$(L),2)=" " THEN 3335
3325 PRINT TAB(15*I-11);L;"-";TCX$(L);
3330 I=I+1 : IF I>5 THEN I=1 : PRINT
3335 NEXT L
3339 PRINT : PRINT
3340 PRINT : PRINT "VARIABLES A CONSIDERAR"
3345 TF$(1)="Todas las Variables"
3350 TF$(2)="Variables Seleccionadas"
3355 KL=2 : GOSUB 980
3359 IF ISP=0 THEN CLOSE#M : RETURN
3360 IPC=ISP
3361 WHILE IPC=1
3362 IF NCX>NCM THEN KE=6 : GOSUB 900 : GOTO 3340
3365 NCK=NCX
3369 FOR K=1 TO NCK : VX(K)=K : NEXT K
3370 IF M=1 THEN FOR K=1 TO NCK : VY(K)=VX(K) : NEXT K
3371 IPC=0
3372 WEND
3375 WHILE IPC=2
3385 PRINT : GOSUB 2405
3390 IF NCK=0 THEN RETURN
3395 IF M=1 THEN FOR K=1 TO NCK : VY(K)=VX(K) : NEXT K
3400 IPC=0
3405 WEND
3420 GOSUB 2390
3460 RETURN
3465 '
3470 ' EST14 - Union de Archivos
3475 ' -------------------------
3485 TSP$="Union de Archivos"
3490 GOSUB 555
3493 PRINT " (Solo con Archivos tipo ESTAD)" : PRINT
3495 PRINT "PROCESOS"
3500 TF$(1)="Union por Variables"
3505 TF$(2)="Union por Observaciones"
3510 TF$(3)="Creacion de Subarchivo"
3515 KL=3 : GOSUB 980
3520 IF ISP=0 THEN RETURN
3525 IKP=ISP
3550 PRINT : PRINT "Archivos en Disco ";DDA$
3555 PRINT : FILES DDA$+":*.EST"
3560 IF KAR=1 THEN PRINT " No Existen" : KAR=0
3565 FOR M=1 TO 3
3570 IF M=2 AND IKP=3 THEN ARC$(2)="" : GOTO 3625
3575 IF M<3 THEN PRINT "Nombre del Archivo Fuente Nro.";M;TAB(37);
ELSE PRINT : PRINT "Nombre del Archivo Destino";TAB(37);
3580 INPUT "(.EST) = ",A$
3585 IF LEN(A$)=0 THEN RETURN
3590 KE=0 : XA$=".EST"
3595 GOSUB 950
3597 C$=A$
3600 IF M<3 AND KAR=1 THEN PRINT : PRINT CHR$(7) : INPUT
"** ARCHIVO NO EXISTENTE",A$ : KAR=0 : GOTO 3575
3605 IF M=3 AND KAR=0 THEN PRINT : INPUT
"Archivo Existente - Se Reemplaza ? (N) = ",A$
3610 IF M=3 AND KAR=0 AND (A$<>"S" AND A$<>"s") THEN 3575
3615 IF KE=1 THEN 3575
3620 ARC$(M)=C$
3625 NEXT M
3630 FOR M=1 TO 2
3635 IF ARC$(M)="" THEN 3650
3640 PRINT : PRINT "ARCHIVO FUENTE NRO.";M : PRINT
3645 GOSUB 3240 : CLOSE #M
3647 NIJ(M)=IB(M)-IA(M)+1
3648 NVS(M)=NCK : NFT(M)=NFX : NCT(M)=NCX
3650 NEXT M
3655 IF IKP=1 AND (NVS(1)<>NVS(2)) THEN PRINT CHR$(7) : PRINT : INPUT "**
CANTIDAD DE VARIABLES DIFERENTE EN LOS DOS ARCHIVOS",A$ : GOTO 3550
3660 IF IKP=2 AND (NIJ(1)<>NIJ(2)) THEN PRINT CHR$(7) : PRINT : INPUT "**
CANTIDAD DE OBSERVACIONES DIFERENTE EN LOS DOS ARCHIVOS",A$ : GOTO 3550
3665 CLOSE
3670 PRINT : INPUT "Descripcion de Archivo Destino = ",DAX$
3675 FOR M=1 TO 2
3680 IF IKP=3 AND M=2 THEN 3695
3685 OPEN XDDA$+ARC$(M)+EXT$ FOR INPUT AS #M
3690 INPUT#M,A$,X,Y
3695 NEXT M
3700 NFX=NFT(1) : IF NFX<NFT(2) THEN NFX=NFT(2)
3715 OPEN XDDA$+ARC$(3)+EXT$ FOR OUTPUT AS #3
3720 PRINT#3,DAX$
3725 WHILE IKP=1 OR IKP=3
3730 PRINT#3,NIJ(1)+NIJ(2),NVS(1)
3733 FOR K=1 TO NCT(1) : INPUT#1,TCX$(K) : NEXT K
3734 FOR K=1 TO NCT(2) : INPUT#2,A$ : NEXT K
3735 FOR K=1 TO NVS(1)
3745 PRINT#3,TCX$(VY(K))
3750 NEXT K
3755 FOR I=1 TO NFT(1)
3760 FOR K=1 TO NCT(1)
3765 INPUT#1,V(K)
3767 NEXT K
3770 IF I<IA(1) OR I>IB(1) THEN 3790
3775 FOR K=1 TO NVS(1)
3780 PRINT#3,V(VY(K));
3783 NEXT K
3785 PRINT#3,
3790 NEXT I
3795 IF IKP=3 THEN 3840
3800 FOR I=1 TO NFT(2)
3805 FOR K=1 TO NCT(2)
3810 INPUT#2,V(K)
3812 NEXT K
3815 IF I<IA(2) OR I>IB(2) THEN 3835
3820 FOR K=1 TO NVS(2)
3823 PRINT#3,V(VX(K));
3825 NEXT K
3830 PRINT#3,
3835 NEXT I
3840 IKP=0
3845 WEND
3850 WHILE IKP=2
3855 PRINT#3,NIJ(1),NVS(1)+NVS(2)
3857 FOR K=1 TO NCT(1) : INPUT#1,TCX$(K) : NEXT K
3860 FOR K=1 TO NVS(1)
3870 PRINT#3,TCX$(VY(K))
3875 NEXT K
3877 FOR K=1 TO NCT(2) : INPUT#2,TCX$(K) : NEXT K
3880 FOR K=1 TO NVS(2)
3890 PRINT#3,TCX$(VX(K))
3895 NEXT K
3900 FOR I=1 TO NFX
3905 IF I>NFT(1) THEN 3935
3910 FOR K=1 TO NCT(1)
3915 INPUT#1,V(K)
3917 NEXT K
3920 IF I<IA(1) OR I>IB(1) THEN 3935
3925 FOR K=1 TO NVS(1)
3927 PRINT#3,V(VY(K));
3930 NEXT K
3935 IF I>NFT(2) THEN 3965
3940 FOR K=1 TO NCT(2)
3945 INPUT#2,V(K)
3947 NEXT K
3950 IF I<IA(2) OR I>IB(2) THEN 3970
3953 FOR K=1 TO NVS(2)
3955 PRINT#3,V(VX(K));
3960 NEXT K
3965 PRINT#3,
3970 NEXT I
3975 IKP=0
3980 WEND
3985 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
3990 PRINT : INPUT "Union terminada - Enter ",A$
3995 RETURN
4000 '
4005 ' EST15 - Salida de Datos
4010 ' -----------------------
4015 TSP$="Salida de Datos"
4017 GOSUB 555
4018 XA$=".EST"
4019 PRINT "DATOS EN"
4020 TF$(1)="Memoria de Trabajo"
4021 TF$(2)="Archivo de Datos (.EST)"
4022 KL=2 : GOSUB 980
4023 IF ISP=0 THEN RETURN
4024 IF ISP=1 AND NF=0 THEN KE=1 : GOSUB 900 : RETURN
4025 LA=ISP : XX=LA
4026 WHILE LA=1
4030 NCX=NC : NFX=NF
4035 FOR K=1 TO NC : TCX$(K)=TC$(K) : NEXT K
4040 GOSUB 500 : PRINT : GOSUB 2405
4045 IF NCK=0 THEN RETURN
4050 KC=0 : IF CD$="" THEN 4070
4055 PRINT : INPUT "Se considera Condicion de Seleccion ? (N) = ",A$
4060 IF A$="S" OR A$="s" THEN KC=1
4070 NFX=NF : M=1
4080 GOSUB 2390
4102 LA=0
4103 WEND
4105 WHILE LA=2
4106 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
4107 PRINT : FILES DDA$+":*"+XA$
4108 IF KAR=1 THEN PRINT " No Existen" : KAR=0
4109 PRINT: INPUT "Nombre del Archivo = ",A$
4110 IF LEN(A$)=0 THEN RETURN
4111 KE=0
4112 GOSUB 950
4113 IF KAR=1 THEN PRINT : PRINT CHR$(7) : INPUT "** ARCHIVO NO EXISTENTE" ,A$
: KAR=0 : GOTO 4109
4114 IF KE=1 THEN 4109
4115 M=1 : ARC$(1)=A$
4116 GOSUB 3240 : CLOSE#1
4117 IF ISP=0 OR NCK=0 THEN RETURN
4118 KC=0 : LA=0
4119 WEND
4120 LA=XX
4122 PRINT : PRINT "Salida actual por Pantalla"
4123 GOSUB 650
4125 KS=1
4126 WHILE KS=1
4127 GOSUB 555
4128 KX=0 : KN=0
4129 IF LA=2 THEN PRINT#3,"Archivo de Datos = ";ARC$(1) : PRINT#3,
4130 FOR M=1 TO NCK STEP 6
4132 IF LA=1 THEN 4140
4133 OPEN XDDA$+ARC$(1)+EXT$ FOR INPUT AS #1
4134 LINE INPUT#1,A$ : INPUT#1,X,Y
4135 FOR K=1 TO NCX : INPUT#1,A$ : NEXT K
4140 KM=KN+1 : KN=KM+5
4145 IF KN>NCK THEN KN=NCK
4150 FOR I=1 TO NFX
4152 IF LA=2 THEN FOR K=1 TO NCX : INPUT#1,VY(K) : NEXT K
4153 IF I<IA(1) OR I>IB(1) THEN 4267
4155 WHILE KX=0
4157 N=0
4158 PRINT#3,
4160 FOR K=KM TO KN
4165 J=VX(K) : N=N+1
4170 PRINT#3,TAB(12*N-4);J;
4175 NEXT K
4180 PRINT#3, : PRINT#3,"Obs.";
4183 N=0
4185 FOR K=KM TO KN
4190 J=VX(K) : N=N+1
4195 PRINT#3,TAB(12*N-4);TCX$(J);
4200 NEXT K
4205 PRINT#3,
4210 KA=1 : KB=12*N+7 : GOSUB 695
4215 IL=8 : KX=1
4220 WEND
4225 IF NFX=0 THEN RETURN
4230 IF KC=1 AND A(I,0)=1 THEN 4270
4235 PRINT#3,I;
4237 N=0
4240 FOR K=KM TO KN
4245 J=VX(K) : N=N+1
4247 IF LA=1 THEN X=A(I,J)
4248 IF LA=2 THEN X=VY(J)
4250 PRINT#3,TAB(12*N-4);X;
4255 NEXT K
4260 PRINT#3,
4265 IL=IL+1
4267 IF (IL=22 OR I=NFX) AND DS$="SCRN:" THEN PRINT : INPUT
"Enter (F: fin) ",A$ : KX=0 : IF A$="F" OR A$="f" THEN I=NFX : M=NCK
4270 NEXT I
4273 KX=0
4274 CLOSE#1
4275 NEXT M
4280 GOSUB 650
4285 WEND
4290 RETURN
4295 '
4300 ' EST16 - Seleccion de Datos para procesos
4305 ' ----------------------------------------
4310 TSP$="Seleccion de Datos"
4315 GOSUB 555
4317 PRINT : PRINT "DEFINICION DE CONDICION DE SELECCION" : PRINT
4320 GOSUB 500
4325 IF LEN(CD$)=0 THEN 4360
4327 FOR I=1 TO NFM : A(I,0)=0 : NEXT I
4330 PRINT : PRINT "Condicion de Seleccion existente = ";CD$
4335 PRINT : INPUT " Se Elimina ? (N) = ",A$
4340 IF A$="S" OR A$="s" THEN CD$="" : RETURN
4345 INPUT " Se Modifica ? (N) = ",A$
4350 IF A$<>"S" AND A$<>"s" THEN 4412
4360 'PRINT : PRINT "Condicion a Ingresar = ",CD$
4365 'LOCATE CSRLIN-1,1
4370 PRINT : INPUT "Condicion a Ingresar = ",A$
4375 IF LEN(A$)=0 THEN CD$="" : RETURN
4380 CD$=A$
4385 OPEN DDA$+":xyz.bas" FOR OUTPUT AS #1
4390 PRINT#1,"4460 if not("+CD$+") THEN a(i,0)=1"
4395 CLOSE#1
4400 CHAIN MERGE DDA$+":xyz",4405,ALL
4405 KILL DDA$+":xyz.bas"
4410 ON ERROR GOTO 936
4412 FOR J=1 TO NC : V(J)=A(1,J) : NEXT J : I=1
4413 GOSUB 4460
4414 A(1,0)=0 : KMM=0
4415 L=LEN(CD$)
4416 FOR M=1 TO L-1
4417 A$=MID$(CD$,M,2)
4418 WHILE A$="V(" OR A$="v("
4419 M=M+1 : B$=""
4420 M=M+1
4421 C$=MID$(CD$,M,1)
4422 IF C$<>")" THEN B$=B$+C$ : GOTO 4420
4423 K=VAL(B$) : KMM=0
4424 IF K<1 OR K>NC OR TC$(K)=" " THEN KE=4 :
GOSUB 900 : KMM=1
4426 A$=""
4427 WEND
4428 NEXT M
4429 IF KE=1 OR KMM=1 THEN KE=0 : GOTO 4370
4430 FOR I=1 TO NF
4435 FOR J=1 TO NC : V(J)=A(I,J) : NEXT J
4440 GOSUB 4460
4445 NEXT I
4450 PRINT : INPUT "Seleccion Terminada - Enter ",A$ : GOSUB 1035
4455 ' Funcion de Seleccion
4460 IF NOT(V(5)>=35 AND V(5)<40) THEN A(I,0)=1
4465 RETURN
4470 '
4475 ' EST17 - Transformacion de Datos
4480 ' -------------------------------
4485 WHILE KW=0
4490 TSP$="Transformacion de Datos"
4493 NXX=0
4495 GOSUB 555
4500 PRINT "TRANSFORMACIONES"
4505 TF$(1)="Mediante una Funcion"
4510 TF$(2)="Normalizacion"
4515 TF$(3)="Recodificacion"
4520 TF$(4)="Corrimiento/Diferencias"
4525 TF$(5)="Calculo de Rangos"
4530 TF$(6)="Calculo de Variables Indicatrices"
4535 TF$(7)="Ordenamiento"
4540 KL=7 : GOSUB 980
4545 IF ISP=0 THEN RETURN
4550 TSP$=TSP$+" - "+TF$(ISP)
4555 GOSUB 555
4560 GOSUB 500
4565 IF ISP=1 THEN 4590
4570 PRINT : INPUT "VARIABLE A TRANSFORMAR = ",A$
4575 IF LEN(A$)=0 THEN RETURN
4580 JZ=VAL(A$)
4585 IF JZ<1 OR JZ>NC OR TC$(JZ)=" " THEN KE=4 :
GOSUB 900 : GOTO 4570
4590 IF ISP=6 THEN 4630
4595 PRINT : PRINT "VARIABLE CON VALORES TRANSFORMADOS"
4600 KVA=1 : GOSUB 390
4605 IF J=0 THEN RETURN
4615 KC=0 : IF CD$="" THEN 4630
4620 PRINT : INPUT "Se considera Condicion de Seleccion ? (N) = ",A$
4625 IF A$="S" OR A$="s" THEN KC=1
4630 ON ISP GOSUB 4650,4810,4880,5010,5046,5082,5142
4635 PRINT : INPUT "Transformacion Terminada - Enter ",A$
4640 WEND
4645 '
4650 ' EST171 - Transformacion mediante una Funcion
4655 ' --------------------------------------------
4660 PRINT : PRINT "DEFINICION DE FUNCION DE TRANSFORMACION" : PRINT
4665 GOSUB 500
4670 IF LEN(FU$)=0 THEN 4700
4675 PRINT "Funcion de Transformacion existente = ",FU$
4680 INPUT "Se Modifica ? (N) = ",A$
4685 IF A$<>"S" AND A$<>"s" THEN 4742
4690 'PRINT : PRINT "Funcion a Ingresar = ";FU$
4695 'LOCATE CSRLIN-1,1
4700 PRINT : INPUT "Funcion a Ingresar = ",A$
4705 IF LEN(A$)=0 THEN FU$="" : RETURN
4710 FU$=A$
4715 OPEN DDA$+":xyz.bas" FOR OUTPUT AS #1
4720 PRINT#1,"4795 A(i,j)="+FU$
4725 CLOSE#1
4730 CHAIN MERGE DDA$+":xyz",4735,ALL
4735 KILL DDA$+":xyz.bas"
4740 ON ERROR GOTO 936
4742 FOR K=1 TO NC : V(K)=A(1,K) : VX(K)=0 : NEXT K
4743 XX=A(1,J)
4744 GOSUB 4795
4746 A(1,J)=XX
4748 L=LEN(FU$)
4749 FOR M=1 TO L-1
4750 A$=MID$(FU$,M,2)
4751 WHILE A$="V(" OR A$="v("
4752 M=M+1 : B$=""
4753 M=M+1
4754 C$=MID$(FU$,M,1)
4755 IF C$<>")" THEN B$=B$+C$ : GOTO 4753
4756 K=VAL(B$) : KMM=0
4757 IF K<1 OR K>NC OR TC$(K)=" " THEN KE=4 :
GOSUB 900 : KMM=1
4758 VX(K)=1
4759 A$=""
4760 WEND
4761 NEXT M
4762 IF KE=1 OR KMM=1 THEN KE=0 : GOTO 4700
4763 FOR I=1 TO NF
4764 KMM=0
4765 IF KC=1 AND A(I,0)=1 THEN 4780
4770 FOR K=1 TO NC
4771 V(K)=A(I,K)
4772 IF VX(K)=1 AND V(K)=XVF THEN KMM=1
4773 NEXT K
4775 IF KMM=0 THEN GOSUB 4795 ELSE A(I,J)=XVF
4780 NEXT I
4785 PRINT : INPUT "Transformacion Terminada - Enter ",A$ : GOSUB 1035
4790 ' Funcion de Transformacion
4795 A(I,J)=V(2)+V(3)
4800 RETURN
4805 '
4810 ' EST172 - Normalizacion
4815 ' ----------------------
4820 XX=J : J=JZ
4825 GOSUB 5480
4830 J=XX
4835 IF NXX<2 THEN KE=3 : GOSUB 900 : RETURN
4840 FOR I=1 TO NF
4845 X=A(I,JZ)
4850 IF (KC=1 AND A(I,0)=1) THEN 4865
4855 IF X=XVF THEN A(I,J)=XVF : GOTO 4865
4860 A(I,J)=(X-PX)/DEX
4865 NEXT I
4870 RETURN
4875 '
4880 ' EST173 - Recodificacion de Datos
4885 ' --------------------------------
4890 XX=J : J=JZ
4895 PRINT : PRINT "Ingreso de Intervalos Valores Actuales" : PRINT
4900 K=1 : GOSUB 6010
4905 IF NVC(1)=0 THEN RETURN
4910 J=XX
4915 PRINT
4920 FOR M=0 TO NVC(1)
4925 PRINT "Nuevo valor para x ";
4930 IF M=0 THEN PRINT "< ";VC(M+1,1); : GOTO 4940
4935 IF M=NVC(1) THEN PRINT ">= ";VC(M,1); : GOTO 4940
4937 PRINT ">= ";VC(M,1);" y < ";VC(M+1,1);
4940 INPUT " = ",A$
4945 VC(M,2)=VAL(A$)
4950 NEXT M
4955 FOR I=1 TO NF
4960 X=A(I,JZ)
4965 IF (KC=1 AND A(I,0)=1) THEN 4995
4970 IF X=XVF THEN A(I,J)=XVF : GOTO 4995
4975 A(I,J)=VC(NVC(1),2)
4980 FOR M=1 TO NVC(1)
4985 IF X<VC(M,1) THEN A(I,J)=VC(M-1,2) : M=NVC(1)
4990 NEXT M
4995 NEXT I
5000 RETURN
5005 '
5010 ' EST174 - Corrimiento/Diferencias
5012 ' --------------------------------
5014 PRINT : PRINT "PROCESO"
5015 TF$(1)="Corrimiento"
5016 TF$(2)="Diferencia"
5017 KL=2 : GOSUB 980
5018 IF ISP=0 THEN RETURN
5020 PRINT : INPUT " Numero de Observaciones para Corrim/Difer. = ",A$
5022 IF LEN(A$)=0 THEN RETURN
5024 K=VAL(A$)
5026 IF K<1 OR K>NF-1 THEN KE=5 : B$=">=1 y <="+STR$(NF-1) :
GOSUB 900 : GOTO 5020
5028 FOR I=1 TO NF
5030 IF I<=K THEN A(I,J)=XVF : GOTO 5040
5031 X=A(I-K,JZ)
5032 IF (KC=1 AND A(I-K,0)=1) THEN 5040
5033 IF X=XVF THEN A(I,J)=XVF : GOTO 5040
5034 IF ISP=1 THEN A(I,J)=X
5035 IF ISP=2 THEN Y=A(I,JZ) : IF (KC=1 AND A(I,0)=1) THEN 5040
5036 IF ISP=2 THEN IF Y=XVF THEN A(I,J)=XVF : GOTO 5040
5038 IF ISP=2 THEN A(I,J)=Y-X
5040 NEXT I
5042 RETURN
5044 '
5046 ' EST175 - Calculo de Rangos
5048 ' --------------------------
5050 N=0
5052 FOR I=1 TO NF
5053 X=A(I,JZ)
5054 IF (KC=1 AND A(I,0)=1) THEN 5060
5055 IF X=XVF THEN A(I,J)=XVF : GOTO 5060
5056 N=N+1
5058 VX(N)=X : VY(N)=I
5060 NEXT I
5062 IF N<2 THEN KE=3 : GOSUB 900 : RETURN
5064 XX=J
5066 GOSUB 5188
5068 J=XX
5070 FOR I=1 TO N
5072 IK=VY(I)
5074 A(IK,J)=VX(I+N)
5076 NEXT I
5078 RETURN
5080 '
5082 ' EST176 - Calculo de Variables Indicatrices
5084 ' ------------------------------------------
5086 PRINT : PRINT "Ingreso de Intervalos Valores Actuales" : PRINT
5088 J=JZ
5090 K=1 : GOSUB 6010
5092 IF NVC(1)=0 THEN RETURN
5094 PRINT
5096 NVI=NVC(1)-1
5097 PRINT : PRINT "ALMACENAM. DE VARIABLES INDICAT. EN MEMORIA DE TRABAJO"
5098 FOR K=1 TO NVI
5100 PRINT : PRINT "Variable Indicatriz Nro.";K
5102 IF K>1 THEN KVA=1
5104 GOSUB 390
5108 VX(K)=J
5110 NEXT K
5112 FOR I=1 TO NF
5114 X=A(I,JZ)
5116 KMM=0 : IF (KC=1 AND A(I,0)=1) OR X=XVF THEN KMM=1
5120 KX=0
5122 FOR K=1 TO NVI
5124 J=VX(K)
5126 IF J=0 THEN KX=1 : GOTO 5132
5128 IF KMM=1 THEN A(I,J)=XVF : KX=1 : GOTO 5132
5130 IF X>=VC(K,1) AND X<VC(K+1,1) THEN A(I,J)=1 : KX=1 ELSE A(I,J)=0
5132 NEXT K
5134 IF KX=0 THEN PRINT: PRINT "Observacion Nro.";I;" no se encontro valor"
5136 NEXT I
5138 RETURN
5140 '
5142 ' EST177 - Ordenamiento
5144 ' ---------------------
5146 PRINT : PRINT "TIPO DE ORDENAMIENTO"
5148 TF$(1)="De Menor a Mayor"
5150 TF$(2)="De Mayor a Menor"
5152 KL=2 : GOSUB 980
5154 IF ISP=0 THEN RETURN
5156 N=0
5158 FOR I=1 TO NF
5160 X=A(I,JZ)
5162 IF (KC=1 AND A(I,0)=1) OR X=XVF THEN 5170
5166 IF ISP=2 THEN X=-X
5168 N=N+1 : VX(N)=X : VY(N)=I
5170 NEXT I
5171 IF N<2 THEN KE=3 : GOSUB 900 : RETURN
5172 GOSUB 5226
5174 FOR I=1 TO N
5176 X=VX(I)
5178 IF ISP=2 THEN X=-X
5180 A(I,J)=X
5182 NEXT I
5183 IF N<NF THEN FOR I=N+1 TO NF : A(I,J)=XVF : NEXT I
5184 RETURN
5186 '
5188 ' EST178 - Determinacion de Rangos de un vector de valores
5190 ' --------------------------------------------------------
5192 FOR I=1 TO N : VX(I+N)=0 : NEXT I
5194 FOR I=1 TO N
5196 IF VX(I+N)>0 THEN 5220
5198 NM=0 : NI=0
5200 X=VX(I)
5202 FOR J=1 TO N
5204 IF VX(J)<X THEN NM=NM+1
5206 IF VX(J)=X THEN NI=NI+1 : VX(J+N)=-1
5208 NEXT J
5210 IF NI<=1 THEN VX(I+N)=NM+1 : GOTO 5220
5212 P=NM+(NI+1)*.5
5214 FOR J=1 TO N
5216 IF VX(J+N)=-1 THEN VX(J+N)=P
5218 NEXT J
5220 NEXT I
5222 RETURN
5224 '
5226 ' EST179 - Ordenamiento de un vector de valores
5228 ' ---------------------------------------------
5230 LOG2=INT(LOG(N)*(1!/.69314728#)+.00001)
5232 MM=N
5234 FOR NN=1 TO LOG2
5236 MM=INT(MM/2)
5238 K=N-MM
5240 FOR JJ=1 TO K
5242 I=JJ
5244 L=I+MM
5246 IF VX(L)>=VX(I) THEN 5256
5248 X=VX(I) : VX(I)=VX(L) : VX(L)=X
5250 X=VY(I) : VY(I)=VY(L) : VY(L)=X
5252 I=I-MM
5254 IF I>=1 THEN 5244
5256 NEXT JJ
5258 NEXT NN
5260 RETURN
5262 '
5264 '
5480 ' EST211 - Calculo de Valor medio, Desv.Std.,Max.,Min.
5485 ' ----------------------------------------------------
5490 SX=0 : SCX=0 : NXX=0
5495 XMI=1E+10 : XMA=-1E+10
5500 FOR I=1 TO NF
5505 IF A(I,0)=1 THEN 5550
5510 X= A(I,J)
5515 IF X=XVF THEN 5550
5520 IF X<XMI THEN XMI=X
5525 IF X>XMA THEN XMA=X
5530 ND=1 : IF JF>0 THEN ND=A(I,JF)
5535 IF ND=XVF THEN 5550
5540 SX=SX+ND*X : SCX=SCX+ND*X^2
5545 NXX=NXX+ND
5550 NEXT I
5555 IF NXX<2 THEN RETURN
5560 PX=SX/NXX
5565 DEM=SQR((SCX-NXX*PX^2)/NXX)
5570 DEX=SQR((SCX-NXX*PX^2)/(NXX-1))
5575 RETURN
5580 '
6010 ' EST221 - Ingreso de Valores de Clasificacion
6015 ' --------------------------------------------
6020 IF NVC(K)=0 THEN 6050
6025 PRINT : PRINT "Valores Actuales de Clasificacion" : PRINT
6030 FOR M=1 TO NVC(K) : PRINT VC(M,K);" - "; : NEXT M : PRINT
6035 PRINT : INPUT "Ingreso de Nuevos Valores de Clasificacion (S/N) = ";A$
6040 IF A$<>"S" AND A$<>"s" THEN VC(0,K)=VC(1,K) : RETURN
6045 NVC(K)=0
6050 GOSUB 5480
6055 PRINT "(Valores Maximo y Minimo de los Datos = ";XMI;"-";XMA;")"
6060 PRINT
6065 INPUT " Valor de la Variable = ",A$
6070 IF LEN(A$)=0 THEN RETURN
6075 XB=VAL(A$)
6080 IF NVC(K)>0 AND XB<=X THEN GOSUB 900 : GOTO 6065
6085 IF NVC(K)=0 THEN 6125
6090 INPUT " Incremento para obtener Valores intermedios = ",A$
6095 DI=VAL(A$)
6100 IF DI<0 OR DI>XB-X THEN GOSUB 900 : GOTO 6090
6105 WHILE DI>0 AND X+DI<XB
6110 X=X+DI
6115 NVC(K)=NVC(K)+1 : VC(NVC(K),K)=X
6120 WEND
6125 NVC(K)=NVC(K)+1 : VC(NVC(K),K)=XB : X=XB : GOTO 6065
7500 ' EST9 - Cambio de Parametros
7505 ' ---------------------------
7510 TSP$="Cambio de Parametros"
7515 WHILE KW=0
7520 KMM=0
7525 GOSUB 555
7530 PRINT : PRINT "VALORES ACTUALES DE PARAMETROS" : PRINT
7535 TF$(1)=" 1 - Disposit. Archivo de datos (A,B o C) = " :PRINT TF$(1);DDA$
7540 TF$(2)=" 2 - Numero de Variables (1 a 100) =" : PRINT TF$(2);NCM
7545 TF$(3)=" 3 - Numero de Observaciones (10 a 1000) =" : PRINT TF$(3);NFM
7550 TF$(4)=" 4 - Parametro Proceso 1 (5 a 100) =" :PRINT TF$(4);PAR1
7555 TF$(5)=" 5 - Parametro Proceso 2 (2 a 50) =" :PRINT TF$(5);PAR2
7560 TF$(6)=" 6 - Valor faltante =" : PRINT TF$(6);XVF
7565 TF$(7)=" 7 - Numero de decimales (mayor que 0) =" : PRINT TF$(7);NDE
7570 PRINT : INPUT "Numero de Parametro a modificar = ",A$
7575 IF LEN(A$)=0 AND KME=1 THEN 7650
7580 IF LEN(A$)=0 THEN RETURN
7585 ISP=VAL(A$)
7590 IF ISP<1 OR ISP>7 THEN GOSUB 900 : GOTO 7525
7595 IF KMM=1 OR NC=0 OR (ISP<>2 AND ISP<>3) THEN 7615
7600 PRINT : PRINT "Un cambio en este parametro implica el borrado"
7605 INPUT "de la memoria de trabajo - Se continua ? (N) = ",A$
7610 IF A$<>"S" AND A$<>"s" THEN 7675
7615 PRINT
7620 PRINT TAB(3);TF$(ISP); : INPUT " ",A$
7625 IF LEN(A$)=0 THEN 7675
7630 X=VAL(A$)
7635 ON ISP GOSUB 7685,7710,7730,7750,7770,7790,7805
7640 KME=0
7645 XMEM=4*(NFM*NCM+(PAR1+1)*(PAR2+1))
7650 IF XMEM>40000! THEN PRINT : PRINT "Los valores de los parametros" : PRINT
"exceden la memoria disponible" : INPUT "",A$ : KME=1 : GOTO 7675
7655 IF KMM=0 THEN 7675
7660 ERASE A,TC$,JX
7665 DIM A(NFM,NCM),TC$(NCM),JX(NCM)
7670 DA$="" : NA$="" : NC=0 : NF=0 : NV=0 : NX=0
7675 WEND
7680 '
7685 IF LEN(A$)>1 THEN GOSUB 900 : RETURN
7690 IF INSTR("ABCabc",A$)=0 THEN GOSUB 900 : RETURN
7695 DDA$=A$
7700 RETURN
7705 '
7710 IF X<1 OR X>100 THEN GOSUB 900 : RETURN
7715 NCM=X : KMM=1
7720 RETURN
7725 '
7730 IF X<10 OR X>1000 THEN GOSUB 900 : RETURN
7735 NFM=X : KMM=1
7740 RETURN
7745 '
7750 IF X<5 OR X>100 THEN GOSUB 900 : RETURN
7755 PAR1=INT(X)
7760 RETURN
7765 '
7770 IF X<2 OR X>PAR1 OR X>50 THEN GOSUB 900 : RETURN
7775 PAR2=INT(X)
7780 RETURN
7785 '
7790 XVF=X
7795 RETURN
7800 '
7805 IF X<1 OR X>6 THEN GOSUB 900 : RETURN
7810 NDE=X
7815 RETURN
| 