primer commit subida

PROYECTO/ccdir - Copy/ccprmt016.4gl

@@ -0,0 +1,102 @@
+{
+  ==============================================================================
+  PROGRAMA              : ccprmt016.4gl
+  PROGRAMADOR           : Ing. Juan Soto
+  OBSERVACION           : ANULAR AVANCES
+  FECHA                 : 1/1/2014
+  ==============================================================================
+}
+
+GLOBALS
+ "ccprgb000.4gl"
+ 
+ MAIN
+ DEFER INTERRUPT
+ CALL ARG_VAL(1) RETURNING usuarios
+ CALL ARG_VAL(2) RETURNING clave
+ CALL ARG_VAL(3) RETURNING impresor
+
+ CONNECT to "decomarmol" AS "MSSQL" USER  usuarios USING clave
+ 
+ CALL ccprmt016()
+ 
+ END MAIN
+ 
+FUNCTION ccprmt016()
+    DEFINE monto1 DEC(12,2),
+           ptipodoc CHAR(2),
+           pnumDoc,pnumoc,xcotizacion_no,xtipo,xsec INT,
+           cliente CHAR(60),
+           estado CHAR(30)
+           
+    
+    OPEN WINDOW ccfmmt016 WITH FORM "ccfmmt016"
+    
+       INPUT BY NAME ptipoDoc,pnumDoc
+          AFTER FIELD pnumdoc
+           IF pnumdoc IS NOT NULL THEN
+              SELECT UNIQUE  a.nombre,CASE b.status_t 
+                WHEN 'E' THEN "NULO"
+               ELSE "ACTIVO"
+              END,
+              b.num_cheque,
+              a.tipo_cliente,a.sec_cliente
+             INTO cliente,estado,xcotizacion_no,xtipo,xsec FROM vetb00004 a,cctb00001 b
+              WHERE a.tipo_cliente = b.tipo_cliente AND
+                    a.sec_cliente = b.sec_cliente AND
+                    b.tipo_doc = ptipoDoc AND
+                    b.num_doc = pnumDoc AND
+                    b.status_t IS NULL
+
+                    
+                    IF STATUS = NOTFOUND THEN
+                       CALL msg(3)
+                       NEXT FIELD ptipoDoc
+                    END IF
+                    
+                    DISPLAY BY NAME cliente,estado
+                    
+          SELECT SUM(a.valor+a.monto_desc) INTO monto1 FROM cctb00001 a
+          WHERE a.status_t IS NULL AND a.num_doc = Pnumdoc AND
+                a.num_doc != a.aplica_a AND a.tipo_doc = "AV" 
+
+          IF monto1 IS NULL THEN
+             LET monto1 = 0
+          END IF
+
+          IF monto1 <> 0 THEN
+             CALL fgl_winmessage("ERROR","Documento Tiene Aplicaciones... No Puede Ser Eliminado","info")
+             NEXT FIELD ptipoDoc
+          END IF
+          # BUSCA DESPACHOS
+          {
+            SELECT a.num_oc INTO pnumoc FROM prtb00012 a
+            WHERE a.cotizacion_no = xcotizacion_no AND a.status_t IS NULL
+            
+            SELECT DISTINCT a.num_oc FROM iptb00006 a,iptb00005 b
+            WHERE a.num_oc = pnumoc AND a.status_t IS NULL AND 
+                  a.cod_mov = b.cod_mov AND b.control_despacho = 'SI'
+                  AND a.cod_sp = xtipo AND a.cod_sp_Sec = xsec
+            IF STATUS <> NOTFOUND THEN
+                CALL fgl_winmessage("ERROR","ORDEN TIENE CONDUCE DESPACHO, NO PUEDE ANULAR AVANCE","INFO")
+                NEXT FIELD pnumdoc
+            END IF
+         }
+      
+          END IF
+         AFTER INPUT
+          IF INT_FLAG THEN
+             CALL msg(2)
+             EXIT INPUT
+           END IF  
+         LET respuesta =  fgl_winquestion("INFO","ESTA SEGURO DE QUERER ANULAR ESTE DOCUMENTO?","NO","NO|YES","question",0)
+         IF UPSHIFT(respuesta) = "YES" THEN
+             UPDATE cctb00001 SET status_t = 'E',
+                                  us_mod = usuarios,
+                                   fech_mod = getdate()
+                      WHERE cctb00001.num_doc = pnumDoc AND 
+                            cctb00001.tipo_doc = ptipoDoc    
+                   CALL fgl_winmessage("INFO","REGISTRO ANULADO","INFO")         
+         END IF   
+         END input
+      END FUNCTION