   ' ============ ::::::::   SIEASP   :::::::: ============================
   '
   ' :::::::  INTERFASE SIERRA ASPEL
   '
   ' SISTEMAS SIERRA SA DE CV                  INTERFASE SIERRA ASPEL
   '                                           Crea las ventas por empresa
   '                                           en archivo .CSV
   ' 14-JUL-2003  1002  creaci¢n inicial del programa
   ' ======================================================================
     DIM VSN$(9),VSI#(9),VCP$(100),VCN$(100),VCI#(100)
     ON ERROR GOTO ErrorHandler

     FLIC$="20101231"
     FHOY$=MID$(DATE$,7,4)+MID$(DATE$,1,2)+MID$(DATE$,4,2)
     PRINT FHOY$
     IF FHOY$>FLIC$ THEN
        COLOR 7,0                                          ' intensidad media
        CLS
        PR=07:PC=28:NR=05:NC=21:GOSUB 9981
        COLOR 0,7
        LOCATE PR+1,PC+2:PRINT " INTERFASE SIE-ASP "
        COLOR 15,7
        LOCATE PR+3,PC+2:PRINT "Su licencia expir¢."
        LOCATE PR+4,PC+2:PRINT "Comuniquese a      "
        LOCATE PR+5,PC+2:PRINT "Sistemas Sierra.   "
        BEEP
        LOCATE PR+6,PC+21:PRINT "";:W$=INPUT$(1)
        CLOSE:END
     ENDIF

     WIDTH LPRINT 150                                      ' asigna impresor

                                                           ' FECHA DE ORDER1.QUE
     OPEN "ORDER1.QUE" FOR RANDOM ACCESS READ WRITE SHARED AS #11 LEN=128
     FIELD#11,128AS QUE11$

     REG=50
1000 GET#11,REG                                            ' accesa reg
     IF MID$(QUE11$,9,1)<>"0" THEN                         ' no es reg cobro
        REG=REG+1                                          ' incrementa reg
        IF REG<501 THEN                                    ' es menor de 501
           GOTO 1000                                       ' regresa a leer otro reg
        ENDIF
     ENDIF
     FEV$=MID$(QUE11$,10,6)                                ' fecha de venta
     MES=VAL(MID$(FEV$,1,2))                               ' mes en que se cre¢ el order
     DIA=VAL(MID$(FEV$,3,2))                               ' dia en que se cre¢ el order
     FX$=MID$(FEV$,5,2)+MID$(FEV$,1,2)+MID$(FEV$,3,2)
     GOSUB 7900                                            ' valida fecha
     IF K<>0 THEN                                          ' fecha no ok
        MES=VAL(MID$(QUE11$,41,2))                         ' mes en que se cre¢ el order
        DIA=VAL(MID$(QUE11$,43,2))                         ' dia en que se cre¢ el order
        FEV$=MID$(QUE11$,41,6)                             ' fecha en que se cre¢
        FX$=MID$(FEV$,5,2)+MID$(FEV$,1,2)+MID$(FEV$,3,2)
        GOSUB 7900
        IF K<>0 THEN
           IKE=1:LPRINT CHR$(27);CHR$(33);CHR$(4);
           LPRINT ">>> LA FECHA ";FECHA$;" DEL ARCHIVO ORDER1.QUE ES INCORRECTA"
           CLOSE
           END
        ENDIF
     ENDIF

1010 GOSUB 7850
     DOQ$=DX$:MOQ$=MX$:AOQ$=AX$                            ' fecha de venta
     IF LEN(AOQ$)=2 THEN XAOQ$=AOQ$:IF AOQ$<"80" THEN AOQ$="20"+AOQ$ ELSE AOQ$="19"+AOQ$
     MESDIA=31*(MES-1)+DIA                                 ' registro

     SHELL "PLUPRU"

     COLOR 7,0                                             ' intensidad media
     CLS
     PR=07:PC=28:NR=05:NC=21:GOSUB 9981
     COLOR 0,7
        LOCATE PR+1,PC+2:PRINT " INTERFASE SIE-ASP "
        COLOR 15,7
           LOCATE PR+2,PC+3:PRINT "Crea p¢liza ventas "
        COLOR 0,7
           LOCATE PR+4,PC+3:PRINT "Venta  "
           LOCATE PR+5,PC+3:PRINT "Avance"

     COLOR 15,7:LOCATE PR+4,PC+10:PRINT DOQ$;"-";MOQ$;"-";AOQ$

     FOR I=1 TO 9                                          ' INICIALIZA VENTAS X MESERO
         VSN$(I) =SPACE$(8)                                ' nombre
         VSI#(I)=0                                         ' importe
     NEXT I
     FOR I=1 TO 100                                        ' INICIALIZA COBROS
         VCP$(I)=SPACE$(5)                                 ' plu
         VCN$(I)=SPACE$(8)                                 ' nombre
         VCI#(I)=0                                         ' importe
     NEXT I

     XC=0
     OPEN "ASC-B" FOR INPUT ACCESS READ SHARED AS #33      ' ARCH ASC-B
