ALTAS.BAS

10 'SAVE"ALTAS
20 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
30 ' ALTAS                                                           '
40 ' Programa para dar de alta y modificar datos de los trabajadores '
50 ' del sistema NOMINA de GMD Microsistemas                         '
60 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
70 'CHECA si fu‚ llamado desde el men£ principal
80 IF EMPRESA$ = "" THEN RUN "nomina"
90 'Inicializa los datos
100     DEFINT A-Z
110    OPTION BASE 1: DIM C(6, 9)
120    FOR I = 1 TO 6
130      FOR J = 1 TO 9
140        READ C(I, J)
150    NEXT J, I
160    OPEN "I", 1, "nomina.ini"
170      INPUT #1, EMPRESA$, CE
180    CLOSE
190   FALSE = FALSE: TRUE = NOT FALSE
200   GOSUB 1040
210   OPEN "R", 1, "TRABAJAD.DAT", 48
220   FIELD #1, 30 AS NOMBRE$, 10 AS PUESTO$, 4 AS SUELDO$, 4 AS COMP$
230   TR = LOF(1) / 48
240   IF TR = 0 THEN LSET NOMBRE$ = SPACE$(30): LSET PUESTO$ = SPACE$(30): LSET SUELDO$ = MKS$(0): LSET COMP$ = MKS$(0): LSET BAJA$ = MKI$(FALSE): PUT #1, 1: GOTO 230
250   CAMPO = 1
260   MASKN$ = "\                            \"
270   MASKP$ = "\         \"
280   MASKD$ = "$$###,###.##"
290   MASKO$ = "###"
300   ESC$=CHR$(27): ENT$ = CHR$(13): F10$ = CHR$(0) + "D": F9$ = CHR$(0) + "C"
310   F8$=CHR$(0)+"B": F7$=CHR$(0)+"A": F6$= CHR$(0) + "@": F2$ = CHR$(0) + "<"
320   FA$=CHR$(0)+"H": FB$=CHR$(0)+"P": FI$= CHR$(0) + "K": FD$ = CHR$(0) + "M"
330   PA$=CHR$(0)+"I": PB$=CHR$(0)+"Q": HO$= CHR$(0) + "G": EN$ = CHR$(0) + "O"
340   REG1 = 1: LIN = 4
350   INICIO = 1: IF TR <= 20 THEN FIN = TR ELSE FIN = 20
360   GOSUB 680
370 :
380 'Programa Principal
390  FINAL = FALSE
400  GET #1, REG1: CAMPO = 1: QUITA = FALSE: GOSUB 1330: GOSUB 1160: GOSUB 1480: GOSUB 3960
410  'DO
420    M$ = " Seleccionar ": GOSUB 1220
430    GOSUB 900 'Pulsar una tecla
440    IF T$ = FA$ THEN 1570'Arriba
450    IF T$ = FB$ THEN 1640'Abajo
460    IF T$ = FD$ THEN 1740'Derecha
470    IF T$ = FI$ THEN 1810'izquierda
480    IF T$ = PA$ THEN 1880'PgUp
490    IF T$ = PB$ THEN 1960'PgDn
500    IF T$ = HO$ THEN 2040'Home
510    IF T$ = EN$ THEN 2090'End
520    IF T$ = F10$ THEN 3470'Anexaÿ
530 '
540    IF T$ = F9$ THEN 3650'Baja
550    IF T$ = F8$ THEN 3120 'Busca Nombre
560    IF T$ = F7$ THEN 3200 'Imprime
570    IF T$ = F2$ THEN IF CAMPO = 3 OR CAMPO = 4 THEN 2920 ELSE 2140 'tex o n£m
580    IF (T$=>"0" AND T$<="9") AND (CAMPO = 3 OR CAMPO = 4) THEN 2920 'N£mero
590    IF T$ >= "A" AND T$ <= "Z" THEN 2140 'Edita Letras
600    IF T$ >= "a" AND T$ <= "z" THEN 2140 'Edita Letras
610    IF T$ = "¥" OR T$ = "¤" THEN T$="¥": GOTO 2140 'Edita Letras
620    IF T$ = ESC$ THEN FINAL = TRUE ELSE BEEP
630  IF NOT FINAL THEN 410
640  CLOSE : RESET
650  RUN "nomina"
660 END
670 :
680  'SUB PresentaLineas
690   M$ = " Aguarde ": GOSUB 1220
700   L = 4
710   COLOR C(CE, 1), C(CE, 2)
720   FOR I = INICIO TO FIN
730     GET #1, I
740     LOCATE L, 1
750     COLOR C(CE, 3), C(CE, 4)
760     PRINT USING MASKO$; I;
770     LOCATE L, 4
780     COLOR C(CE, 1), C(CE, 2)
790     PRINT USING MASKN$; NOMBRE$;
800     LOCATE L, 38
810     PRINT USING MASKP$; PUESTO$;
820     LOCATE L, 52
830     PRINT USING MASKD$; CVS(SUELDO$);
840     LOCATE L, 68
850     PRINT USING MASKD$; CVS(COMP$);
860     L = L + 1
870   NEXT
880 RETURN
890 :
900 'SUB PulseUnaTecla
910  T$ = INKEY$: IF T$ = "" GOTO 910
920 RETURN
930 :
940 'SUB TextoAyuda
950  LOCATE 25, 1
960  IF LEN(M$) >= 80 - (LEN(EMPRESA$) + 3) THEN MASK$ = SPACE$(80) ELSE MASK$ = SPACE$(80 - (LEN(EMPRESA$) + 3)) + "³ " + EMPRESA$ + " "
970  COLOR C(CE, 3), C(CE, 4)
980  PRINT MASK$;
990  LOCATE 25, 2
1000  COLOR C(CE, 9)
1010  PRINT M$;
1020 RETURN
1030 :
1040 'SUB Pantalla de presentaci¢n
1050   VIEW PRINT 2 TO 24: COLOR , C(CE, 2): CLS : VIEW PRINT
1060   M$ = "Aguarde un instante": GOSUB 940
1070   COLOR C(CE, 3), C(CE, 4)
1080   LOCATE 3, 1
1090   PRINT "N§ Nombre del Trabajador             Puesto        Sueldo          Compensaci¢n ";
1100   FOR I = 4 TO 23
1110     LOCATE I, 1
1120     PRINT "   "
1130   NEXT
1140 RETURN
1150 :
1160 'SUB Linea24
1170  COLOR C(CE, 1), C(CE, 2)
1180  LOCATE 24, 1
1190  PRINT USING "\      \  \        \  Total de trabajadores: ###"; TIME$; DATE$; TR;
1200 RETURN
1210 :
1220 'SUB Mensaje24
1230   IF M = 0 THEN M = 50
1240   LOCATE 24, M
1250   COLOR C(CE, 1), C(CE, 2)
1260   PRINT SPACE$(80 - M);
1270   M = 80 - LEN(M$)
1280   LOCATE 24, M
1290   COLOR C(CE, 7), C(CE, 8)
1300   PRINT M$;
1310 RETURN
1320 :
1330 'SUB MarcaCampo
1340   ON CAMPO GOTO 1350, 1360, 1370, 1380
1350   COL = 4: M$ = MASKN$: GOTO 1390
1360   COL = 38: M$ = MASKP$: GOTO 1390
1370   COL = 52: M$ = MASKD$: GOTO 1390
1380   COL = 68: M$ = MASKD$
1390   LOCATE LIN, COL
1400   IF QUITA THEN COLOR C(CE, 1), C(CE, 2) ELSE COLOR C(CE, 7), C(CE, 8)
1410   ON CAMPO GOTO 1420, 1430, 1440, 1450
1420   PRINT USING M$; NOMBRE$: GOTO 1460
1430   PRINT USING M$; PUESTO$: GOTO 1460
1440   PRINT USING M$; CVS(SUELDO$): GOTO 1460
1450   PRINT USING M$; CVS(COMP$)
1460 RETURN
1470 :
1480 'SUB EligeMensajeCampos
1490   ON CAMPO GOTO 1500, 1510, 1520, 1530
1500   M$ = "Apellido paterno Materno y nombre(s) del trabajador": GOTO 1540
1510   M$ = "Puesto asignado al trabajador": GOTO 1540
1520   M$ = "Sueldo diario del Trabajador": GOTO 1540
1530   M$ = "Compensaci¢n diaria del Trabajador (Bonos)"
1540   GOSUB 940
1550 RETURN
1560 :
1570 'SUB Flecha arriba
1580   IF LIN = 4 AND INICIO > 1 THEN INICIO = INICIO - 1: FIN = FIN - 1: REG1 = REG1 - 1: GOSUB 680 ELSE IF LIN = 4 AND INICIO = 1 THEN BEEP: GOTO 630 ELSE IF LIN > 4 THEN QUITA = TRUE: GOSUB 1330: LIN = LIN - 1: REG1 = REG1 - 1
1590   GET #1, REG1
1600   QUITA = FALSE
1610   GOSUB 1330: GOSUB 1160
1620 GOTO 630
1630 :
1640 'SUB Flecha Abajo
1650   IF LIN = 23 AND FIN < TR THEN INICIO = INICIO + 1: FIN = FIN + 1: REG1 = REG1 + 1: GOSUB 680: GOTO 1690
1660   IF LIN = 3 + TR THEN BEEP: GOTO 630
1670   IF LIN = 23 AND FIN = TR THEN BEEP: GOTO 630
1680   IF LIN < 23 THEN QUITA = TRUE: GOSUB 1330: LIN = LIN + 1: REG1 = REG1 + 1
1690   GET #1, REG1
1700   QUITA = FALSE
1710   GOSUB 1330: GOSUB 1160
1720 GOTO 630
1730 :
1740 'SUB Flecha derecha
1750   QUITA = TRUE: GOSUB 1330
1760   CAMPO = CAMPO + 1: IF CAMPO > 4 THEN CAMPO = 1
1770   QUITA = FALSE
1780   GOSUB 1330: GOSUB 1160: GOSUB 1480
1790 GOTO 630
1800 :
1810 'SUB Flecha Izquierda
1820   QUITA = TRUE: GOSUB 1330
1830   CAMPO = CAMPO - 1: IF CAMPO < 1 THEN CAMPO = 4
1840   QUITA = FALSE
1850   GOSUB 1330: GOSUB 1160: GOSUB 1480
1860 GOTO 630
1870 :
1880 'SUB PgUp
1890   IF INICIO = 1 OR TR <= 20 THEN BEEP: GOTO 630
1900   IF INICIO - 20 < 1 THEN REG1 = 1: LIN = 4: INICIO = 1: FIN = 20 ELSE INICIO = INICIO - 20: FIN = FIN - 20: REG1 = REG1 - 20
1910   GOSUB 680
1920   GET #1, REG1
1930   GOSUB 1330: GOSUB 1160
1940 GOTO 630
1950 :
1960 'SUB PgDn
1970   IF FIN = TR OR TR <= 20 THEN BEEP: GOTO 630
1980   IF FIN + 20 > TR THEN REG1 = TR: LIN = 23: INICIO = TR - 19: FIN = TR ELSE INICIO = INICIO + 20: FIN = FIN + 20: REG1 = REG1 + 20
1990   GOSUB 680
2000   GET #1, REG1
2010   GOSUB 1330: GOSUB 1160
2020 GOTO 630
2030 :
2040 'SUB Home
2050   IF INICIO = 1 THEN QUITA = TRUE: GOSUB 1330: REG1 = 1: LIN = 4: CAMPO = 1: QUITA = FALSE: GET #1, REG1: GOSUB 1330: GOSUB 1160: GOSUB 1480: GOTO 630
2060   INICIO = 1: FIN = 20: REG1 = 1: LIN = 4
2070   GOTO 1990
2080 :
2090 'SUB End
2100   IF FIN=TR THEN QUITA=TRUE:GOSUB 1330: REG1=TR: IF TR<=20 THEN LIN=TR+3:CAMPO=1:QUITA=FALSE:GET #1,REG1:GOSUB 1330:GOSUB 1160:GOSUB 1480:GOTO 630 ELSE LIN=23:CAMPO=1:QUITA=FALSE:GET #1,REG1:GOSUB 1330: GOSUB 1160:GOSUB 1480:GOTO 630
2110   INICIO = TR - 19: FIN = TR: REG1 = TR: LIN = 23
2120   GOTO 1990
2130 :
2140 'SUB EditaNombreOPuesto
2150   IF CAMPO = 3 OR CAMPO = 4 THEN BEEP: GOTO 630
2160   GOSUB 2220
2170   IF CADENT$="" THEN 630 ELSE IF CAMPO=1 THEN LSET NOMBRE$=CADENT$ ELSE IF CAMPO=2 THEN LSET PUESTO$=CADENT$
2180   PUT #1,REG1: FIND$=NOMBRE$: A$=T$
2190   IF TR>1 AND CAMPO=1 THEN GOSUB 2490: GOSUB 2790 'Clasificaci¢n y B£squeda
2200   T$=A$: IF T$=CHR$(13) THEN GOSUB 1330: GOTO 630 ELSE 440
2210 :
2220 'SUB EditaTexto
2230   M$=" Etiqueta ": GOSUB 1220
2240   LOCATE 2,1: COLOR C(CE,1),C(CE,2): PRINT SPACE$(80);
2250   IF T$ >= "a" AND T$ <= "z" THEN CADENT$ = CHR$(ASC(T$) - 32) ELSE CADENT$ = T$
2260   IF T$ = "¤" THEN CADENT$ = "¥"
2270   'DO
2280      COLOR C(CE, 1), C(CE, 2)
2290      LOCATE 2, 1
2300      PRINT "> " + CADENT$;: COLOR C(CE,1)+16: PRINT "_ "
2310      GOSUB 900
2320      IF T$=CHR$(8) AND CADENT$<>"" THEN CADENT$=LEFT$(CADENT$,LEN(CADENT$)-1): GOTO 2270 ELSE IF T$=CHR$(8) AND CADENT$="" THEN BEEP: GOTO 2310
2330      IF T$=ENT$ OR LEN(T$)=2 THEN 2450  'Aceptado
2340      IF T$=CHR$(27) THEN CADENT$="": T$="": GOTO 2450  'Aceptado
2341      IF LEN(CADENT$)=>76 THEN BEEP: GOTO 2310
2350      IF T$=>"A" AND T$<="Z" THEN 2430
2360      IF T$=>"a" AND T$<="z" THEN T$=CHR$(ASC(T$)-32): GOTO 2430
2370      IF T$=" " THEN T$="A": GOTO 2430
2380      IF T$="‚" THEN T$="E": GOTO 2430
2390      IF T$="¡" THEN T$="I": GOTO 2430
2400      IF T$="¢" THEN T$="O": GOTO 2430
2410      IF T$="£" THEN T$="U": GOTO 2430
2420      IF T$="¤" THEN T$="¥"
2430      CADENT$=CADENT$+T$
2440   GOTO 2270
2450   'Aceptado
2460   GOSUB 3960
2470 RETURN
2480 :
2490 'SUB Clasificaci¢nAutom tica
2500  M$=" Clasificando ": GOSUB 1220
2510  FLAG=FALSE
2520  WHILE NOT FLAG
2530    FLAG=TRUE
2540    J=TR
2550    WHILE J>1
2560      GET #1,J
2570      N1$=NOMBRE$
2580      GET #1,J-1
2590      IF N1$=>NOMBRE$ THEN 2730
2600        FLAG=FALSE
2610        GET #1,J
2620        N1$=NOMBRE$
2630        P1$=PUESTO$
2640        S1$=SUELDO$
2650        C1$=COMP$
2660        GET #1,J-1
2670        PUT #1,J
2680        LSET NOMBRE$=N1$
2690        LSET PUESTO$=P1$
2700        LSET SUELDO$=S1$
2710        LSET COMP$  =C1$
2720        PUT #1,J-1
2730      'STEP
2740      J=J-1
2750    WEND
2760  WEND
2770 RETURN
2780 :
2790 'SUB B£squeda
2800   M$=" B£squeda ": GOSUB 1220
2810   J=1
2820   GET #1,J
2830   WHILE FIND$<>LEFT$(NOMBRE$,LEN(FIND$)) AND J<=TR
2840     J=J+1
2850     GET #1,J
2860   WEND
2870   IF FIND$<>LEFT$(NOMBRE$,LEN(FIND$)) THEN GET #1,REG1: LOCATE 2,1: COLOR C(CE,1),C(CE,2): PRINT " Nombre no localizado, Pulse una tecla ": GOSUB 900: LOCATE 2,1: PRINT SPACE$(50): RETURN
2880   IF J>FIN THEN FIN=J: LIN=23: REG1=J: INICIO=FIN-19 ELSE IF J<INICIO THEN INICIO=J: LIN=4: REG1=J: FIN=INICIO+19 ELSE IF REG1>J THEN LIN=LIN-(REG1-J): REG1=J ELSE LIN=LIN+(J-REG1): REG1=J
2890   CAMPO=1: GOSUB 680: GET #1,REG1: GOSUB 1330: GOSUB 1480
2900 RETURN
2910 :
2920 'SUB EditaN£meros
2930   LOCATE 2,1: COLOR C(CE,1),C(CE,2): PRINT SPACE$(80);
2940   M$=" Valor ": GOSUB 1220
2950   CADENT$=T$
2960   LOCATE 2,1
2970     COLOR C(CE,1),C(CE,2)
2980     PRINT "> "+CADENT$;: COLOR C(CE,1)+16: PRINT "_ "
2990     GOSUB 900 'Tecla
3000     IF T$=CHR$(8) AND CADENT$<>"" THEN CADENT$=LEFT$(CADENT$,LEN(CADENT$)-1): GOTO 2960 ELSE IF T$=CHR$(8) AND CADENT$="" THEN BEEP: GOTO 2990
3010     IF T$=CHR$(13) OR LEN(T$)=2 THEN 3050 'Aceptado
3020     IF T$=>"0" AND T$<="9" THEN CADENT$=CADENT$+T$: GOTO 2960
3030     IF T$="." THEN CADENT$=CADENT$+T$: GOTO 2960
3040   BEEP: GOTO 2990
3050   'Aceptado
3060   GOSUB 3960
3070   IF CADENT$="" THEN 630
3080   IF CAMPO=3 THEN LSET SUELDO$=MKS$(VAL(CADENT$)) ELSE LSET COMP$=MKS$(VAL(CADENT$))
3090   PUT #1,REG1
3100   IF T$=CHR$(13) THEN GOSUB 1330: GOTO 630 ELSE 440
3110 :
3120 'SUB BuscaNombre
3130   M$="Tecl‚e el nombre a buscar": GOSUB 940
3140   T$="": GOSUB 2220
3150   IF CADENT$="" THEN 630
3160   FIND$=CADENT$
3170   GOSUB 2790: GOSUB 1480
3180 GOTO 630
3190 :
3200 'SUB Imprime
3210 M$=" Impresi¢n ": GOSUB 1220
3220 M$="Prepare impresora y pulse una tecla para iniciar. Esc aborta":GOSUB 940
3230 GOSUB 900
3240 IF T$=ESC$ THEN 630
3250 ON ERROR GOTO 3400
3260 M$="Imprimiendo. Aguarde un instante": GOSUB 940
3270 LPRINT "Empresa: "+ESC$+"E"+EMPRESA$+ESC$+"F"
3280 LPRINT "Fecha..: "+ESC$+"E"+DATE$+"  "+TIME$+ESC$+"F"
3290 LPRINT
3300 LPRINT "N§  Nombre del Trabajador            Puesto        Sueldo          Compensaci¢n ";
3310 FOR I=1 TO TR
3320   GET #1,I
3330   LPRINT USING "### "+MASKN$+"   "+MASKP$+"   "+MASKD$+"    "+MASKD$;I,NOMBRE$,PUESTO$,CVS(SUELDO$),CVS(COMP$)
3340 NEXT
3350 LPRINT CHR$(12)
3360 ON ERROR GOTO 0
3370 GET #1,REG1
3380 GOSUB 1480: GOTO 630
3390 :
3400 'ERROR de impresi¢n
3410 RESUME 3420
3420 ON ERROR GOTO 0
3430 M$=" Error ": GOSUB 1220
3440 M$="Error de Impresi¢n, pulse una tecla": GOSUB 940: GOSUB 900
3450 GOSUB 1480: GOTO 630
3460 :
3470 'SUB Anexar un registro
3480   M$=" Anexar ": GOSUB 1220
3490   IF TR < 20 THEN LIN = 4 + TR ELSE LIN = 23
3500   REG1 = TR + 1: CAMPO = 1
3510   GET #1, REG1
3520   LSET NOMBRE$ = SPACE$(30)
3530   LSET PUESTO$ = SPACE$(10)
3540   LSET SUELDO$ = MKS$(0)
3550   LSET COMP$ = MKS$(0)
3560   LSET BAJA$ = MKI$(FALSE)
3570   PUT #1, REG1
3580   TR = LOF(1) / 48
3590   IF TR < 20 THEN INICIO = 1: FIN = TR ELSE INICIO = REG1 - 19: FIN = REG1
3600   GOSUB 680
3610   GET #1, REG1
3620   GOSUB 1330: GOSUB 1160: GOSUB 1480
3630 GOTO 630
3640 :
3650 'SUB Baja
3660   M$=" Baja ": GOSUB 1220
3670   M$="­Precauci¢n! Trabajador se dar  de baja sin opci¢n a recuperar": GOSUB 940
3680   COLOR C(CE,1),C(CE,2): LOCATE 2,1: PRINT SPACE$(80);
3690   LOCATE 2, 1
3700   COLOR C(CE, 5), C(CE, 6)
3710   PRINT " !Trabajador se dar  de baja­ ¨Procede? (S/N) "
3720   GOSUB 900
3730   GOSUB 3960
3740   IF T$ <> "S" AND T$ <> "s" THEN GOSUB 1480: GOTO 630
3750   M$ = " En Proceso de Eliminaci¢n ": GOSUB 940
3760   IF TR = 1 THEN LSET NOMBRE$ = SPACE$(30): LSET PUESTO$ = SPACE$(10): LSET SUELDO$ = MKS$(0): LSET COMP$ = MKS$(0): PUT #1, 1: GOTO 3940
3770   OPEN "R", 2, "TRABAJAD.$$$", 48
3780   FIELD #2, 30 AS N1$, 10 AS P1$, 4 AS S1$, 4 AS C1$
3790   REG2 = 0
3800   FOR I = 1 TO TR
3810     GET #1, I
3820     IF I = REG1 THEN 3890
3830     LSET N1$ = NOMBRE$
3840     LSET P1$ = PUESTO$
3850     LSET S1$ = SUELDO$
3860     LSET C1$ = COMP$
3870     REG2 = REG2 + 1
3880     PUT #2, REG2
3890   NEXT I
3900   CLOSE
3910   KILL "trabajad.dat"
3920   NAME "trabajad.$$$" AS "trabajad.dat"
3930   GOSUB 1480
3940 RUN 90
3950 :
3960 'SUB LineaAyuda2
3970   COLOR C(CE,1),C(CE,2)
3980   LOCATE 2,1
3990   PRINT "Esc=Salir F7=Imprimir F8=Buscar F9=Borrar F10=Anexar     PgUp PgDn Home End "+CHR$(24)+CHR$(25)+CHR$(26)+CHR$(27)
4000 RETURN
4010 :
4020 'DATOS de los colores del monitor
4030 '    PPlano Splano Pmenu Smenu Pelec Selec Pcursor Scursor Pmensaje
4040 DATA   7   ,   0  ,  0  ,  7  , 15  ,  0  ,   0   ,   7   ,  15
4050 DATA  14   ,   1  ,  0  ,  3  , 15  ,  6  ,  15   ,   3   ,  14
4060 DATA   1   ,   7  , 15  ,  3  , 15  ,  1  ,  11   ,   7   ,  14
4070 DATA   0   ,   7  , 14  ,  2  , 15  ,  0  ,  15   ,   2   ,  12
4080 DATA   0   ,   7  , 14  ,  4  , 15  ,  0  ,  15   ,   4   ,  15
4090 DATA   8   ,   7  , 15  ,  5  , 13  ,  0  ,  15   ,   5   ,  14