10 ' ============ ::::::::   VP4FOR :::::::: ==============================
   '
   ' :::::::  ANALISIS DE VENTAS   INTERFASE INTFOR04               
   '                               PLUs   
   ' SISTEMAS SIERRA SA DE CV      REPORTE DE ALTO MOVIMIENTO ANUAL IMPORTE
   ' 31-ENE-2005 1147  creaci˘n inicial del programa
   ' ======================================================================
   
    ' $INCLUDE: 'EDITAL.BAS'
      DIM SHARED V1%(2000),V2%(2000),V3%(2000)
      DIM VP#(2,12),VT#(2,12)
      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$

     ' $INCLUDE: 'OPNTOT.BAS'
     ' $INCLUDE: 'OPNTEM.BAS'
     ' $INCLUDE: 'OPNPLU.BAS'

      GOSUB 100:GOTO 110
100   GET#5,1
      IVI$=MID$(VP5$,2,1)                                  ' iva incluido
      IIMP$=MID$(VP5$,4,1)                                 ' importe dif 0
      IVA =CVS(IV5$)                                       ' iva
      UP  =CVS(UP5$)                                       ' ultimo plu
      MPLU=CVI(PI5$)                                       ' max plus a imprimir
      VAB$ =AB5$                                           ' vector A y B
      RETURN

110    CLS
       PR=10:PC=28:NR=02:NC=17:GOSUB 9981
       COLOR 15,7:LOCATE 11,29:PRINT "Calculando ###.#%"
       COLOR  1,7:LOCATE 12,29:PRINT "INTFOR04.CSV     "
       GOSUB 350                                           
       'BEEP
       'COLOR  4,7:LOCATE 12,29:PRINT " Fin de proceso  "
       '**********************************************
     CLOSE                                                 ' cierra archivos
     END

350                                                        ' VENTAS ANUALES

     PG=1
     NOM$="XIAnual":REP$="VENTA PLUs POR IMPORTE   "
     AB$=SPACE$(1)

