   ' ============ ::::::::   CVEARG :::::::: ==============================
   '
   ' :::::::  ANALISIS DE VENTAS                   
   '                                                
   ' SISTEMAS SIERRA SA DE CV                    CLAVES DE ACCESO
   ' 14-Oct-2003 0900  creaci¢n inicial del programa
   ' ======================================================================
    
    ' $INCLUDE: 'EDITAL.BAS'
      DIM SHARED V1%(2000),V2%(2000),V3%(2000)
      ON ERROR GOTO ErrorHandler
      WIDTH LPRINT 150                                     ' asigna impresor

      GOSUB 9802                                           ' carga parametros
      IF LEN(ANO$)=2 THEN XANO$=ANO$:IF ANO$<"80" THEN ANO$="20"+ANO$ ELSE ANO$="19"+ANO$

110   GOSUB 350                                            ' INICIA PROCESO
      CLOSE                                                ' cierra archivos
      END

350                                                        ' CLAVES
     GOSUB 10016                                           ' cuadro pantalla
     SISTEMA$="ANALISIS DE VENTAS":LG=79                   ' titulo
     MENU$="Alta de claves"
     GOSUB 8300                                            ' encabezado
     COLOR 7,0                                             ' intensidad media

     COLOR 7,0                                             ' intensidad media
     PR= 6:PC=02:NR=01:NC=07:GOSUB 9981
     PR= 9:PC=09:NR=04:NC=62:GOSUB 9980
     PR=11:PC=10:NR=01:NC=04:GOSUB 9981
     PR=11:PC=16:NR=01:NC=07:GOSUB 9981
     PR=11:PC=25:NR=01:NC=30:GOSUB 9981
     PR=11:PC=57:NR=01:NC=05:GOSUB 9981
     PR=11:PC=64:NR=01:NC=06:GOSUB 9981
     COLOR  0,7:LOCATE 10,12:PRINT "Num    Men£            Descripci¢n            Clave  Progrm"

1000 MENSAJE$=" Clave gerencial para crear claves.":GOSUB 15710
     COLOR 15,1:LOCATE 7,03:PRINT SPACE$(7)
     PSW$=SPACE$(7)
     I=1
1002 S$="":W=7:Z=2+I:L=1:T=3:keypressed = edit(z,w,l,S$)
     IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW OR KEYPRESSED=LEFTARROW OR KEYPRESSED=BACKSPACE THEN
        IF I=1 THEN
           RETURN
        ELSE
           COLOR 15,1:LOCATE 7,2+I:PRINT "*"
           I=I-1
           GOTO 1002
        ENDIF
     ENDIF
     MID$(PSW$,I,1)=S$
     COLOR 15,1:LOCATE 7,2+I:PRINT "*"
     I=I+1
     IF I<8 THEN 1002
     IF PSW$<>"SSIERRA" THEN
        COLOR 15,7
        LOCATE 7,12:PRINT "Clave Inv lida...No autorizado..."
        BEEP
        RETURN
     ENDIF

1006 COLOR 15,7
     FOR I=6 TO 8
         LOCATE I,2:PRINT SPACE$(9)
     NEXT I

     OPEN "PSWACC.ARG" FOR RANDOM ACCESS READ WRITE SHARED AS #41 LEN=49
     FIELD#41,1AS ST41$,7AS MN41$,30AS DE41$,5AS CV41$,6AS PG41$

1010 GOSUB 1012:GOSUB 1014:GOSUB 1016:GOSUB 1018:GOSUB 1020:GOTO 1050
1012 COLOR 15,7:LOCATE 12,11:PRINT SPACE$(04):RETURN
1014 COLOR 15,7:LOCATE 12,17:PRINT SPACE$(07):RETURN
1016 COLOR 15,7:LOCATE 12,26:PRINT SPACE$(30):RETURN
1018 COLOR 15,7:LOCATE 12,58:PRINT SPACE$(05):RETURN
1020 COLOR 15,7:LOCATE 12,65:PRINT SPACE$(06):RETURN

