primer commit subida

PROYECTOS COSTOS/irdir/irprmt066.4gl

@@ -0,0 +1,170 @@
+{
+--------------------------------------------------------------------------
+ PROGRAMA          : IRPRMT066
+ OBJETIVO          : Programa Para Anular en Forma Logica Movimientos de
+                     Inventario de Repuestos.
+ PROGRAMADOR       : Juan Soto
+ FECHA             : Diciembre 4, 1996
+--------------------------------------------------------------------------
+}
+GLOBALS
+  "irprgb000.4gl"
+
+ DEFINE anular RECORD
+         cod_mov    SMALLINT,
+         num_doc    INTEGER,
+         fecha      DATE,
+         cod_sp     SMALLINT,
+         cod_sp_sec SMALLINT
+ END RECORD
+ DEFINE descrip_mov CHAR(30)
+ DEFINE opc1 CHAR(1)
+
+MAIN                
+ 
+   CALL ARG_VAL(1) RETURNING usuarios
+   CALL ARG_VAL(2) RETURNING clave
+   CALL ARG_VAL(3) RETURNING impresor
+   
+   CONNECT to "decomarmol" USER  usuarios USING clave
+   SELECT a.* INTO p_companias.* FROM companias a
+
+  CALL irprmt066()
+END MAIN
+
+FUNCTION irprmt066()
+  DEFINE fecha CHAR(8)
+  DEFINE hora CHAR(5),
+         chcodigo CHAR(100)
+         
+  OPTIONS
+  ERROR LINE 24,
+  FORM LINE 4,
+  COMMENT LINE 22,
+  PROMPT LINE 23
+
+  
+  OPEN WINDOW anular AT 8,4 WITH FORM "irfmwd066" ATTRIBUTE (BORDER,FORM LINE
+  FIRST + 1,PROMPT LINE LAST)
+
+  INPUT BY NAME anular.cod_mov,anular.num_doc ATTRIBUTE (BOLD)
+  
+  AFTER FIELD cod_mov
+    IF anular.cod_mov is null THEN
+       LET numero_msg = 16
+       CALL msg(numero_msg)
+       NEXT FIELD cod_mov
+    END IF
+ 
+   SELECT a.descrip_mov  INTO descrip_mov FROM irtb00005 a
+   WHERE a.cod_mov = anular.cod_mov AND a.status_t IS NULL
+
+   IF STATUS = NOTFOUND THEN 
+      LET numero_msg = 3
+      CALL msg(numero_msg)
+      NEXT FIELD cod_mov
+   END IF
+
+   DISPLAY BY NAME descrip_mov
+
+ AFTER FIELD num_doc
+   IF anular.num_doc is null THEN
+      LET numero_msg = 16
+      CALL msg(numero_msg)
+      NEXT FIELD num_doc
+   END IF
+
+   SELECT UNIQUE a.num_doc FROM irtb00006 a
+   WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
+         a.status_t IS NULL 
+
+   IF status = notfound THEN
+      LET numero_msg = 3
+      CALL msg(numero_msg)
+      NEXT FIELD cod_mov
+   END IF
+
+   SELECT MAX(a.fecha),MAX(a.cod_sp),MAX(a.cod_sp_sec)
+   INTO anular.fecha,anular.cod_sp,anular.cod_sp_sec
+   FROM irtb00006 a 
+   WHERE a.cod_mov = anular.cod_mov AND a.num_doc = anular.num_doc AND
+         a.status_t IS NULL
+     
+   DISPLAY BY NAME anular.fecha,anular.cod_sp,anular.cod_sp_sec
+
+   LET p_fechas = anular.fecha USING "dd/mm/yyyy"
+   LET bandera = 0
+   CALL prd(p_fechas,usuarios) RETURNING bandera
+     IF bandera = 1 THEN
+        CALL fgl_winmessage("ERROR","NO PUEDE ANULAR DOCUMENTO, ESTA FUERA DE CORTE","STOP")
+        EXIT INPUT
+     END IF
+    
+ END INPUT  
+ 
+ IF int_flag THEN
+    LET numero_msg = 2
+    CALL msg(numero_msg)
+    LET int_flag = FALSE
+    CLOSE WINDOW anular 
+    RETURN
+ END IF
+
+ PROMPT "Quiere Proceder Anulacion de Este Dcto.  (S/N)? " FOR CHAR opc1
+ LET opc1 = upshift(opc1)
+
+ IF opc1 = "S" THEN
+    SELECT a.status_mov INTO status_m FROM irtb00005 a
+    WHERE a.cod_mov = anular.cod_mov
+
+    DECLARE busca CURSOR FOR
+      SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.cantidad_2 
+      FROM irtb00006 a
+      WHERE a.num_doc=anular.num_doc and 
+           a.cod_mov=anular.cod_mov 
+         #  a.fecha > "01012008"
+
+      LET decide = "N"
+      LET idx = 1
+    FOREACH busca INTO movi2[idx].cod_n,movi2[idx].cod_grupo,
+                       movi2[idx].cod_tipo,movi2[idx].cod_sec,
+                       movi2[idx].cantidad_2
+
+      IF status_m = "1" THEN
+         SELECT SUM(a.cantidad_2) INTO chequea.existe FROM irtb00006 a
+         WHERE a.cod_n = movi2[idx].cod_n and 
+               a.cod_grupo = movi2[idx].cod_grupo and
+               a.cod_tipo=movi2[idx].cod_tipo and 
+               a.cod_sec = movi2[idx].cod_sec and 
+               a.status_t is null
+        IF chequea.existe IS NULL THEN
+           LET chequea.existe = 0
+        END IF
+         LET chequea.existe = chequea.existe - movi2[idx].cantidad_2
+   
+         IF chequea.existe < 0 THEN
+            LET chcodigo = "SI ANULA ESTE DOCUMENTO ESTE CODIGO SERA NEGATIVO, ANULACION ABORTADA ",
+                           movi2[idx].cod_n," ",movi2[idx].cod_grupo," ",
+                           movi2[idx].cod_tipo," ",movi2[idx].cod_sec
+            CALL fgl_winmessage("ERROR",chcodigo,"stop")
+            LET bandera = 1               
+            EXIT FOREACH               
+         END IF  
+      END IF
+      LET idx = idx + 1
+    END FOREACH
+    IF bandera = 1 THEN
+       GOTO salir
+    END IF
+    UPDATE irtb00006 set status_t = "E",
+                         us_mod = SUSER_SNAME(),
+                         fech_mod = GETDATE()
+    WHERE cod_mov = anular.cod_mov AND 
+          num_doc = anular.num_doc 
+
+    LET numero_msg = 39
+    CALL msg(numero_msg)
+ END IF
+LABEL salir:
+CLOSE WINDOW anular
+END FUNCTION