1005 AB$="T"
     MAB$="A y B    "
     XNOM$="EXCFOR04.CSV"

     OPEN "O",#26,XNOM$                                    ' abre archivo CSV
     CLOSE#26                                              ' cierra arch CSV
     KILL XNOM$                                            ' borra arch CSV
     OPEN "O",#26,XNOM$                                    ' abre arch CSV
     PERIODO$=DIA$+"-"+MES$+"-"+ANO$
     WRITE#26,PERIODO$,TIT$,"","","ENE","","FEB","","MAR","","ABR","","MAY","","JUN","","JUL","","AGO","","SEP","","OCT","","NOV","","DIC",""
     WRITE#26,"PLU","NOMBRE CORTO","NOMBRE COMPLETO","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA",_
                                                     "CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","CANTIDAD","VENTA","DIAS VENTA"

                                                           ' CREA INDICE ANUAL
     GOSUB 1354                                            '    abre archivo indice
     CLOSE#23                                              '    cierra arch indice
     KILL IND$                                             '    borra arch indice
     GOSUB 1354                                            '    abre arch indice

     KR=0
     V96$=SPACE$(96)
     FOR I=1 TO 12
         MID$(V96$,8*(I-1)+1,8)=MKD$(0)                    ' vector
     NEXT I
     FOR XPLU=1 TO UP                                      ' PLUs
         COLOR 15,7:LOCATE 11,40:PRINT USING "###.#%";(XPLU/UP)*100
         VA$=V96$
         VC$=V96$
         KD=0                                              ' dias
         GET#3,XPLU                                        ' accesa plus
         IF ASC(F3$)=0 THEN                                ' existe plu
            IF W$="C" THEN CLOSE:END
            IF VAL(PL3$)=0 THEN 1040
            IF AB$<>"T" THEN                               ' es a o b
               PV=VAL(MID$(PL3$,1,1))                      ' supercategoria
               IF PV<1 OR PV>8         THEN 1040           ' pv invalido
               IF MID$(VAB$,PV,1)<>AB$ THEN 1040           ' a y b
            ENDIF
            VTA$=VD3$                                      ' venta en importe
            VTC$=VU3$
            FOR XMES=1 TO 12
                VMES#=0
                VMEC#=0
                FOR XDIA=1 TO 31
                    MESDIA=124*(XMES-1)+4*(XDIA-1)+1       ' posicion
                    VDIA#=CVS(MID$(VTA$,MESDIA,4))         ' venta del dia importe
                    YY#=VDIA#:GOSUB 7402:VDIA#=YY#/100
                    VDIC#=CVS(MID$(VTC$,MESDIA,4))         ' venta del dia unidades
                    YY#=VDIC#:GOSUB 7402:VDIC#=YY#/100
                    IF VDIA#<>0 OR VDIC#<>0 THEN           ' dif a cero
                       VMES#=VMES#+VDIA#                   ' acumula venta
                       VMEC#=VMEC#+VDIC#                   ' acumula venta
                       KD=KD+1                             ' dias de venta
                    ENDIF
                NEXT XDIA
                MID$(VA$,8*(XMES-1)+1,8)=MKD$(VMES#)
                MID$(VC$,8*(XMES-1)+1,8)=MKD$(VMEC#)
            NEXT XMES
            LSET PLU23$=PL3$                               ' plu
            LSET NCPLU23$=NC3$                             ' nombre corto
            LSET NPLU23$=NL3$                              ' nombre del plu
            LSET VI23$=VA$                                 ' importe
            LSET VC23$=VC$                                 ' unidades
            LSET DV23$=MKI$(KD)                            ' dias de venta
            LSET CS23$=MKI$(1)                             ' ind de sort
            KR=KR+1                                        ' registro mes
            PUT#23,KR
         ENDIF
1040 NEXT XPLU
     GOSUB 6000                                            ' ve a ordenar

     FOR I=1 TO 12
         VT#(1,I)=0
         VT#(2,I)=0
     NEXT I
     FOR XPLU=1 TO KR
         GET#23,XPLU
         FOR I=1 TO 12
             VP#(1,I)=0
             VP#(2,I)=0
         NEXT I
         FOR XMES=1 TO 12
             VP#(1,XMES)=CVD(MID$(VI23$,8*(XMES-1)+1,8))
             VP#(2,XMES)=CVD(MID$(VC23$,8*(XMES-1)+1,8))
         NEXT XMES
         WRITE#26,PLU23$,NCPLU23$,NPLU23$,VP#(2,01),VP#(1,01),VP#(2,02),VP#(1,02),VP#(2,03),VP#(1,03),VP#(2,04),VP#(1,04),VP#(2,05),VP#(1,05),VP#(2,06),VP#(1,06),_
                                          VP#(2,07),VP#(1,07),VP#(2,08),VP#(1,08),VP#(2,09),VP#(1,09),VP#(2,10),VP#(1,10),VP#(2,11),VP#(1,11),VP#(2,12),VP#(1,12),CVI(DV23$)
         FOR I=1 TO 12
             VT#(1,I)=VT#(1,I)+VP#(1,I)
             VT#(2,I)=VT#(2,I)+VP#(2,I)
         NEXT I
     NEXT XPLU
     WRITE#26,"TOTALES:",KR,"",VP#(2,01),VP#(1,01),VP#(2,02),VP#(1,02),VP#(2,03),VP#(1,03),VP#(2,04),VP#(1,04),VP#(2,05),VP#(1,05),VP#(2,06),VP#(1,06),_
                               VP#(2,07),VP#(1,07),VP#(2,08),VP#(1,08),VP#(2,09),VP#(1,09),VP#(2,10),VP#(1,10),VP#(2,11),VP#(1,11),VP#(2,12),VP#(1,12),""

     ' $INCLUDE: 'P16ARG.BAS'
     KONT=0
     FOR S=1 TO 8
         FOR C=1 TO 9
             FOR B=1 TO 9
                 FOR D=1 TO 99
                     PLU$=MID$(STR$(S),2,1)+MID$(STR$(C),2,1)+MID$(STR$(B),2,1)
                     IF D<10 THEN
                        PLU$=PLU$+"0"+MID$(STR$(D),2,1)
                     ELSE
                        PLU$=PLU$+MID$(STR$(D),2,2)
                     ENDIF
                     KONT=KONT+1
                     LSET PLU22$=PLU$
                     LSET NCPLU22$=SPACE$(8)
                     LSET NLPLU22$=SPACE$(24)
                     LSET V22$=V96$
                     LSET C22$=V96$
                     LSET DV22$=MKI$(0)
                     PUT#22,KONT
                     COLOR 15,7:LOCATE 11,40:PRINT USING "###.#";(KONT/64152)*100
                 NEXT D
             NEXT B
         NEXT C
      NEXT S

      FOR XPLU=1 TO KR
          GET#23,XPLU
          COLOR 15,7:LOCATE 11,40:PRINT USING "###.#";(XPLU/KR)*100
          S=VAL(MID$(PLU23$,1,1))
          C=VAL(MID$(PLU23$,2,1))
          B=VAL(MID$(PLU23$,3,1))
          D=VAL(MID$(PLU23$,4,2))
          REG=8019*(S-1)+891*(C-1)+99*(B-1)+D
             LSET PLU22$=PLU23$
             LSET NCPLU22$=NCPLU23$
             LSET NLPLU22$=NPLU23$
             LSET V22$=VI23$
             LSET C22$=VC23$
             LSET DV22$=DV23$
             PUT#22,REG
     NEXT XPLU     

1320 RETURN

1354 IND$="C:"+"F16IND.ARG"
     ' $INCLUDE: 'F16ARG.BAS'
     RETURN

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

6000                                                       ' ORDENAR (SORT)
     PLC$="C:"+"F16IND.ARG"                                ' indice
     CMND$="2\1\0\0\"+PLC$+"\"+PLC$+"\0\233\N\N\0\01\5\A\A\0\Y\D\232\2\I\E\0\0"
     CLOSE#23
     SLVN$="1"
     CALL SORTMC(CMND$,SORTERR%,RECCNT%)
     RECCNT=RECCNT%
     IF RECCNT<0 THEN
        RECCNT=RECCNT+65536
     ENDIF
     IF SORTERR%=0 THEN
        GOSUB 1354
        RETURN
     ENDIF
     PRINT
     PRINT "*** ERROR AL ORDENAR ARCHIVO INDICE ...VERFIFIQUE QUE HAYA ESPACIO SUFICIENTE";SORTERR%
     CLOSE:END

6999 ' $INCLUDE: 'R40GRL.BAS'
     ' $INCLUDE: 'LEFARG.BAS'
     ' $INCLUDE: 'KEYARG.BAS'
     ' $INCLUDE: 'VERSFT.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