1050 LS=1000
     NUM$=SPACE$(4)
     MNU$=SPACE$(7)
     DES$=SPACE$(3)
     CVE$=SPACE$(5)
     PRG$=SPACE$(6)

1100 MENSAJE$=" N£mero de men£.  F1=autoasignado.  F8=consulta.":GOSUB 15710
     COLOR 16,15:LOCATE 24,20:PRINT "F1";
                 LOCATE 24,38:PRINT "F8";
     LOCATE 23,2:PRINT "":COLOR 7,0
     IF NUM$=SPACE$(4) THEN S$="" ELSE S$=NUM$
     COLOR 15,1:W=12:Z=11:L=4:T=1:keypressed = edit(z,w,l,S$) ' NUMERO
     IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW THEN RETURN
     IF KEYPRESSED=FF1 THEN
        FOR IJ=1 TO LS                                     ' busca disponible
            GET#41,IJ                                      ' accesa
            IF ASC(ST41$)=255 THEN
               NUM=IJ
               NUM$=STR$(NUM)
               NUM$=MID$(NUM$,2)
               NUM$=STRING$(4-LEN(NUM$),"0")+NUM$
               COLOR 15,7:LOCATE 12,11:PRINT NUM$
               GOTO 1150
            ENDIF
        NEXT IJ
        GOSUB 7570                                         ' no hay espacio
        GOTO 1010
     ENDIF   
     IF KEYPRESSED=FF8 THEN
        GOSUB 2800
        S$=NUM$
     ENDIF
     NUM$=STRING$(4-LEN(S$),"0")+S$
     COLOR 15,7:LOCATE 12,11:PRINT NUM$
     NUM=VAL(S$)
     IF NUM<1 OR NUM>LS THEN
        GOSUB 7600
        GOTO 1010
     ENDIF
     GET#41,NUM
     IF ASC(ST41$)=255 THEN 1150                       ' nueva alta
        MNU$=MN41$
        DES$=DE41$
        CVE$=CV41$
        PRG$=PG41$
        COLOR 15,7
           LOCATE 12,17:PRINT MNU$
           LOCATE 12,26:PRINT DES$
           LOCATE 12,58:PRINT CVE$
           LOCATE 12,65:PRINT PRG$

     GOSUB 5000
        PR=06:PC=16:NR=03:NC=10:GOSUB 9980
        PR=07:PC=17:NR=01:NC=01:GOSUB 9981
        COLOR 0,7:LOCATE 08,21:PRINT "1=baja"

        MENSAJE$=" 1=borrar registro.  Enter=modificar.  Esc=regresar":GOSUB 15710
        COLOR 16,15:LOCATE 24,03:PRINT "1";
                    LOCATE 24,23:PRINT "Enter";
                    LOCATE 24,41:PRINT "Esc";
        LOCATE 23,2:PRINT "":COLOR 7,0
        COLOR 15,1:S$="":W=08:Z=18:L=1:T=1:keypressed = edit(z,w,l,S$) ' BAJA
        IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW THEN GOSUB 5002:GOTO 1010
        IF S$="1" THEN                                     ' BAJA
           LSET ST41$=CHR$(255)                            
           LSET MN41$=SPACE$(7)
           LSET DE41$=SPACE$(30)
           LSET CV41$=SPACE$(5)
           LSET PG41$=SPACE$(6)
           PUT#41,NUM
           BEEP
           GOSUB 5002
           GOTO 1010                                       ' regresa
        ENDIF
        GOSUB 5002