1020 IF EOF(33) THEN CLOSE#33:GOTO 1030
        INPUT#33,X01$,X02$,X03$,X04$,X05$,X06$,X07$,X08$,X09$,X10$,X11$,X12$,X13$,X14$,X15$,X16$,X17$,X18$,X19$,X20$,X21$,X22$,X23$,X24$,X25$,X26$,X27$,X28$
        PLU$=MID$(X02$,2,5)                                ' plu
        NOM$=MID$(X04$,002,08)                             ' nombre
        IF MID$(PLU$,1,1)="9" THEN
           FOR J=1 TO 5
               IF MID$(PLU$,J,1)=" " THEN 1020             ' es espacio
           NEXT J
           XC=XC+1
           VCP$(XC)=PLU$                                   ' plu$
           VCN$(XC)=NOM$                                   ' nombre 
           GOTO 1020
        ELSE
           IF MID$(PLU$,2,1)=" " THEN                      ' es espacio
              SUP=VAL(MID$(PLU$,1,1))                      ' supercategoria
              VSN$(SUP)=NOM$                               ' nombre
              GOTO 1020
           ENDIF
        ENDIF
        GOTO 1020

1030 VSN$(9)="PROPINA "
     IQ=2:CAMB#=0:IVA#=0:kont=0                            ' inicio en 2
1100 IF EOF(11) THEN 1350                                  ' termina
        COLOR 15,7:LOCATE PR+5,PC+15:PRINT USING "######";IQ
        GET#11,IQ                                          ' accesa archivo order1.que
        IF MID$(QUE11$, 9,1)>"1" THEN 1102                 ' no es venta o cobro
        XCA=VAL(MID$(QUE11$, 31,1)):IF XCA=0 THEN XCA=1    ' categoria
        PLU$=MID$(QUE11$,31,5)
        IF MID$(QUE11$, 9,1)="1" THEN                      ' es venta
           IF MID$(QUE11$,30,1)="V" OR MID$(QUE11$,30,1)="v" THEN 1102 ' invalido
           IF MID$(QUE11$,31,1)="9" THEN
              VSI#(9)=VSI#(9)+VAL(MID$(QUE11$,62,8))       ' acumula propina
              FOR J=1 TO 100
                  IF VCP$(J)=PLU$ THEN
                     VCI#(J)=VCI#(J)+VAL(MID$(QUE11$,70,8)) ' acumula cobro
                     GOTO 1102
                  ENDIF
              NEXT J
           ELSE
              VSI#(XCA)=VSI#(XCA)+VAL(MID$(QUE11$,70,8))   ' acumula venta supercat
           ENDIF
        ELSE
           CAMB#=CAMB#+VAL(MID$(QUE11$,70,8))              ' cambio
           IVA# =IVA# +VAL(MID$(QUE11$,54,8))              ' iva
        ENDIF
     IF MID$(QUE11$, 9,1)<"0" THEN 1350                    ' fin de archivo
     IF MID$(QUE11$, 9,1)>"9" THEN 1350                    ' fin de archivo
1102    IQ=IQ+1                                            ' incrementa contador
        GOTO 1100                                          ' regresa a accesar order.que

1350 IXXX$="VT"+MID$(FEV$,3,2)+MID$(FEV$,1,2)+MID$(FEV$,5,2)+".CSV" ' archivo CSV
     OPEN "O",#26,IXXX$                                    ' abre archivo CSV
     CLOSE#26                                              ' cierra arch CSV
     KILL IXXX$                                            ' borra arch CSV
     OPEN "O",#26,IXXX$                                    ' abre arch CSV

     AV$="VT"+MID$(FEV$,3,2)+MID$(FEV$,1,2)+MID$(FEV$,5,2)+".POL" ' archivo CSV
     OPEN "O",#1,AV$                                       ' abre archivo POL
     CLOSE#1                                               ' cierra arch POL
     KILL AV$                                              ' borra arch POL

     OPEN AV$ FOR RANDOM ACCESS READ WRITE SHARED AS #1 LEN=66
     FIELD#1,5AS A1$,1AS AA$,40AS B1$,1AS BB$,18AS C1$,1AS D1$

     FOR I=1 TO 8                                          ' 1-8 SUPERCATEGORIAS
         WRITE#26,MID$(STR$(I),2),VSN$(I),VSI#(I)
         XA$=MID$(STR$(I),2):XA$=STRING$(4-LEN(A$),"0")+XA$ 
         XB$=VSN$(I)
         YY#=VSI#(I):GOSUB 7402
         XC$=STRING$(18-LEN(YY$),"0")+YY$
         GOSUB 1400                                        ' lsets
         PUT#1,I                                           ' graba
     NEXT I

     WRITE#26,MID$(STR$(9),2),VSN$(9),VSI#(9)              '   9 PROPINA
     XA$=MID$(STR$(9),2):XA$=STRING$(4-LEN(A$),"0")+XA$
     XB$="PROPINA"+SPACE$(33)
     YY#=VSI#(9):GOSUB 7402
     XC$=STRING$(18-LEN(YY$),"0")+YY$
     GOSUB 1400                                            ' lsets
     PUT#1,9                                               ' graba

     WRITE#26,MID$(STR$(10),2),"IVA     ",IVA#             '  10 IVA
     XA$=MID$(STR$(10),2):XA$=STRING$(3-LEN(A$),"0")+XA$
     XB$="IVA"+SPACE$(37)
     YY#=IVA#:GOSUB 7402
     XC$=STRING$(18-LEN(YY$),"0")+YY$
     GOSUB 1400                                            ' lsets
     PUT#1,10                                              ' graba

     FECHA$=MID$(FEV$,3,2)+"-"+MID$(FEV$,1,2)+"-"+MID$(FEV$,5,2)
     WRITE#26,MID$(STR$(11),2),"VENTAS DEL DIA",FECHA$     '  11 FECHA DE VENTA
     XA$=MID$(STR$(11),2):XA$=STRING$(3-LEN(A$),"0")+XA$
     XB$="VENTAS DEL DIA"+SPACE$(26)
     XC$=FECHA$
     XC$=STRING$(18-LEN(XC$)," ")+XC$
     GOSUB 1400                                            ' lsets
     PUT#1,11                                              ' graba

     WRITE#26,MID$(STR$(12),2),"CAMBIO  ",CAMB#            ' 12   cambio
     XA$=MID$(STR$(12),2):XA$=STRING$(3-LEN(A$),"0")+XA$
     XB$="CAMBIO"+SPACE$(34)
     YY#=CAMB#:GOSUB 7402
     XC$=STRING$(18-LEN(YY$),"0")+YY$
     GOSUB 1400                                            ' lsets
     PUT#1,12                                              ' graba

     REG=12
     FOR I=1 TO 100                                        ' 13-> cobros
         IF VCI#(I)<>0 THEN
            IF I=1 THEN
               VCI#(I)=VCI#(I)+CAMB#-VSI#(9)               ' efectivo 24-mar-04
            ENDIF
            WRITE#26,VCP$(I),VCN$(I),VCI#(I)
            XA$=VCP$(I)
            XB$=VCN$(I)
            YY#=VCI#(I):GOSUB 7402
            XC$=STRING$(18-LEN(YY$),"0")+YY$
            GOSUB 1400                                     ' lsets
            REG=REG+1
            PUT#1,REG                                      ' graba
         ENDIF
     NEXT I
     CLOSE:END

1400 LSET A1$=XA$
     LSET AA$=SPACE$(1)
     LSET B1$=XB$
     LSET BB$=SPACE$(1)
     LSET C1$=XC$
     LSET D1$=CHR$(10)
     RETURN

6999 ' $INCLUDE: 'R40GRL.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