1150 MENSAJE$=" Opci¢n de men£. 9.9.9.9 ":GOSUB 15710
     IF MNU$=SPACE$(7) THEN S$="" ELSE S$=MNU$
     COLOR 15,1:W=12:Z=17:L=7:T=2:keypressed = edit(z,w,l,S$) ' MENU
     IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW THEN
        GOTO 1010
     ELSE
        MNU$=S$+SPACE$(7-LEN(S$))                          ' menu
        COLOR 15,7:LOCATE 12,17:PRINT MNU$                 ' imprime
     ENDIF

1160 MENSAJE$=" Descripci¢n.  SSS MMM xxxxxxxxxxxxxxxxxxxxxx ":GOSUB 15710
     IF DES$=SPACE$(30) THEN S$="" ELSE S$=DES$
     COLOR 15,1:W=12:Z=26:L=30:T=3:keypressed = edit(z,w,l,S$) ' DESCRIPCION
     IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW THEN
        COLOR 15,7:LOCATE 12,26:PRINT DES$
        GOTO 1150
     ELSE
        DES$=S$+SPACE$(30-LEN(S$))                         ' menu
        COLOR 15,7:LOCATE 12,26:PRINT DES$                 ' imprime
    ENDIF

1170 MENSAJE$=" Clave de acceso.  xxxxx ":GOSUB 15710
     IF CVE$=SPACE$(5) THEN S$="" ELSE S$=CVE$
     COLOR 15,1:W=12:Z=58:L=5:T=3:keypressed = edit(z,w,l,S$) ' CLAVE
     IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW THEN
        COLOR 15,7:LOCATE 12,58:PRINT CVE$
        GOTO 1160
     ELSE
        CVE$=S$+SPACE$(5-LEN(S$))                          ' clave
        COLOR 15,7:LOCATE 12,58:PRINT CVE$                 ' imprime
    ENDIF

1172 MENSAJE$=" Programa.  xxxxxx ":GOSUB 15710
     IF PRG$=SPACE$(6) THEN S$="" ELSE S$=PRG$
     COLOR 15,1:W=12:Z=65:L=6:T=3:keypressed = edit(z,w,l,S$) ' PROGRAMA
     IF KEYPRESSED=ESCAPE OR KEYPRESSED=UPARROW THEN 
        COLOR 15,7:LOCATE 12,65:PRINT PRG$
        GOTO 1170
     ELSE
        PRG$=S$+SPACE$(6-LEN(S$))                          ' clave
        COLOR 15,7:LOCATE 12,65:PRINT PRG$                 ' imprime
    ENDIF

1175 LSET ST41$=CHR$(0)
     LSET MN41$=MNU$
     LSET DE41$=DES$
     LSET CV41$=CVE$
     LSET PG41$=PRG$
     PUT#41,NUM
     BEEP
     GOTO 1010

2800                                                       ' CONSULTA
     ' $INCLUDE: 'I60ARG.BAS'
       LSET NUM60$ =SPACE$(4)
       PUT#60,1
       CLOSE#60
       SHELL "\SIEARG2\CMNARG"                             ' INSERTA MENU
       ' $INCLUDE: 'I60ARG.BAS'
       GET#60,1
       NUM$=NUM60$
       CLOSE#60
       RETURN

5000 AP%=VARPTR(V1%(1)):CALL SAVESCRN(1, AP%):RETURN
5002 AP%=VARPTR(V1%(1)):CALL RESTSCRN(1, AP%):RETURN

6999 ' $INCLUDE: 'R40GRL.BAS'
     ' $INCLUDE: 'LEFARG.BAS'

ErrorHandler:
      IF ERR=70 THEN LOCATE 24,01:COLOR 16,15:PRINT "pd...";:LOCATE 23,2:PRINT "":RESUME
      IF ERR=24 OR ERR=25 OR ERR=27 THEN GOSUB 7510:RESUME
      COLOR 16,15:LOCATE 24,01:PRINT "Error en los datos ";ERR;" Linea ";ERL;". Llame a SIERRA.";:LOCATE 23,2:PRINT "":W$=INPUT$(1):CLOSE:END
