jsoto/MBS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Commit inicial: fuentes MBS ERP (Genero 6) + .gitignore + docs/SETUP_PC_MBS.md

Browse Source
This commit is contained in:
jsoto
2026-08-18 20:59:52 -04:00
commit 454973e269
5978 changed files with 2664094 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
PROYECTOS/isdir/intb01.unl
+9368
View File
File diff suppressed because it is too large Load Diff
PROYECTOS/isdir/iscs.bat
+7
View File
@@ -0,0 +1,7 @@
fgl2p ismncs000.4gl
fgl2p msg.4gl
fgl2p seg000.4gl
fgl2p isprcs006.4gl
fgl2p -o ismncs000.42r ismncs000.42m isprcs006.42m msg.42m seg000.42m
PROYECTOS/isdir/isfm.bat
+19
View File
@@ -0,0 +1,19 @@
fglform isfmcs006.per
fglform isfmmt002.per
fglform isfmmt003.per
fglform isfmmt005.per
fglform isfmmt007.per
fglform isfmmt008.per
fglform isfmmt013.per
fglform isfmmt016.per
fglform isfmmt036.per
fglform isfmmt056.per
fglform isfmrp002.per
fglform isfmrp003.per
fglform isfmrp008.per
fglform isfmrp009.per
fglform isfmrp010.per
fglform isfmrp011.per
fglform isfmrp012.per
fglform isfmrp013.per
PROYECTOS/isdir/isfmcs006.per
+47
View File
@@ -0,0 +1,47 @@
database rayovac
screen size 24 by 80
{
Codigo Materia Prima :[a]-[b]-[c ]-[d ] [a1 ] [a2 ]
Bodega: [h ]
Fecha Inicial:[f1 ] Fecha Final:[f2 ]
\g------------------------------------------------------------------------------\g
C a n t i d a d
Fecha Documento Entrada Salida Balance
\g------------------------------------------------------------------------------\g
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
[d2 ][d1 ][d4 ] [d5 ] [d6 ]
}
tables
intb00001,
intb00002,
intb00006
attributes
a = intb00001.cod_n,autonext;
b = intb00001.cod_grupo,autonext;
c = intb00001.cod_tipo,autonext;
d = intb00001.cod_sec,autonext;
a1 = intb00001.descrip_esp,noentry;
a2 = intb00001.unidad_med,noentry;
h = intb00006.bodega,autonext;
f1 = formonly.fech_in type date,format = "dd/mm/yyyy";
f2 = formonly.fech_fi type date,format = "dd/mm/yyyy";
d1 = intb00006.num_doc;
d2 = formonly.fecha type date,format = "dd/mm/yyyy";
d4 = formonly.entrada;
d5 = formonly.salida;
d6 = formonly.balance;
instructions
screen record s_csmov[8] (num_doc,fecha,entrada,salida,balance)
delimiters " "
end
PROYECTOS/isdir/isfmmt002.4fd
+84
View File
@@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8" ?>
<ManagedForm databaseName="rayovac" fileVersion="31400" gstVersion="31408" name="ManagedForm" uid="{1b631a68-cf0a-41c4-bedb-7d4c416a7fa8}">
<AGSettings>
<DynamicProperties version="2"/>
</AGSettings>
<Record additionalTables="" joinLeft="" joinOperator="" joinRight="" name="Undefined" order="" uid="{0289e5ad-5c63-451f-85aa-54ea2e52d5a3}" where="">
<RecordField colName="cod_n" fieldIdRef="0" fieldType="TABLE_COLUMN" name="intb00002.cod_n" sqlTabName="intb00002" sqlType="SMALLINT" table_alias_name="" uid="{dbefe3ec-6fc5-4b23-8eda-c89276a268fe}"/>
<RecordField colName="cod_grupo" fieldIdRef="1" fieldType="TABLE_COLUMN" name="intb00002.cod_grupo" sqlTabName="intb00002" sqlType="SMALLINT" table_alias_name="" uid="{6c93a6c4-e3a3-42da-bde5-4c595302b4d9}"/>
<RecordField colName="cod_tipo" fieldIdRef="2" fieldType="TABLE_COLUMN" name="intb00002.cod_tipo" sqlTabName="intb00002" sqlType="SMALLINT" table_alias_name="" uid="{f7a00072-8c32-407d-8f9b-b6a11c95d4b0}"/>
<RecordField colName="cod_sec" fieldIdRef="3" fieldType="NON_DATABASE" name="cod_sec" sqlTabName="intb00002" sqlType="SMALLINT" table_alias_name="" uid="{53eaf2a2-7e09-4167-be81-8a1270d434cb}"/>
<RecordField colName="descrip1" fieldIdRef="15" name="descrip_esp" sqlTabName="formonly" table_alias_name="" uid="{5f792ed3-96eb-45d7-bd0f-632b049ed06a}"/>
<RecordField colName="medida" fieldIdRef="17" name="unidad_med" sqlTabName="formonly" table_alias_name="" uid="{60ce36b8-a1db-4996-83e3-b5fd0111476b}"/>
<RecordField colName="pto_reorden" fieldIdRef="4" fieldType="TABLE_COLUMN" name="intb00002.pto_reorden" precisionDecimal="10" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" table_alias_name="" uid="{ce8c2660-4c23-4f5e-b0bf-18549ab2b3f5}"/>
<RecordField colName="existencia" fieldIdRef="5" fieldType="TABLE_COLUMN" name="intb00002.existencia" precisionDecimal="10" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" table_alias_name="" uid="{49ccdccc-d149-49f2-a3cd-cd7fe9202795}"/>
<RecordField colName="cod_nab" fieldIdRef="6" fieldType="TABLE_COLUMN" name="intb00002.cod_nab" sqlTabName="intb00002" sqlType="CHAR" table_alias_name="" uid="{9b75d0e9-e3f5-42d0-8321-d4027febfa58}"/>
<RecordField colName="base" defaultValue="1" fieldIdRef="19" fieldType="TABLE_COLUMN" name="intb00002.base" precisionDecimal="10" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" table_alias_name="" uid="{2a457f46-6bbd-4819-9815-16885c5d6264}"/>
<RecordField colName="bodega" fieldIdRef="7" fieldType="TABLE_COLUMN" name="intb00002.bodega" sqlTabName="intb00002" sqlType="SMALLINT" table_alias_name="" uid="{628cf333-5c37-47fa-b1a9-c0557f000d08}"/>
<RecordField colName="categoria" defaultValue="A" fieldIdRef="8" fieldType="TABLE_COLUMN" name="intb00002.categoria" sqlTabName="intb00002" sqlType="CHAR" table_alias_name="" uid="{3dc8cfe2-919f-43b6-bfc2-45f72fb38473}"/>
<RecordField colName="dia_llegada" fieldIdRef="9" fieldType="TABLE_COLUMN" name="intb00002.dia_llegada" sqlTabName="intb00002" sqlType="SMALLINT" table_alias_name="" uid="{ec677a53-51b0-472c-a732-4439dda1e1aa}"/>
<RecordField colName="gravamen" fieldIdRef="10" fieldType="TABLE_COLUMN" name="intb00002.gravamen" precisionDecimal="5" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" table_alias_name="" uid="{b5aa98f0-be83-4cec-93da-0689a69f2ed5}"/>
<RecordField colName="status_t" fieldIdRef="18" fieldType="TABLE_COLUMN" name="intb00002.status_t" sqlTabName="intb00002" sqlType="CHAR" table_alias_name="" uid="{72f20235-1e34-4421-97bc-3b52284e3f01}"/>
<RecordField colName="us_crea" fieldIdRef="11" fieldType="TABLE_COLUMN" name="intb00002.us_crea" sqlTabName="intb00002" sqlType="CHAR" table_alias_name="" uid="{80c6cabd-750d-4899-bd12-67e3e69c2999}"/>
<RecordField colName="us_mod" fieldIdRef="13" fieldType="TABLE_COLUMN" name="intb00002.us_mod" sqlTabName="intb00002" sqlType="CHAR" table_alias_name="" uid="{4de698eb-1f3d-4057-b453-ba6ad26ae4b2}"/>
<RecordField colName="fech_crea" fieldIdRef="12" fieldType="TABLE_COLUMN" name="intb00002.fech_crea" qual1="YEAR" qualFraction="MINUTE" sqlTabName="intb00002" sqlType="DATETIME" table_alias_name="" uid="{6d7c8ff6-0105-43a4-aec9-d343d70e5d0f}"/>
<RecordField colName="fech_mod" fieldIdRef="14" fieldType="TABLE_COLUMN" name="intb00002.fech_mod" qual1="YEAR" qualFraction="MINUTE" sqlTabName="intb00002" sqlType="DATETIME" table_alias_name="" uid="{4ce95fa7-2faf-4ab0-9dbd-11655a8a0e41}"/>
<RecordField colName="" fieldIdRef="20" name="rowid" sqlTabName="" table_alias_name="" uid="{53ccc4a3-2270-41c0-b84e-38aaceed5f43}"/>
</Record>
<Form gridHeight="24" gridWidth="80" name="isfmmt002" text="SUMINISTROS">
<Grid gridHeight="17" gridWidth="78" name="Grid1" posX="0" posY="1">
<Label posX="4" posY="0" text="Codigo"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" autoNext="true" colName="cod_n" comment="Digite el codigo de la materia prima" fieldId="0" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="3" name="intb00002.cod_n" notNull="true" posX="16" posY="0" required="true" sqlTabName="intb00002" sqlType="SMALLINT" tabIndex="1" table_alias_name="" widget="Edit"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" autoNext="true" colName="cod_grupo" comment="Digite el codigo de la materia prima" fieldId="1" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="3" name="intb00002.cod_grupo" notNull="true" posX="20" posY="0" required="true" sqlTabName="intb00002" sqlType="SMALLINT" tabIndex="2" table_alias_name="" widget="Edit"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" autoNext="true" colName="cod_tipo" comment="Digite el codigo de la materia prima" fieldId="2" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="3" name="intb00002.cod_tipo" notNull="true" posX="24" posY="0" required="true" sqlTabName="intb00002" sqlType="SMALLINT" tabIndex="3" table_alias_name="" widget="Edit"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" autoNext="false" colName="cod_sec" comment="Digite el codigo de la materia prima" fieldId="3" fieldType="NON_DATABASE" gridHeight="1" gridWidth="4" length="1" name="cod_sec" notNull="false" posX="28" posY="0" required="false" sqlTabName="intb00002" sqlType="SMALLINT" tabIndex="4" table_alias_name="" widget="Edit"/>
<Label gridHeight="1" gridWidth="10" name="Label1" posX="38" posY="0" text="ID"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="" fieldId="20" gridHeight="1" gridWidth="8" name="rowid" noEntry="true" posX="51" posY="0" sqlTabName="" tabIndex="20" table_alias_name="" title="Edit1" widget="Edit"/>
<Label posX="1" posY="2" text="Descripcion Espanol"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" case="upper" colName="descrip1" fieldId="15" gridHeight="1" gridWidth="46" name="descrip_esp" posX="22" posY="2" scroll="true" sqlTabName="formonly" tabIndex="5" table_alias_name="" widget="Edit"/>
<Label posX="1" posY="4" text="Unidad Medida"/>
<ComboBox aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" case="upper" colName="medida" fieldId="17" gridHeight="1" gridWidth="12" items="UD, MT2, GLS, LBR, PLG, MT3, 1/4 GL" name="unidad_med" posX="22" posY="4" sqlTabName="formonly" tabIndex="6" table_alias_name="" widget="ComboBox">
<Item lstrtext="false" name="UD" text="UD"/>
<Item lstrtext="false" name="MT2" text="MT2"/>
<Item lstrtext="false" name="GLS" text="GLS"/>
<Item lstrtext="false" name="LBR" text="LBR"/>
<Item lstrtext="false" name="PLG" text="PLG"/>
<Item lstrtext="false" name="MT3" text="MT3"/>
<Item lstrtext="false" name="1/4 GL" text="1/4 GL"/>
</ComboBox>
<Label posX="1" posY="5" text="Punto de reorden"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="pto_reorden" comment="Digite el punto de reorden" fieldId="4" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="12" name="intb00002.pto_reorden" notNull="true" posX="22" posY="5" precisionDecimal="10" required="true" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" tabIndex="7" table_alias_name="" widget="Edit"/>
<Label posX="1" posY="6" text="Existencia"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="existencia" comment="Digite la existencia actual" fieldId="5" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="12" name="intb00002.existencia" notNull="true" posX="22" posY="6" precisionDecimal="10" required="true" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" tabIndex="8" table_alias_name="" widget="Edit"/>
<Label gridHeight="1" gridWidth="20" name="Label2" posX="1" posY="7" text="Nomenclatura Arancelaria"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="cod_nab" comment="Digite el codigo arancelario" fieldId="6" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="11" name="intb00002.cod_nab" picture="##.##.##.##" posX="22" posY="7" sqlTabName="intb00002" sqlType="CHAR" tabIndex="9" table_alias_name="" widget="Edit"/>
<Label posX="41" posY="7" text="Base Para Precio"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" autoNext="true" colName="base" comment="Digite La Cantidad de la base para calculo de su precio" defaultValue="1" fieldId="19" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="13" name="intb00002.base" posX="59" posY="7" precisionDecimal="10" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" tabIndex="10" table_alias_name="" widget="Edit"/>
<Label posX="1" posY="8" text="Bodega"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="bodega" comment="Digite la bodega" fieldId="7" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="4" name="intb00002.bodega" posX="22" posY="8" sqlTabName="intb00002" sqlType="SMALLINT" tabIndex="11" table_alias_name="" widget="Edit"/>
<Label posX="32" posY="8" text="Categoria"/>
<ComboBox aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" case="upper" colName="categoria" comment="Digite A,B,C" defaultValue="A" fieldId="8" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="6" items="A, B, C" name="intb00002.categoria" posX="45" posY="8" sqlTabName="intb00002" sqlType="CHAR" tabIndex="12" table_alias_name="" widget="ComboBox">
<Item lstrtext="false" name="A" text="A"/>
<Item lstrtext="false" name="B" text="B"/>
<Item lstrtext="false" name="C" text="C"/>
</ComboBox>
<Label posX="1" posY="9" text="Dia de Llegada"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="dia_llegada" comment="Digite el dia de llegada de la materia prima" fieldId="9" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="3" name="intb00002.dia_llegada" posX="22" posY="9" sqlTabName="intb00002" sqlType="SMALLINT" tabIndex="13" table_alias_name="" widget="Edit"/>
<Label posX="33" posY="9" text="Gravamen"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" autoNext="true" colName="gravamen" comment="Digite El Porcentaje de Gravamen" fieldId="10" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="6" name="intb00002.gravamen" posX="45" posY="9" precisionDecimal="5" scaleDecimal="2" sqlTabName="intb00002" sqlType="DECIMAL" tabIndex="14" table_alias_name="" widget="Edit"/>
<Label posX="52" posY="9" text="%"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="status_t" fieldId="18" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="1" name="intb00002.status_t" noEntry="true" posX="2" posY="10" sqlTabName="intb00002" sqlType="CHAR" tabIndex="15" table_alias_name="" widget="Edit"/>
<Label posX="1" posY="11" text="Usuario creador"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="us_crea" fieldId="11" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="16" name="intb00002.us_crea" noEntry="true" posX="19" posY="11" sqlTabName="intb00002" sqlType="CHAR" tabIndex="16" table_alias_name="" widget="Edit"/>
<Label posX="38" posY="11" text="Usuario modificador"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="us_mod" fieldId="13" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="16" name="intb00002.us_mod" noEntry="true" posX="60" posY="11" sqlTabName="intb00002" sqlType="CHAR" tabIndex="17" table_alias_name="" widget="Edit"/>
<Label posX="1" posY="12" text="Fecha Creacion"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="fech_crea" fieldId="12" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="16" name="intb00002.fech_crea" noEntry="true" posX="19" posY="12" qual1="YEAR" qualFraction="MINUTE" sqlTabName="intb00002" sqlType="DATETIME" tabIndex="18" table_alias_name="" widget="Edit"/>
<Label posX="38" posY="12" text="Fecha Modificacion"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="fech_mod" fieldId="14" fieldType="TABLE_COLUMN" gridHeight="1" gridWidth="16" name="intb00002.fech_mod" noEntry="true" posX="60" posY="12" qual1="YEAR" qualFraction="MINUTE" sqlTabName="intb00002" sqlType="DATETIME" tabIndex="19" table_alias_name="" widget="Edit"/>
</Grid>
</Form>
<DiagramLayout>
<![CDATA[AAAAAgAAAEwAewAwADIAOAA5AGUANQBhAGQALQA1AGMANgAzAC0ANAA1ADEAZgAtADgANQBhAGEALQA1ADQAZQBhADIAZQA1ADIAZAA1AGEAMwB9AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQ==]]>
</DiagramLayout>
</ManagedForm>
PROYECTOS/isdir/isfmmt002.per
+56
View File
@@ -0,0 +1,56 @@
database rayovac
screen size 24 by 80
{
Codigo [a][b][c ][e ]
Descripcion Espanol [d ]
Descripcion Ingles [f ]
Unidad Medida [k ]
Punto de reorden [f004 ]
Existencia [f005 ]
Nomenclatura Arancelaria [f006 ] Base Para Precio [k1 ]
Bodega [l ] Categoria [r]
Dia de Llegada [m ] Gravamen [mn ]%
[q]
Usuario creador [f007 ] Usuario modificador [f009 ]
Fecha Creacion [f008 ] Fecha Modificacion [f010 ]
}
end
tables
intb00002
attributes
a = intb00002.cod_n, autonext,
comments = "Digite el codigo de la materia prima";
b = intb00002.cod_grupo, autonext,
comments = "Digite el codigo de la materia prima";
c = intb00002.cod_tipo, autonext,
comments = "Digite el codigo de la materia prima";
e = intb00002.cod_sec,autonext,
comments = "Digite el codigo de la materia prima";
f004 = intb00002.pto_reorden,
comments = "Digite el punto de reorden";
f005 = intb00002.existencia,
comments = "Digite la existencia actual";
f006 = intb00002.cod_nab, picture = "##.##.##.##",
comments = "Digite el codigo arancelario";
l = intb00002.bodega,
comments ="Digite la bodega";
r = intb00002.categoria,comments = "Digite A,B,C",
upshift;
m = intb00002.dia_llegada,
comments = "Digite el dia de llegada de la materia prima";
mn = intb00002.gravamen,autonext,
comments = "Digite El Porcentaje de Gravamen";
f007 = intb00002.us_crea, noentry;
f008 = intb00002.fech_crea, noentry;
f009 = intb00002.us_mod, noentry;
f010 = intb00002.fech_mod, noentry;
d = formonly.descrip1,upshift;
f = formonly.descrip2,upshift;
k = formonly.medida,upshift;
q = intb00002.status_t,noentry;
k1 = intb00002.base,autonext,comments =
"Digite La Cantidad de la base para calculo de su precio";
instructions
delimiters " "
end
PROYECTOS/isdir/isfmmt003.per
+39
View File
@@ -0,0 +1,39 @@
database rayovac
screen size 24 by 80
{
Mes Inicial [f1] [g4 ]
Mes Final [f2] [g5 ]
Ano [f002]
Codigo [a]-[b]-[c ]-[d ][e ] [g ]
Costo Estandar [f005 ]
[j]
Usuario Creador [f006 ] Usuario Modificador [f008 ]
Fecha Creacion [f007 ] Fecha Modificacion [f009 ]
}
end
tables
istb00013,intb00001
attributes
f1 = istb00013.mes_ini,autonext,
comments = "Digite el mes inicial";
g4 = formonly.descrip1;
f2 = istb00013.mes_fin,autonext,
comments = "Digite el mes final";
g5 = formonly.descrip2;
f002 = istb00013.ano,autonext,comments = "Digite el ano";
a = istb00013.cod_n,autonext,comments = "Digite el NIVEL";
b = istb00013.cod_grupo,autonext,comments = "Digite el GRUPO";
c = istb00013.cod_tipo,autonext,comments = "Digite el TIPO";
d = istb00013.cod_sec,autonext,comments = "Digite la SECUENCIA";
e = intb00001.descrip_esp,noentry;
g = intb00001.unidad_med,noentry;
f005 = istb00013.costo_st,comments = "Digite el costo";
j = istb00013.status_t,noentry;
f006 = istb00013.us_crea,noentry;
f007 = istb00013.fech_crea,noentry;
f008 = istb00013.us_mod,noentry;
f009 = istb00013.fech_mod,noentry;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmmt005.per
+35
View File
@@ -0,0 +1,35 @@
database rayovac
screen size 24 by 80
{
Codigo del movimiento [f0] Cuenta_1 [f002]
Descripcion [f001 ] Cuenta_2 [f003]
Status del movimiento [a] Cuenta_3 [f004]
[j]
Usuario creador [f005 ] Usuario modificador [f007 ]
Fecha creacion [f006 ] Fecha modificacion [f008 ]
}
end
tables
intb00005
attributes
f0 = intb00005.cod_mov, autonext, required,
comments = "Digite el codigo del movimiento";
f001 = intb00005.descrip_mov, autonext, upshift,
comments = "Digite la descripcion del movimiento";
a = intb00005.status_mov, required, autonext, include = ("1","2"),
comments = "1.- Entradas 2.- Salidas" ;
f002 = intb00005.cuenta_1, autonext, required,
comments = "Digite el numero de la cuenta";
f003 = intb00005.cuenta_2, autonext,required,
comments = "Digite el numero de la cuenta";
f004 = intb00005.cuenta_3, comments = "Digite el numero de la cuenta";
f005 = intb00005.us_crea, noentry;
f006 = intb00005.fech_crea, noentry;
f007 = intb00005.us_mod, noentry;
f008 = intb00005.fech_mod, noentry;
j = intb00005.status_t, noentry;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmmt007.per
+28
View File
@@ -0,0 +1,28 @@
database rayovac
screen size 24 by 80
{
Codigo de la Unidad [a0 ]
Descripcion [f000 ]
[j]
Usuario Creador [f001 ] Usuario Modificador [f003 ]
Fecha Creacion [f002 ] Fecha Modificacion [f004 ]
}
end
tables
intb00007
attributes
a0 = intb00007.codigo_unidad, upshift, autonext,
comments="Digite el codigo de la unidad de medida";
f000 = intb00007.descripcion, upshift,
comments="Digite el nombre de la unidad de medida";
f001 = intb00007.us_crea, noentry;
f002 = intb00007.fech_crea, noentry;
f003 = intb00007.us_mod, noentry;
f004 = intb00007.fech_mod, noentry;
j = intb00007.status_t, noentry;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmmt008.per
+48
View File
@@ -0,0 +1,48 @@
database rayovac
screen size 24 by 80
{
Fecha Del Conteo [f1 ]
Bodega [b1]
Codigo Suministro [a]-[b]-[c ]-[d ]
[k1 ][k2 ]
Conteo [f3 ] Existencia S/Movimientos [f4 ]
\g-------------------------------------------------------------
Diferencia [p1 ]
[b2][b3 ]
[k20 ]
}
tables
intb00001,
intb00006
intb00002
attributes
f1 = formonly.fecha type date,reverse,format = "dd/mm/yyyy",
comments = "Digite Fecha Del Conteo Fisico";
a = intb00001.cod_n,reverse,autonext,required,
comments = "Digite NIVEL Codificacion";
b = intb00001.cod_grupo,reverse,autonext,required,
comments = "Digite GRUPO Codificacion";
c = intb00001.cod_tipo,reverse,autonext,required,
comments = "Digite TIPO Codificacion";
d = intb00001.cod_sec,reverse,autonext,required,
comments = "Digite SECUENCIA Codificacion";
k1 = formonly.descrip_esp,noentry;
k2 = formonly.unidad_med,noentry;
b1 = intb00002.bodega,reverse,autonext,required,
comments = "Digite BODEGA Materia Prima";
f3 = formonly.cantidad,reverse,required,
comments = "Digite Cantidad Del Conteo Fisico";
f4 = formonly.ex_mov,noentry;
b2 = formonly.cod_mov,noentry;
b3 = formonly.descrip_mov,noentry;
p1 = formonly.diferencia,noentry;
k20 = formonly.num_doc;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmmt013.per
+37
View File
@@ -0,0 +1,37 @@
database rayovac
screen size 24 by 80
{
Mes Inicial [f1] [g4 ]
Mes Final [f2] [g5 ]
Ano [f002]
Codigo [a]-[b]-[c ]-[d ][e ] [g ]
Costo Estandar [f005 ]
[j]
Usuario Creador [f006 ] Usuario Modificador [f008 ]
Fecha Creacion [f007 ] Fecha Modificacion [f009 ]
}
end
tables
istb00013,intb00001
attributes
f1 = istb00013.mes_ini,autonext,comments = "Digite el mes inicial";
g4 = formonly.descrip1;
f2 = istb00013.mes_fin,autonext,comments = "Digite el mes final";
g5 = formonly.descrip2;
f002 = istb00013.ano,autonext,comments = "Digite el ano";
a = istb00013.cod_n,autonext,comments = "Digite el NIVEL";
b = istb00013.cod_grupo,autonext,comments = "Digite el GRUPO";
c = istb00013.cod_tipo,autonext,comments = "Digite el TIPO";
d = istb00013.cod_sec,autonext,comments = "Digite la SECUENCIA";
e = intb00001.descrip_esp,noentry;
g = intb00001.unidad_med,noentry;
f005 = istb00013.costo_st,comments = "Digite el costo";
j = istb00013.status_t,noentry;
f006 = istb00013.us_crea,noentry;
f007 = istb00013.fech_crea,noentry;
f008 = istb00013.us_mod,noentry;
f009 = istb00013.fech_mod,noentry;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmmt016.per
+53
View File
@@ -0,0 +1,53 @@
database rayovac
screen size 24 by 80
{
\gp---------------------------------------------------------------------------q\g
\g|\gDocumento Numero [f000 ] Orden de Compras [ti][l ] \g|\g
\g|\gFecha [f001 ] \g|\g
\g|\gSuplidor [p1][f013] [a1 ] Bodega: [p2] \g|\g
\gb---------------------------------------------------------------------------d\g
C A N T I D A D
Codigo Devuelta Ordenada Unidad D e s c r i p c i o n
\g------------------------------------------------------------------------------\g
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
\g------------------------------------------------------------------------------\g
}
end
tables
intb00006,
intb00001,
cotb00001
attributes
f000 = intb00006.num_doc,autonext,
comments = "Digite Numero Documento";
l = intb00006.orden_compra,autonext,
comments = "Digite El Numero De La Orden de Compras";
f001 = intb00006.fecha, format = "dd/mm/yyyy",autonext,
comments = "Digite Fecha Documento";
p2 = intb00006.bodega,autonext;
p1 = intb00006.cod_sp,noentry;
f013 = intb00006.cod_sp_sec,noentry;
ti = intb00006.tipo,autonext,include = ("01","02","03","04"),comments =
"Digite tipo 01-Generales 02-Rov-Ltd. 03-Locales 04-Miscelanas";
a = intb00006.cod_n,noentry;
b = intb00006.cod_grupo,noentry;
c = intb00006.cod_tipo,noentry;
d = intb00006.cod_sec,noentry;
f02 = intb00006.cantidad_1,autonext,
comments = "Digite La Cantidad Ordenada";
f03 = intb00006.cantidad_2,noentry;
k = intb00001.descrip_esp,noentry,autonext;
p = intb00001.unidad_med,noentry,autonext;
a1 = cotb00001.nom_sp,noentry;
INSTRUCTIONS
SCREEN RECORD s_movi1[6] (cod_n,cod_grupo,cod_tipo,cod_sec,cantidad_1,
cantidad_2,unidad_med,descrip_esp)
end
PROYECTOS/isdir/isfmmt036.per
+66
View File
@@ -0,0 +1,66 @@
{
----------------------------------------------------------------------
FORMULARIO : ISFMMT036
OBJETIVO : Captura Documento Movimiento: REQUISICION DE MATERIALES
de Inventario de Suministro (INPRMT036).
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Octubre 21, 1992.
----------------------------------------------------------------------
}
database rayovac
screen size 24 by 80
{
\gp---------------------------------------------------------------------------q\g
\g|\g Codigo Movimiento [p1][ak ]
\g|\g Documento Numero [f000 ] Fecha [f001 ] \g|\g
\g|\g Codigo de Dpto. [f4 ] [a1 ] \g|\g
\g|\g Bodega :[a7] \g|\g
\gb---------------------------------------------------------------------------d\g
C A N T I D A D
Codigo Ordenada Entregada Unidad D e s c r i p c i o n
\g-----------------------------------------------------------------------------\g
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
[a][b][c ][d ][f02 ][f03 ][p ][k ]
\g-----------------------------------------------------------------------------\g
}
end
tables
intb00001,
intb00002,
intb00006,
adtb00001
attributes
p1 = formonly.cod_mov,comments="Digite Codigo Movimiento";
ak = formonly.descrip_mov,noentry;
f000 = intb00006.num_doc,autonext,
comments = "Digite Numero Documento";
f001 = intb00006.fecha, format = "dd/mm/yyyy",autonext,
comments = "Digite Fecha Documento";
f4 = intb00006.depto_a,autonext,
comments = "Digite Codigo Departamento";
a1 = adtb00001.nom_dpto,noentry;
a = intb00006.cod_n,autonext,
comments = "Digite Codigo Articulo";
b = intb00006.cod_grupo,autonext,
comments = "Digite Codigo Articulo";
c = intb00006.cod_tipo,autonext,
comments = "Digite Codigo Articulo";
d = intb00006.cod_sec,autonext,
comments = "Digite Codigo Articulo";
f02 = intb00006.cantidad_1,autonext,
comments = "Digite La Cantidad Ordenada";
f03 = intb00006.cantidad_2,autonext,
comments = "Digite La Cantidad Entregada";
a7 = intb00006.bodega,autonext,
comments = "Digite el codigo de la bodega de almacenamiento";
k = intb00001.descrip_esp,noentry,autonext;
p = intb00001.unidad_med,noentry;
INSTRUCTIONS
SCREEN RECORD s_movi1[6] (cod_n,cod_grupo,cod_tipo,cod_sec,cantidad_1,
cantidad_2,unidad_med,descrip_esp)
end
PROYECTOS/isdir/isfmmt056.per
+75
View File
@@ -0,0 +1,75 @@
{
----------------------------------------------------------------------------
FORMULARIO : ISFMMT056
OBJETIVO : Capturar registros de los Movimientos de Suministro
PROGRAMA Q. UTILIZA (ISPRMT056).
PROGRAMADOR : Ing. Juan Soto(Johnny)
FECHA REALIZACION : Octubre 21, 1993.
----------------------------------------------------------------------------
}
database rayovac
screen size 24 by 80
{
Movimiento:[t ][t1 ] Doc. No. [f00 ]
\gp-------------------------------------------------------------------------q\g
\g|\gFecha [f05 ] Conduce no.[f03 ] \g|\g
\g|\gFactura No.[f04 ] Orden Compra:[ti][f02 ] \g|\g
\g|\gSuplidor:[p1]-[f01 ][a ] \g|\g
\g|\gDepartamento De[f8 ] [p5 ] \g|\g
\g|\gBodega:[k ] \g|\g
\gb-------------------------------------------------------------------------d\g
C A N T I D A D
Codigo Ordenada Recibida/ Unidad D e s c r i p c i o n
Ordenada
\g------------------------------------------------------------------------------\g
[b][c][d ][f ][f06 ][f07 ][f08][g ]
[b][c][d ][f ][f06 ][f07 ][f08][g ]
[b][c][d ][f ][f06 ][f07 ][f08][g ]
[b][c][d ][f ][f06 ][f07 ][f08][g ]
\g------------------------------------------------------------------------------\g
}
end
tables
intb00006,
cotb00001,
intb00001,
intb00005
attributes
f00 = intb00006.num_doc,
comments = "Digite el Numero Documento";
p1 = intb00006.cod_sp,noentry;
f01 = intb00006.cod_sp_sec,noentry;
f02 = intb00006.orden_compra,noentry;
f03 = intb00006.conduce_no,autonext,
comments = "Digite el Numero del Conduce Del Suplidor, Si Tiene Conduce";
f04 = intb00006.fact_no,autonext,
comments = "Digite el Numero de la Factura del Suplidor";
f8 = intb00006.depto_de,autonext;
p5 = formonly.nom_dpto,noentry;
f05 = formonly.fecha type date,format = "dd/mm/yyyy",
comments = "Digite la Fecha Correspondiente al Documento";
f06 = intb00006.cantidad_1,
comments = "Digite la Cantidad Pedida ";
f07 = intb00006.cantidad_2,
comments = "Digite la Cantidad Llegada desde el Suplidor";
f08 = intb00001.unidad_med,noentry;
a = cotb00001.nom_sp,noentry;
b = intb00006.cod_n,autonext,comments =
"Para Borrar un codigo Presione Ctrl-B o Continue Consultando";
ti = intb00006.tipo,include = ("01","02","03","04"),
comments = "Digite 01-Generales 02-Rov-Ltd 03-Locales 04-Micelaneas";
c = intb00006.cod_grupo,autonext,comments =
"Para Borrar un codigo Presione Ctrl-B o Continue Consultando";
d = intb00006.cod_tipo,autonext,comments =
"Para Borrar un codigo Presione Ctrl-B o Continue Consultando";
f = intb00006.cod_sec,autonext,comments =
"Para Borrar un codigo Presione Ctrl-B o Continue Consultando";
g = intb00001.descrip_esp,noentry;
t = intb00006.cod_mov,autonext;
t1 = intb00005.descrip_mov,noentry;
k = intb00006.bodega,autonext;
INSTRUCTIONS
screen record s_movi1[4] (cod_n,cod_grupo,cod_tipo,cod_sec,cantidad_1,
cantidad_2,unidad_med,descrip_esp)
end
PROYECTOS/isdir/isfmrp002.per
+19
View File
@@ -0,0 +1,19 @@
database rayovac
screen size 24 by 80
{
Ordenamiento [k]
Codigo [a][b][c ][d ]
}
end
tables
intb00001
attributes
a = intb00001.cod_n;
b = intb00001.cod_grupo;
c = intb00001.cod_tipo;
d = intb00001.cod_sec;
k = formonly.decide type char,required,autonext,
comments = "Digite A - Alfabetico N - Numerico",
include = ("A","N"),upshift;
end
PROYECTOS/isdir/isfmrp003.per
+23
View File
@@ -0,0 +1,23 @@
database rayovac
screen size 24 by 80
{
Fecha Inicial [k ]
Fecha Final [p ]
Codigo [a]-[b]-[c ]-[d ]
}
end
tables
intb00006=intb00006
attributes
k = formonly.fech_in type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Inicial ";
p = formonly.fech_fi type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Final";
a = intb00006.cod_n,autonext;
b = intb00006.cod_grupo,autonext;
c = intb00006.cod_tipo,autonext;
d = intb00006.cod_sec,autonext;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmrp008.per
+16
View File
@@ -0,0 +1,16 @@
database rayovac
screen size 24 by 80
{
Ordenamiento [k]
Codigo Movimiento [a ]
}
end
tables
intb00005
attributes
a = intb00005.cod_mov;
k = formonly.decide type char,required,autonext,
comments = "Digite A - Alfabetico N - Numerico",
include = ("A","N"),upshift;
end
PROYECTOS/isdir/isfmrp009.per
+23
View File
@@ -0,0 +1,23 @@
database rayovac
screen size 24 by 80
{
Fecha Inicial [k ]
Fecha Final [p ]
Codigo [a]-[b]-[c ]-[d ]
}
end
tables
intb00001
attributes
k = formonly.fech_in type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Inicial ";
p = formonly.fech_fi type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Final";
a = intb00001.cod_n;
b = intb00001.cod_grupo;
c = intb00001.cod_tipo;
d = intb00001.cod_sec;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmrp010.per
+25
View File
@@ -0,0 +1,25 @@
database rayovac
screen size 24 by 80
{
Fecha Inicial [k ]
Fecha Final [p ]
Codigo Movimiento [g ]
Codigo [a]-[b]-[c ]-[d ]
}
end
tables
intb00006
attributes
k = formonly.fech_in type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Inicial ";
p = formonly.fech_fi type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Final";
g = intb00006.cod_mov;
a = intb00006.cod_n;
b = intb00006.cod_grupo;
c = intb00006.cod_tipo;
d = intb00006.cod_sec;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmrp011.per
+25
View File
@@ -0,0 +1,25 @@
database rayovac
screen size 24 by 80
{
Fecha Inicial [k ]
Fecha Final [p ]
Codigo Movimiento [g ]
Codigo [a]-[b]-[c ]-[d ]
}
end
tables
intb00006
attributes
k = formonly.fech_in type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Inicial ";
p = formonly.fech_fi type date,format = "dd/mm/yyyy",
comments = "Introduzca Fecha Final";
g = intb00006.cod_mov;
a = intb00006.cod_n;
b = intb00006.cod_grupo;
c = intb00006.cod_tipo;
d = intb00006.cod_sec;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmrp012.per
+17
View File
@@ -0,0 +1,17 @@
database rayovac
screen size 24 by 80
{
Codigo [a]-[b]-[c ]-[d ]
}
end
tables
intb00006
attributes
a = intb00006.cod_n;
b = intb00006.cod_grupo;
c = intb00006.cod_tipo;
d = intb00006.cod_sec;
instructions
delimiters " "
end
PROYECTOS/isdir/isfmrp013.per
+23
View File
@@ -0,0 +1,23 @@
database rayovac
screen size 24 by 80
{
Articulo [a][b][c ][d ]
Fecha Inicial [k ]
Fecha Final [p ]
}
end
tables
istb00006
attributes
a = istb00006.cod_n;
b = istb00006.cod_grupo;
c = istb00006.cod_tipo;
d = istb00006.cod_sec;
k = formonly.fecha_1 type datetime year to day,format = "yyyy-mm-dd", comments =
"Digite Fecha Inicial con el Sigte. Formato ANO-MES-DIA, EJ. 1994-12-01";
p = formonly.fecha_2 type datetime year to day,format = "yyyy-mm-dd", comments =
"Digite Fecha Final con el Sigte. Formato ANO-MES-DIA, EJ. 1994-12-31";
instructions
delimiters " "
end
PROYECTOS/isdir/ismn00000.4gl
+87
View File
@@ -0,0 +1,87 @@
{
-----------------------------------------------------------------------------
PROGRAMA : ISMN00000
OBJETIVO : Menu principal del Sistema
de Inventario de Suministro.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 21, 1993.
-----------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA REALIZACION : Marzo 27, 1999.
OBJETIVO : Utilizar COMMAND para los menues de este sistema.
Optimizar el procedimiento de llamadas de programas.
---------------------------------------------------------------------------
}
GLOBALS
"isprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL opciones_ismn00000()
END MAIN
FUNCTION opciones_ismn00000()
DEFINE opt CHAR(2)
DEFINE p_user CHAR(9)
DEFINE luz CHAR(5)
OPTIONS
PROMPT LINE 8,
ERROR LINE 24
CALL desplega_mn00000()
MENU "Principal: "
COMMAND "1"
CALL seg000(1,"ismn00000") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\ismnmt000"
CALL desplega_mn00000()
END IF
COMMAND "2"
CALL seg000(2,"ismn00000") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\ismncs000"
CALL desplega_mn00000()
END IF
COMMAND "3"
CALL seg000(3,"ismn00000") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\ismnrp000"
CALL desplega_mn00000()
END IF
COMMAND KEY("R") "Retornar" "Retorna Menu Principal"
EXIT MENU
END MENU
END FUNCTION
FUNCTION pantalla()
DEFINE fecha CHAR(10),
hora char(5)
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A" AT 4,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 4,68 ATTRIBUTE (RED)
DISPLAY "Sistema Inventario de Suministros" AT 5,23 ATTRIBUTE(BLACK)
DISPLAY hora AT 6,73 ATTRIBUTE(RED)
CALL fgl_drawbox(5,79,3,1)
CALL fgl_drawbox(1,79,22,1)
END FUNCTION
FUNCTION desplega_mn00000()
CLEAR SCREEN
CALL pantalla()
DISPLAY "Menu Principal" AT 6,33 ATTRIBUTE(BLACK)
DISPLAY "ismn00000" AT 4,3 ATTRIBUTE(RED)
DISPLAY "1- Mantenimientos ismnmt000" AT 10,1
DISPLAY "2- Consultas ismncs000" AT 11,1
DISPLAY "3- Reportes ismnrp000" AT 12,1
# DISPLAY "R- Retorna Menu Anterior" AT 14,1 ATTRIBUTE (BLACK)
END FUNCTION
PROYECTOS/isdir/ismncs000.4gl
+87
View File
@@ -0,0 +1,87 @@
{
----------------------------------------------------------------------------
PROGRAMA : ISMNCS00
OBJETIVO : Menu de Consultas del Sistema de
Inventario de Suministro.
PROGRAMADOR : Ing. Juan Soto.
FECHA REALIZACION : Octubre 29, 1993.
----------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA REALIZACION : Marzo 27, 1999.
OBJETIVO : Utilizar COMMAND para los menues de este sistema.
Optimizar el procedimiento de llamadas de programas.
---------------------------------------------------------------------------
}
DATABASE rayovac
GLOBALS
DEFINE bandera,numero_msg SMALLINT
END GLOBALS
MAIN
CLEAR SCREEN
DEFER INTERRUPT
CALL opciones_ismncs000()
END MAIN
FUNCTION opciones_ismncs000()
DEFINE opt CHAR(2)
DEFINE p_user CHAR(9)
DEFINE luz CHAR(5)
OPTIONS
PROMPT LINE 8,
ERROR LINE 24
CALL desplega_mncs000()
MENU "Consultas: "
COMMAND "1"
CALL seg000(1,"ismncs000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprcs006()"
CALL isprcs006()
CALL desplega_mncs000()
END IF
COMMAND KEY("R") "Retornar" "Retorna Menu Principal"
EXIT MENU
END MENU
END FUNCTION
FUNCTION integridad()
IF sqlca.sqlcode < 0 THEN
LET numero_msg = sqlca.sqlcode
CALL msg(numero_msg)
DISPLAY numero_msg AT 23,70
LET bandera = 1
SLEEP 2
RETURN
END IF
END FUNCTION
FUNCTION pantalla()
DEFINE fecha CHAR(10),
hora char(5)
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A" AT 4,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 4,68 ATTRIBUTE (RED)
DISPLAY "Sistema Inventario de Suministros" AT 5,23 ATTRIBUTE(BLACK)
DISPLAY hora AT 6,73 ATTRIBUTE(RED)
CALL fgl_drawbox(5,79,3,1)
CALL fgl_drawbox(1,79,22,1)
END FUNCTION
FUNCTION desplega_mncs000()
CLEAR SCREEN
CALL pantalla()
DISPLAY "Consultas" AT 6,35 ATTRIBUTE(BLACK)
DISPLAY "ismncs000" AT 4,3 ATTRIBUTE(RED)
DISPLAY "1- Balance Suministro isprcs006" AT 10,1
# DISPLAY "R- Retorna Menu Anterior" AT 15,1
# ATTRIBUTE (BLACK)
END FUNCTION
PROYECTOS/isdir/ismnmt000.4gl
+193
View File
@@ -0,0 +1,193 @@
{
---------------------------------------------------------------------------
PROGRAMA : ISMNMT00
OBJETIVO : Menu de Mantenimientos del Sistema
de Inventario de Suministros.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 21, 1993.
---------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA REALIZACION : Marzo 27, 1999.
OBJETIVO : Utilizar COMMAND para los menues de este sistema.
Optimizar el procedimiento de llamadas de programas.
---------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
MAIN
CLEAR SCREEN
DEFER INTERRUPT
CALL opciones_ismnmt000()
END MAIN
FUNCTION opciones_ismnmt000()
DEFINE opt CHAR(2)
DEFINE p_user CHAR(9)
DEFINE luz CHAR(5)
OPTIONS
PROMPT LINE 8,
ERROR LINE 24
CALL desplega_mnmt000()
MENU "Mantenimientos: "
COMMAND "1"
CALL seg000(1,"ismnmt000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprmt002()"
CALL isprmt002()
CALL desplega_mnmt000()
END IF
COMMAND "2"
CALL seg000(2,"ismnmt000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprmt005()"
CALL isprmt005()
CALL desplega_mnmt000()
END IF
COMMAND "3"
CALL seg000(3,"ismnmt000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprmt036()"
CALL isprmt036()
CALL desplega_mnmt000()
END IF
COMMAND "4"
CALL seg000(4,"ismnmt000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprmt007()"
CALL isprmt007()
CALL desplega_mnmt000()
END IF
COMMAND "5"
CALL seg000(5,"ismnmt000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprmt008()"
CALL isprmt008()
CALL desplega_mnmt000()
END IF
COMMAND "6"
CALL seg000(6,"ismnmt000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprmt003()"
CALL isprmt003()
CALL desplega_mnmt000()
END IF
COMMAND KEY("R") "Retornar" "Retorna Menu Principal"
EXIT MENU
END MENU
END FUNCTION
FUNCTION integridad()
DEFINE bandera,numero_msg INTEGER
IF sqlca.sqlcode < 0 THEN
LET numero_msg = sqlca.sqlcode
CALL msg(numero_msg)
DISPLAY numero_msg AT 23,70
LET bandera = 1
SLEEP 2
RETURN
END IF
END FUNCTION
FUNCTION pantalla()
DEFINE fecha CHAR(10),
hora char(5)
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A" AT 4,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 4,68 ATTRIBUTE (RED)
DISPLAY "Sistema Inventario de Suministros" AT 5,23 ATTRIBUTE(BLACK)
DISPLAY hora AT 6,73 ATTRIBUTE(RED)
CALL fgl_drawbox(5,79,3,1)
CALL fgl_drawbox(1,79,22,1)
END FUNCTION
FUNCTION prd()
DEFINE otrab SMALLINT
#DEFINE numero_msg INTEGER
#DEFINE p_fechas DATE
DEFINE comp_fech,comp_fech1 DATE
DEFINE mes_control CHAR(2)
DEFINE mes_calc,dia SMALLINT
DEFINE fecha_c DATE
DEFINE c_ano,a_ano CHAR(4)
DEFINE usuario1 CHAR(9)
LET a_ano = year(today)
LET mes_control = MONTH(today)
LET mes_calc = mes_control
IF mes_calc = 01 THEN
LET mes_calc = 13
LET a_ano = year(today - 32)
END IF
#Aqui la funcion se posicionaba en dos meses para el control del documento
#LET mes_calc = mes_calc - 2
IF mes_calc <= 0 THEN
LET mes_calc = 12
LET a_ano = year(today) - 1
END IF
LET c_ano = year(today)
SELECT MIN(fecha_corte) INTO fecha_c FROM prdtable
WHERE fecha_corte >= p_fechas
IF STATUS = NOTFOUND THEN
LET numero_msg = 57
CALL msg(numero_msg)
LET bandera = 1
END IF
LET dia = 0
SELECT MIN(dias_gracia) INTO dia FROM prdtable
WHERE fecha_corte = fecha_c
IF dia IS NULL THEN
LET dia = 0
END IF
SELECT UNIQUE a.usuario FROM seg0003 a
WHERE a.usuario = USER
IF STATUS != NOTFOUND THEN
LET fecha_c = fecha_c + dia
END IF
LET comp_fech = fecha_c
LET comp_fech1 = TODAY
IF comp_fech < comp_fech1 THEN
LET numero_msg = 57
CALL msg(numero_msg)
LET bandera = 1
END IF
END FUNCTION
FUNCTION desplega_mnmt000()
CLEAR SCREEN
CALL pantalla()
DISPLAY "Mantenimientos" AT 6,33 ATTRIBUTE(BLACK)
DISPLAY "ismnmt00" AT 4,3 ATTRIBUTE(RED)
DISPLAY " 1- Catalogo Suministros isprmt002" AT 10,1
DISPLAY " 2- Tipos de Movimientos isprmt005" AT 11,1
DISPLAY " 3- Movimientos de Almacen isprmt036" AT 12,1
DISPLAY " 4- Unidades de Medida isprmt007" AT 13,1
DISPLAY " 5- Conteo Fisico y Ajustes isprmt008" AT 14,1
DISPLAY " 6- Costos Standares isprmt003" AT 15,1
# DISPLAY " R- Retorna Menu Anterior " AT 20,1
# ATTRIBUTE(BLACK)
END FUNCTION
PROYECTOS/isdir/ismnmt006.4gl
+72
View File
@@ -0,0 +1,72 @@
{
----------------------------------------------------------------------------
PROGRAMA : ISMNMT06
OBJETIVO : Sub Menu Mantenimiento Movimientos
Inventario de Suministro.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 22, 1993.
----------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA REALIZACION : Marzo 19, 1999.
OBJETIVO : Utilizar COMMAND para los menues de este sistema.
Optimizar el procedimiento de llamadas de programas.
---------------------------------------------------------------------------
}
DATABASE rayovac
DEFINE bandera,numero_msg INTEGER
FUNCTION ismnmt06()
CLEAR SCREEN
CALL opciones_ismnmt006()
END FUNCTION
FUNCTION opciones_ismnmt006()
DEFINE opt CHAR(2)
DEFINE p_user CHAR(9)
DEFINE luz CHAR(5)
OPTIONS
PROMPT LINE 8,
ERROR LINE 24
CALL desplega_mnmt006()
MENU "Mantenimientos: "
COMMAND "1"
CALL seg000(1,"ismnmt006") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\isprmt016()"
CALL desplega_mnmt006()
END IF
COMMAND "2"
CALL seg000(2,"ismnmt006") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\isprmt036()"
CALL desplega_mnmt006()
END IF
COMMAND "3"
CALL seg000(3,"ismnmt006") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\isprmt056()"
CALL desplega_mnmt006()
END IF
COMMAND KEY("R") "Retornar" "Retorna Menu Principal"
EXIT MENU
END MENU
END FUNCTION
FUNCTION desplega_mnmt006()
CLEAR SCREEN
CALL pantalla()
DISPLAY " Movimientos De Almacen " AT 6,22 ATTRIBUTE(BLACK)
DISPLAY "ismnmt006" AT 4,3 ATTRIBUTE(RED)
DISPLAY "1- Suministros Devueltos al Suplidor isprmt016" AT 10,1
DISPLAY "2- Requisicion Suministros isprmt036" AT 11,1
DISPLAY "3- Actualizacion de Documentos isprmt056" AT 12,1
# DISPLAY "R- Retornar Menu Anterior " AT 15,1
# ATTRIBUTE (BLACK)
END FUNCTION
PROYECTOS/isdir/ismnrp000.4gl
+157
View File
@@ -0,0 +1,157 @@
{
--------------------------------------------------------------------------
PROGRAMA : ISMNRP000
OBJETIVO : Menu de Reportes del Sistema
de Inventario de Suministro
PROGRAMADOR : Juan Soto
FECHA REALIZACION : Octubre 27, 1993.
--------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA REALIZACION : Marzo 27, 1999.
OBJETIVO : Utilizar COMMAND para los menues de este sistema.
Optimizar el procedimiento de llamadas de programas.
---------------------------------------------------------------------------
}
DATABASE rayovac
GLOBALS "isprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL opciones_ismnrp000()
END MAIN
FUNCTION opciones_ismnrp000()
DEFINE opt CHAR(2)
DEFINE p_user CHAR(9)
DEFINE luz CHAR(5)
OPTIONS
PROMPT LINE 8,
ERROR LINE 24
CALL desplega_mnrp000()
MENU "Reportes: "
COMMAND "1"
CALL seg000(1,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp001()"
#CALL isprrp001()
CALL desplega_mnrp000()
END IF
COMMAND "2"
CALL seg000(2,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp002()"
CALL isprrp002()
CALL desplega_mnrp000()
END IF
COMMAND "3"
CALL seg000(3,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp003()"
CALL isprrp003()
CALL desplega_mnrp000()
END IF
COMMAND "4"
CALL seg000(4,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp008()"
CALL isprrp008()
CALL desplega_mnrp000()
END IF
COMMAND "5"
CALL seg000(5,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp009()"
CALL isprrp009()
CALL desplega_mnrp000()
END IF
COMMAND "6"
CALL seg000(6,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp010()"
CALL isprrp010()
CALL desplega_mnrp000()
END IF
COMMAND "7"
CALL seg000(7,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp011()"
CALL isprrp011()
CALL desplega_mnrp000()
END IF
COMMAND "8"
CALL seg000(8,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp012()"
CALL isprrp012()
CALL desplega_mnrp000()
END IF
COMMAND "9"
CALL seg000(9,"ismnrp000") RETURNING luz
IF luz = "azul" THEN
#RUN "fglrun %FGLPROG%\\isprrp013()"
CALL isprrp013()
CALL desplega_mnrp000()
END IF
COMMAND KEY("R") "Retornar" "Retorna Menu Principal"
EXIT MENU
END MENU
END FUNCTION
FUNCTION pantalla()
DEFINE fecha CHAR(10),
hora char(5)
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A" AT 4,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 4,68 ATTRIBUTE (RED)
DISPLAY "Sistema Inventario de Suministros" AT 5,23 ATTRIBUTE(BLACK)
DISPLAY hora AT 6,73 ATTRIBUTE(RED)
CALL fgl_drawbox(5,79,3,1)
CALL fgl_drawbox(1,79,22,1)
END FUNCTION
FUNCTION integridad()
IF sqlca.sqlcode < 0 THEN
LET numero_msg = sqlca.sqlcode
CALL msg(numero_msg)
DISPLAY numero_msg AT 23,70
LET bandera = 1
SLEEP 2
RETURN
END IF
END FUNCTION
FUNCTION desplega_mnrp000()
CLEAR SCREEN
CALL pantalla()
LET impresor = FGL_GETENV("IMP")
DISPLAY "Reportes" AT 6,36 ATTRIBUTE(BLACK)
DISPLAY "ismnrp000" AT 4,3 ATTRIBUTE(RED)
DISPLAY " 1-Catalogo Bienes y Servicios inprrp001" AT 10,1
DISPLAY " 2-Catalogo de Suministros isprrp002" AT 11,1
DISPLAY " 3-Movimiento de Almacen isprrp003" AT 12,1
DISPLAY " 4-Tipos De Movimientos isprrp008" AT 13,1
DISPLAY " 5-Suministro - Existencia isprrp009" AT 14,1
DISPLAY " 6-Acumulado Por Movimientos isprrp010" AT 15,1
DISPLAY " 7-Operaciones X Movimientos isprrp011" AT 16,1
DISPLAY " 8-Comparativo de Existencia isprrp012" AT 17,1
DISPLAY " 9-Registros Modificados isprrp013" AT 17,1
# DISPLAY " R- Retorna Menu Anterior" AT 20,1
# ATTRIBUTE (BLACK)
END FUNCTION
PROYECTOS/isdir/ismt.bat
+16
View File
@@ -0,0 +1,16 @@
fgl2p ismn00000.4gl
fgl2p ismnmt000.4gl
fgl2p ismnmt006.4gl
fgl2p isprmt002.4gl
fgl2p isprmt003.4gl
fgl2p isprmt004.4gl
fgl2p isprmt005.4gl
fgl2p isprmt007.4gl
fgl2p isprmt008.4gl
fgl2p isprmt013.4gl
fgl2p isprmt016.4gl
fgl2p isprmt036.4gl
fgl2p isprmt056.4gl
fgl2p -o ismn00000.42r ismn00000.42m seg000.42m msg.42m
fgl2p -o ismnmt000.42r ismnmt000.42m ismnmt006.42m isprmt002.42m isprmt003.42m isprmt005.42m isprmt007.42m isprmt008.42m isprmt013.42m isprmt016.42m isprmt036.42m isprmt056.42m msg.42m seg000.42m msgrp000.42m
PROYECTOS/isdir/isprcs006.4gl
+245
View File
@@ -0,0 +1,245 @@
{
-----------------------------------------------------------------------------
PROGRAMA : ISPRCS006
OBJETIVO : Programa Consulta Balances Suministro.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 29, 1992.
-----------------------------------------------------------------------------
}
GLOBALS
"isprgb000.4gl"
FUNCTION isprcs006()
DEFINE segunda CHAR(1)
DEFINE fecha1 char(10)
DEFINE hora1 char(5)
DEFINE balance_in DECIMAL(12,2)
DEFINE primera CHAR(1)
DEFINE nombre CHAR(8)
LET fecha1 = today using "dd/mm/yyyy"
LET hora1 = time
LET int_flag = false
LET bandera = 0
WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
DISPLAY " R A Y . O . V A C D O M I N I C A N A " AT 1,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha1 AT 1,70 ATTRIBUTE (RED)
DISPLAY hora1 AT 2,73 ATTRIBUTE (RED)
DISPLAY "Consulta Balance - Suministros" AT 2,25 ATTRIBUTE(BLACK)
DISPLAY "<Esc> Continua Consultando" AT 3,7 ATTRIBUTE (RED,REVERSE)
DISPLAY "<Supr> Cancela Operacion" AT 3,50 ATTRIBUTE (RED,REVERSE)
DISPLAY "isprcs006" AT 1,3 ATTRIBUTE (RED)
OPEN FORM isfmcs006 FROM "isfmcs006"
DISPLAY FORM isfmcs006
INITIALIZE datos_gen.* TO NULL
LABEL volver:
INPUT BY NAME datos_cons.*
BEFORE FIELD fech_in
LET datos_cons.fech_in = today using "dd/mm/yyyy"
DISPLAY BY NAME datos_cons.fech_in
BEFORE FIELD fech_fi
LET datos_cons.fech_fi = today using "dd/mm/yyyy"
DISPLAY BY NAME datos_cons.fech_fi
AFTER FIELD cod_sec
SELECT descrip_esp,unidad_med INTO datos_cons.descrip_esp,
articulos.unidad_med
FROM intb00001
WHERE cod_n = datos_cons.cod_n and
cod_grupo = datos_cons.cod_grupo and
cod_tipo = datos_cons.cod_tipo and
cod_sec = datos_cons.cod_sec and
status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
CLEAR FORM
NEXT FIELD cod_n
END IF
DISPLAY BY NAME datos_cons.descrip_esp,articulos.unidad_med
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
{SELECT fecha INTO datos_cons.fech_in FROM istb00006
WHERE cod_mov = 99 AND
cod_n = datos_cons.cod_n and
cod_grupo = datos_cons.cod_grupo and
cod_tipo = datos_cons.cod_tipo and
cod_sec = datos_cons.cod_sec}
AFTER FIELD bodega
SELECT * FROM istb00009 where cod_bodega = datos_cons.bodega
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
CLEAR FORM
NEXT FIELD cod_n
END IF
SELECT * FROM istb00002
WHERE cod_n = datos_cons.cod_n and
cod_grupo = datos_cons.cod_grupo and
cod_tipo = datos_cons.cod_tipo and
cod_sec = datos_cons.cod_sec and
bodega = datos_cons.bodega
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
CLEAR FORM
NEXT FIELD cod_n
END IF
AFTER FIELD fech_fi
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
IF datos_cons.fech_in > datos_cons.fech_fi THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
AFTER INPUT
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
CLEAR SCREEN
RETURN
END IF
DISPLAY "Buscando Informacion... Espere Por Favor" AT 24,2 ATTRIBUTE (blue)
{ SELECT existencia INTO balance FROM istb00002 WHERE
cod_n = datos_cons.cod_n and
cod_grupo = datos_cons.cod_grupo and
cod_tipo = datos_cons.cod_tipo and
cod_sec = datos_cons.cod_sec and
status_t is null
IF STATUS >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
GOTO volver
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
GOTO volver
END IF
END IF
}
SELECT SUM(cantidad_2) INTO balance FROM istb00006 WHERE
cod_n = datos_cons.cod_n and
cod_grupo = datos_cons.cod_grupo and
cod_tipo = datos_cons.cod_tipo and
cod_sec = datos_cons.cod_sec and
fecha <= datos_cons.fech_in and
status_t is null
IF balance is null THEN
LET balance = 0
END IF
LET balance_in = balance
DISPLAY "Balance Inicial Al: " AT 13,30 ATTRIBUTE (blue)
DISPLAY datos_cons.fech_in using "dd/mm/yyyy" AT 13,51 ATTRIBUTE (blue)
DISPLAY balance_in using "---,---,---.##" AT 13,61 ATTRIBUTE (blue)
DECLARE jhonn_1 CURSOR FOR
SELECT unique p.num_doc,p.fecha,p.cantidad_2,p.cod_mov
FROM istb00006 p
WHERE
p.cod_n = datos_cons.cod_n and
p.cod_grupo = datos_cons.cod_grupo and
p.cod_tipo = datos_cons.cod_tipo and
p.cod_sec = datos_cons.cod_sec and
p.status_t is null and
p.fecha > datos_cons.fech_in and
p.fecha <= datos_cons.fech_fi
ORDER BY 2,1
OPEN jhonn_1
LET idx = 1
FOREACH jhonn_1 INTO csmov.*
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
end if
LET balance = balance + csmov.cantidad_2
LET csmov1[idx].fecha_2 = csmov.fecha_1
LET csmov1[idx].balance = balance USING "---,---,---.##"
LET csmov1[idx].num_doc = "(",csmov.cod_mov using "&&",")"," ",
csmov.num_doc USING "&&&&&&"
IF csmov.cantidad_2 < 0 THEN
LET csmov1[idx].entrada = null
LET csmov1[idx].salida = csmov.cantidad_2 USING "---,---,---.##"
ELSE
LET csmov1[idx].salida = null
LET csmov1[idx].entrada = csmov.cantidad_2 USING "###,###,###.##"
END IF
IF idx < 9 THEN
DISPLAY csmov1[idx].num_doc TO s_csmov[idx].num_doc
DISPLAY csmov1[idx].fecha_2 TO s_csmov[idx].fecha
DISPLAY csmov1[idx].entrada TO s_csmov[idx].entrada
DISPLAY csmov1[idx].salida TO s_csmov[idx].salida
DISPLAY csmov1[idx].balance TO s_csmov[idx].balance
END IF
LET idx = idx + 1
END FOREACH
DISPLAY " " AT 24,2
LET balance_in = 0
CALL set_count(idx - 1)
DISPLAY ARRAY csmov1 TO s_csmov.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
CLEAR SCREEN
RETURN
END IF
CLEAR FORM
DISPLAY " " AT 13,6
DISPLAY " " AT 13,60
GOTO volver
END FUNCTION
PROYECTOS/isdir/isprgb000.4gl
+287
View File
@@ -0,0 +1,287 @@
SCHEMA smarmotech
GLOBALS
DEFINE movimientos RECORD
cod_mov LIKE istb00006.cod_mov,
num_doc LIKE istb00006.num_doc,
fecha LIKE istb00006.fecha,
conduce_no LIKE istb00006.conduce_no,
fact_no LIKE istb00006.fact_no,
tipo LIKE istb00006.tipo,
orden_compra LIKE istb00006.orden_compra,
cod_sp LIKE istb00006.cod_sp,
cod_sp_sec LIKE istb00006.cod_sp_sec,
depto_de LIKE istb00006.depto_de,
bodega LIKE istb00006.bodega
END RECORD,
usuarios,clave VARCHAR(50)
DEFINE letras RECORD
negrillas_on ,
negrillas_off ,
doble_on ,
doble_off ,
comp_on ,
comp_off ,
doce ,
normal CHAR(6)
END RECORD
DEFINE impresor SMALLINT,
imprime CHAR(80),
archivo CHAR(20)
DEFINE ultimo RECORD
cond_recep LIKE istb00006.cond_recep,
uso_tiempo LIKE istb00006.uso_tiempo
END RECORD
{
DEFINE datos1 RECORD
cod_mov LIKE istb00005.cod_mov,
descrip_mov LIKE istb00005.descrip_mov,
num_doc LIKE istb00006.num_doc,
fecha LIKE istb00006.fecha,
depto_a LIKE istb00006.depto_a,
nom_dpto LIKE adtb00001.nom_dpto,
bodega LIKE istb00006.bodega
END RECORD
}
DEFINE p_conteo RECORD
fecha LIKE istb00006.fecha,
bodega LIKE istb00006.bodega,
cod_n LIKE istb00006.cod_n,
cod_grupo LIKE istb00006.cod_grupo,
cod_tipo LIKE istb00006.cod_tipo,
cod_sec LIKE istb00006.cod_sec,
cantidad LIKE istb00006.cantidad_2
END RECORD
{
DEFINE costos RECORD
mes_ini LIKE istb00013.mes_ini,
mes_fin LIKE istb00013.mes_fin,
ano LIKE istb00013.ano,
cod_n LIKE intb00001.cod_N,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
costo_st LIKE istb00013.costo_st,
us_crea LIKE istb00013.us_crea,
fech_crea LIKE istb00013.fech_crea,
us_mod LIKE istb00013.us_mod,
fech_mod LIKE istb00013.fech_mod
END RECORD
}
DEFINE datos RECORD
num_doc LIKE istb00006.num_doc,
fecha LIKE istb00006.fecha,
depto_de LIKE istb00006.depto_de,
depto_a LIKE istb00006.depto_a,
nom_dpto LIKE adtb00001.nom_dpto,
nom_dpto1 LIKE adtb00001.nom_dpto,
bodega LIKE istb00006.bodega
END RECORD
DEFINE datos_gen RECORD
cod_mov LIKE istb00006.cod_mov,
num_doc LIKE istb00006.num_doc,
tipo LIKE istb00006.tipo,
orden_compra LIKE istb00006.orden_compra,
cod_sp LIKE istb00006.cod_sp,
cod_sp_sec LIKE istb00006.cod_sp_sec,
conduce_no LIKE istb00006.conduce_no,
fact_no LIKE istb00006.fact_no,
fecha LIKE istb00006.fecha,
bodega LIKE istb00006.bodega,
nom_sp LIKE cotb00001.nom_sp,
descrip_mov VARCHAR(60),
depto_de LIKE istb00006.depto_de,
depto_a LIKE istb00006.depto_a
END RECORD
{
DEFINE otros_mov RECORD
num_doc LIKE istb00006.num_doc,
cod_mov LIKE istb00006.cod_mov,
fecha LIKE istb00006.fecha,
descrip_mov LIKE istb00005.descrip_mov,
bodega LIKE istb00006.bodega
END RECORD
}
DEFINE chequea RECORD
pto LIKE istb00002.pto_reorden,
existe LIKE istb00002.existencia
END RECORD
DEFINE bandera smallint
DEFINE p_fechas DATE
DEFINE nombre_dia ARRAY[7] OF char(10)
DEFINE nombre_mes ARRAY[12] OF char(10)
DEFINE general decimal(12,2)
DEFINE p_bodega SMALLINT
DEFINE arancel RECORD LIKE cotb00005.*
DEFINE status_m char(1)
DEFINE decide char(1)
DEFINE cant DECIMAL(10,2)
DEFINE tipo_papel smallint
DEFINE balance DECIMAL(12,2)
DEFINE cod_mov_ant LIKE istb00006.cod_mov
DEFINE existe_comp,suplidor1,doc_existe,actual,mat_prima CHAR (1000)
DEFINE opc ,opt2,existe,ya ,opera1,cambio CHAR(1)
DEFINE medida CHAR (3)
DEFINE fila smallint
DEFINE m_articulos RECORD LIKE istb00002.*
DEFINE numero_msg LIKE msgtable.cod_msg
DEFINE articulos RECORD LIKE intb00001.*
DEFINE mensajes RECORD {LIKE msgtable.* }
cod_msg smallint,
desc_msg char(60),
us_crea char(9),
fech_crea char(16),
us_mod char(9),
fech_mod char(16)
END RECORD
#DEFINE transacc RECORD LIKE istb00005.*
{ cod_mov smallint,
descrip_mov char (40),
status_mov char (1),
cuenta_1 char (4),
cuenta_2 char (4),
cuenta_3 char (4),
us_crea char(9),
fech_crea char(16),
us_mod char(9),
fech_mod char(16)
END RECORD }
DEFINE medidas RECORD LIKE intb00007.*
DEFINE descrip3,descrip4 CHAR(30),
descrip1,descrip2 CHAR(60)
DEFINE criterio CHAR(1000)
DEFINE selec CHAR(1000)
DEFINE cod_n_a,cod_grupo_a,cod_tipo_a,cod_sec_a SMALLINT
DEFINE p_act,idx,scr_l SMALLINT
DEFINE opcion CHAR(1)
DEFINE movi2 ARRAY[100] OF RECORD
cod_n LIKE istb00002.cod_n,
cod_grupo LIKE istb00002.cod_grupo,
cod_tipo LIKE istb00002.cod_tipo,
cod_sec LIKE istb00002.cod_sec,
cantidad_2 LIKE istb00006.cantidad_2,
unidad_med LIKE intb00001.unidad_med,
descrip_esp LIKE intb00001.descrip_esp
END RECORD
DEFINE art ARRAY[200] OF RECORD
cod_n1 SMALLINT,
cod_grupo1 SMALLINT,
cod_tipo1 SMALLINT,
cod_sec1 SMALLINT,
descrip_esp1 CHAR(30),
unidad_med LIKE intb00001.unidad_med,
bodega LIKE istb00002.bodega,
existencia like istb00002.existencia,
pto_reorden LIKE istb00002.pto_reorden,
dia_llegada LIKE istb00002.dia_llegada,
precio LIKE cotb00015.precio,
valor decimal(10,2)
END RECORD
DEFINE csmov1 ARRAY[300] OF RECORD
num_doc CHAR(11),
fecha_2 LIKE istb00006.fecha,
entrada char(14),
salida char(14),
balance char(14)
END RECORD
DEFINE csmov RECORD
num_doc LIKE istb00006.num_doc,
fecha_1 LIKE istb00006.fecha,
cantidad_2 LIKE istb00006.cantidad_2 ,
cod_mov LIKE istb00006.cod_mov
END RECORD
DEFINE datos_cons RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
bodega LIKE istb00006.bodega,
fech_in LIKE istb00006.fecha,
fech_fi LIKE istb00006.fecha
END RECORD
DEFINE movi3 ARRAY[100] OF RECORD
codigo CHAR(10),
cantidad_1 LIKE istb00006.cantidad_1,
cantidad_2 LIKE istb00006.cantidad_2,
diferencia DECIMAL(10,2),
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med
END RECORD
DEFINE movi_ant ARRAY[100] OF RECORD
cod_n LIKE istb00006.cod_n,
cod_grupo LIKE istb00006.cod_grupo,
cod_tipo LIKE istb00006.cod_tipo,
cod_sec LIKE istb00006.cod_sec,
cant_ant LIKE istb00006.cantidad_2
END RECORD
DEFINE movi ARRAY[100] OF RECORD
cod_n LIKE istb00006.cod_n,
cod_grupo LIKE istb00006.cod_grupo,
cod_tipo LIKE istb00006.cod_tipo,
cod_sec LIKE istb00006.cod_sec,
cantidad_1 LIKE istb00006.cantidad_1,
cantidad_2 LIKE istb00006.cantidad_2,
unidad_med LIKE intb00001.unidad_med,
descrip_esp LIKE intb00001.descrip_esp
END RECORD
DEFINE ant_art RECORD
cod_n LIKE cotb00002.cod_n,
cod_grupo LIKE cotb00002.cod_grupo,
cod_tipo LIKE cotb00002.cod_tipo,
cod_sec LIKE cotb00002.cod_sec
END RECORD
DEFINE consulta_mv ARRAY[200] OF RECORD
num_doc LIKE istb00006.num_doc,
fecha LIKE istb00006.fecha,
nombre char(7),
cantidad_1 LIKE istb00006.cantidad_1,
cantidad_2 LIKE istb00006.cantidad_1,
balance decimal(12,2)
END RECORD
{
DEFINE c_det_inv ARRAY[200] OF RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
existencia LIKE istb00002.existencia,
costo LIKE istb00013.costo_st,
valor DECIMAL(12,2)
END RECORD
}
DEFINE datos_cs RECORD
cod_n LIKE istb00006.cod_n,
cod_grupo LIKE istb00006.cod_grupo,
cod_tipo LIKE istb00006.cod_tipo,
cod_sec LIKE istb00006.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
fecha_in LIKE istb00006.fecha,
fecha_fi LIKE istb00006.fecha
END RECORD
DEFINE furgon RECORD LIKE cotb00003.*
DEFINE furgonart RECORD LIKE cotb00004.*
DEFINE arancelart RECORD LIKE cotb00006.*
END GLOBALS
PROYECTOS/isdir/isprmt002.140301.txt
+380
View File
@@ -0,0 +1,380 @@
{
------------------------------------------------------------------
PROGRAMA : ISPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra Suministro.
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Octubre 21, 1993.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt002 FROM "isfmmt002"
DISPLAY FORM isfmmt002
CALL pantalla()
DISPLAY "isprmt002" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Catalogo Suministros" at 6,30 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET INT_FLAG = FALSE
CALL ispcad002()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET INT_FLAG = FALSE
CALL ispcmf002()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad002()
DEFINE fech_ant CHAR(8)
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME m_articulos.cod_n THRU m_articulos.cod_sec,descrip1,descrip2,
medida,m_articulos.pto_reorden THRU m_articulos.fech_mod
## Verifica que el codigo no exista en el catalogo de m_articulos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
IF ( m_articulos.cod_n = 0 AND m_articulos.cod_grupo = 0 AND
m_articulos.cod_tipo = 0 AND m_articulos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT i.* FROM intb00001 i
WHERE i.cod_n = m_articulos.cod_n AND
i.cod_grupo = m_articulos.cod_grupo AND
i.cod_tipo = m_articulos.cod_tipo AND
i.cod_sec = m_articulos.cod_sec and
i.status_t is null
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT max(num_doc),max(fecha) INTO datos_gen.num_doc,datos_gen.fecha
FROM istb00006 WHERE cod_mov = 99
IF status = notfound THEN
LET datos_gen.num_doc = 0
LET datos_gen.fecha = today
END IF
LET datos_gen.num_doc = datos_gen.num_doc + 1
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab and
status_t is null
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
AFTER FIELD existencia
IF m_articulos.existencia IS null then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD existencia
END IF
AFTER FIELD bodega
IF m_articulos.bodega IS NOT NULL THEN
SELECT * FROM istb00009 WHERE
cod_bodega = m_articulos.bodega
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
AFTER FIELD dia_llegada
IF m_articulos.dia_llegada IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dia_llegada
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
INSERT INTO intb00001 VALUES (m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,descrip1,descrip2,
medida,NULL,USER,CURRENT,NULL,NULL)
INSERT INTO istb00002 VALUES (m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.pto_reorden,
m_articulos.existencia,m_articulos.cod_nab,m_articulos.base,
m_articulos.bodega, m_articulos.categoria,
m_articulos.dia_llegada,m_articulos.gravamen,
null,user,current,null,null)
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si el Status es diferente de cero quiere decir que hubo problemas durante
# la creacion del registro, entonces despliega un mensaje de alerta para que
# el usuario sepa que hubo problemas en la creacion del registro.
SELECT * FROM istb00006 WHERE
cod_mov = 99 AND
cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
IF status = notfound THEN
INSERT INTO istb00006 (num_doc,fecha,cod_mov,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad_2,bodega,us_crea,fech_crea)
VALUES (1,datos_gen.fecha,99,m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.existencia,
m_articulos.bodega,user,current)
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION ispcmf002()
#WHENEVER ERROR CONTINUE
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON istb00002.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM istb00002 WHERE ",
" status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO m_articulos.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO m_articulos.*
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO m_articulos.*
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME descrip1,descrip2,medida,m_articulos.pto_reorden THRU
m_articulos.fech_mod WITHOUT DEFAULTS
AFTER FIELD pto_reorden
NEXT FIELD existencia
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE intb00001 SET (descrip_esp,descrip_ing,unidad_med,us_mod,fech_mod)=
(descrip1,descrip2,medida,USER,CURRENT)
WHERE @cod_n= m_articulos.cod_n AND @cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND @cod_sec = m_articulos.cod_sec
UPDATE istb00002 SET pto_reorden = m_articulos.pto_reorden,
existencia = m_articulos.existencia,
cod_nab = m_articulos.cod_nab,
bodega = m_articulos.bodega,
dia_llegada = m_articulos.dia_llegada,
gravamen = m_articulos.gravamen,
base = m_articulos.base,
categoria = m_articulos.categoria,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
UPDATE istb00006 SET cantidad_2 = m_articulos.existencia,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
UPDATE intb00001 SET status_t = "E",
us_mod = user,
fech_mod = current
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
UPDATE istb00002 SET status_t = "E",
us_mod = user,
fech_mod = current
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
UPDATE istb00006 SET status_t = "E",
us_mod = user,
fech_mod = current
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
PROYECTOS/isdir/isprmt002.4gl
+319
View File
@@ -0,0 +1,319 @@
{
------------------------------------------------------------------
PROGRAMA : ISPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra Suministro.
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Octubre 21, 1993.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
DEFINE p_rowid,l_rowid,m_rowid INTEGER,
opt VARCHAR(3)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
DISPLAY "usuario ",usuarios, " clave ",clave
CONNECT TO "smarmotech" USER usuarios USING clave
CALL isprmt002()
END MAIN
FUNCTION isprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt002 FROM "isfmmt002"
DISPLAY FORM isfmmt002
# CALL pantalla()
DISPLAY "isprmt002" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Catalogo Suministros" at 6,30 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET INT_FLAG = FALSE
CALL ispcad002()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET INT_FLAG = FALSE
CALL ispcmf002()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad002()
DEFINE fech_ant CHAR(8)
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME m_articulos.cod_n THRU m_articulos.cod_sec,m_articulos.descrip_esp,m_articulos.unidad_med,
m_articulos.pto_reorden THRU m_articulos.fech_mod
BEFORE INPUT
LET m_articulos.cod_n = 2
LET m_articulos.cod_grupo = 0
LET m_articulos.cod_tipo = 0
LET m_articulos.bodega = 1
LET m_articulos.dia_llegada=0
LET m_articulos.existencia=0
LET m_articulos.gravamen=0
LET m_articulos.pto_reorden=0
LET m_articulos.unidad_med='UD'
DISPLAY BY NAME m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.bodega,m_articulos.dia_llegada,m_articulos.existencia,
m_articulos.gravamen,m_articulos.pto_reorden,m_articulos.unidad_med
## Verifica que el codigo no exista en el catalogo de m_articulos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
IF ( m_articulos.cod_n = 0 AND m_articulos.cod_grupo = 0 AND
m_articulos.cod_tipo = 0 AND m_articulos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT max(num_doc),max(fecha) INTO datos_gen.num_doc,datos_gen.fecha
FROM istb00006 WHERE cod_mov = 99
IF status = notfound THEN
LET datos_gen.num_doc = 0
LET datos_gen.fecha = today
END IF
LET datos_gen.num_doc = datos_gen.num_doc + 1
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab and
status_t is null
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
END IF
AFTER FIELD bodega
IF m_articulos.bodega IS NOT NULL THEN
SELECT * FROM intb00009 WHERE
cod_bodega = m_articulos.bodega
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
END IF
END IF
AFTER FIELD dia_llegada
IF m_articulos.dia_llegada IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dia_llegada
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT MAX(a.cod_sec) INTO m_articulos.cod_sec FROM istb00002 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo
IF m_articulos.cod_sec IS NULL THEN
LET m_articulos.cod_sec = 0
END IF
LET m_articulos.cod_sec = m_articulos.cod_sec +1
DISPLAY BY NAME m_articulos.cod_sec
INSERT INTO istb00002 (cod_n,cod_grupo,cod_tipo,cod_Sec,pto_reorden,existencia,cod_nab,base,bodega,
categoria,dia_llegada,gravamen,us_crea,fech_crea,descrip_esp,unidad_med )
VALUES (m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.pto_reorden,
m_articulos.existencia,m_articulos.cod_nab,m_articulos.base,
m_articulos.bodega, m_articulos.categoria,
m_articulos.dia_llegada,m_articulos.gravamen,
usuarios,getdate(),m_articulos.descrip_esp,m_articulos.unidad_med)
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si el Status es diferente de cero quiere decir que hubo problemas durante
# la creacion del registro, entonces despliega un mensaje de alerta para que
# el usuario sepa que hubo problemas en la creacion del registro.
SELECT * FROM istb00006 WHERE
cod_mov = 99 AND
cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
IF status = notfound THEN
INSERT INTO istb00006 (num_doc,fecha,cod_mov,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad_2,bodega,us_crea,fech_crea)
VALUES (1,datos_gen.fecha,99,m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.existencia,
m_articulos.bodega,usuarios,getdate())
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION ispcmf002()
#WHENEVER ERROR CONTINUE
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON istb00002.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE *,rowid FROM istb00002 WHERE ",
" status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO m_articulos.*,m_rowid
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
END IF
DISPLAY BY NAME m_articulos.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME m_articulos.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME m_articulos.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO m_articulos.*
DISPLAY BY NAME m_articulos.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO m_articulos.*
DISPLAY BY NAME m_articulos.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME m_articulos.descrip_esp,m_articulos.unidad_med,m_articulos.pto_reorden THRU
m_articulos.fech_mod WITHOUT DEFAULTS
AFTER FIELD pto_reorden
NEXT FIELD existencia
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE istb00002 SET descrip_esp = m_articulos.descrip_esp,
unidad_med = m_articulos.unidad_med,
pto_reorden = m_articulos.pto_reorden,
existencia = m_articulos.existencia,
cod_nab = m_articulos.cod_nab,
bodega = m_articulos.bodega,
dia_llegada = m_articulos.dia_llegada,
gravamen = m_articulos.gravamen,
base = m_articulos.base,
categoria = m_articulos.categoria,
us_mod = usuarios,
fech_mod = GETDATE()
WHERE rowid = m_rowid
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
LET opt = fgl_Winquestion("ELIMINAR","ESTA SEGURO DE ELIMINAR ESTE REGISTRO?","NO","YES|NO","QUESTION",0)
IF opt = "YES" THEN
UPDATE istb00002 SET status_t = "E",
us_mod = usuarios,
fech_mod = getdate()
WHERE cod_n = m_articulos.cod_n AND
cod_grupo = m_articulos.cod_grupo AND
cod_tipo = m_articulos.cod_tipo AND
cod_sec = m_articulos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
END IF
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
PROYECTOS/isdir/isprmt003.4gl
+362
View File
@@ -0,0 +1,362 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRMT003
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Costos Estandares
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Nov. 25, 1994
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt003()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt003 FROM "isfmmt003"
DISPLAY FORM isfmmt003
CALL pantalla()
DISPLAY "isprmt003" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Mantenimiento de Costos Estandares" AT 6,23 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET int_flag = false
CALL ispcad003()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET int_flag = false
CALL ispcmf003()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad003()
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME costos.mes_ini THRU costos.costo_st
## Verifica que el costo exista en el catalogo de costos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD mes_ini
IF costos.mes_ini IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
DISPLAY BY NAME descrip1
AFTER FIELD mes_fin
IF costos.mes_fin IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_fin
END IF
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD mes_fin
END IF
DISPLAY BY NAME descrip2
AFTER FIELD ano
IF costos.ano IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano
END IF
AFTER FIELD cod_sec
IF ( costos.cod_n = 0 AND costos.cod_grupo = 0 AND
costos.cod_tipo = 0 AND costos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT a.mes_ini,a.mes_fin,a.ano,a.cod_n,a.cod_grupo,a.cod_tipo,
a.cod_sec
FROM istb00013 a
WHERE a.mes_ini=costos.mes_ini AND a.mes_fin=costos.mes_fin AND
a.ano=costos.ano AND a.cod_n IN(2,7) AND
a.cod_n=costos.cod_n AND a.cod_grupo=costos.cod_grupo AND
a.cod_tipo=costos.cod_tipo AND a.cod_sec= costos.cod_sec
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a
WHERE a.cod_n= costos.cod_n AND a.cod_grupo=costos.cod_grupo
AND a.cod_tipo=costos.cod_tipo AND a.cod_sec=costos.cod_sec
AND a.status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME articulos.descrip_esp,articulos.unidad_med
AFTER FIELD costo_st
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
ELSE
INSERT INTO istb00013 VALUES (costos.mes_ini,costos.mes_fin,
costos.ano,costos.cod_n,costos.cod_grupo,
costos.cod_tipo,costos.cod_sec,costos.costo_st,
null,USER,CURRENT,null, null)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET costos.mes_ini = NULL
LET costos.mes_fin = NULL
LET costos.ano = NULL
LET costos.cod_n = NULL
LET costos.cod_grupo = NULL
LET costos.cod_tipo = NULL
LET costos.cod_sec = NULL
LET costos.costo_st = NULL
NEXT FIELD mes_ini
END IF
END INPUT
END FUNCTION
FUNCTION ispcmf003()
#WHENEVER ERROR CONTINUE
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON c.mes_ini,c.mes_fin,c.ano,c.cod_n,c.cod_grupo,
c.cod_tipo,c.cod_sec,c.costo_st
FROM mes_ini,mes_fin,ano,cod_n,cod_grupo,cod_tipo,
cod_sec,costo_st
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC =
"SELECT UNIQUE c.mes_ini,c.mes_fin,c.ano,d.cod_n,d.cod_grupo, ",
" d.cod_tipo,d.cod_sec,c.costo_st,c.us_crea,c.fech_crea, ",
" c.us_mod,c.fech_mod,a.descrip_esp,a.unidad_med ",
"FROM istb00013 c, intb00001 d,intb00001 a ",
"WHERE c.cod_n = a.cod_n and c.cod_grupo = a.cod_grupo and ",
" c.cod_tipo = a.cod_tipo and c.cod_sec = a.cod_sec and ",
" c.cod_n = d.cod_n and c.cod_grupo = d.cod_grupo and ",
" c.cod_tipo = d.cod_tipo and c.cod_sec = d.cod_sec and ",
" c.status_t is null and ",criterio clipped,
" ORDER BY 4,5,6,7"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
FETCH FIRST datos INTO costos.*,articulos.descrip_esp,articulos.unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
MENU "OPCIONES"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO costos.*,articulos.descrip_esp,articulos.unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO costos.*,articulos.descrip_esp,articulos.unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO costos.*,articulos.descrip_esp,articulos.unidad_med
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO costos.*,articulos.descrip_esp,articulos.unidad_med
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME costos.costo_st,costos.us_crea,costos.fech_crea,
costos.us_mod,costos.fech_mod WITHOUT DEFAULTS
AFTER FIELD costo_st
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
## Verifica si el usuario presiono la tecla <Supr>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE istb00013 SET costo_st = costos.costo_st,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = costos.cod_n and
cod_grupo = costos.cod_grupo and
cod_tipo = costos.cod_tipo and
cod_sec = costos.cod_sec
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE istb00013 SET status_t = "E"
WHERE cod_n = costos.cod_n and
cod_grupo = costos.cod_grupo and
cod_tipo = costos.cod_tipo and
cod_sec = costos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
PROYECTOS/isdir/isprmt004.4gl
+67
View File
@@ -0,0 +1,67 @@
{
==========================================================================
PROGRAMA : ISPRMT004
OBJETIVO : CERRAR INVENTARIO SUMINISTRO
REALIZADO POR : JUAN F. SOTO
FECHA : DICIEMBRE 1, 1994.
==========================================================================
}
DATABASE rayovac
GLOBALS
DEFINE trx RECORD LIKE istb00006.*
DEFINE p_fecha1,p_fecha2 DATE,
cantidad DECIMAL(12,2),
opt1 CHAR(1)
DEFINE datos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DECIMAL(12,2)
END RECORD
END GLOBALS
MAIN
CALL cierra()
END MAIN
FUNCTION cierra()
OPTIONS
PROMPT LINE 12
DISPLAY "R A Y . O . V A C D O M I N I C A N A, S. A."
AT 1,20 ATTRIBUTE(BLUE)
DISPLAY "CIERRE TRANSACCIONES PRODUCTOS TERMINADOS"
AT 2,22 ATTRIBUTE(BLACK)
PROMPT "Fecha Inicial, Formato (dd/mm/yy)? " FOR p_fecha1
PROMPT "Fecha Final, Formato (dd/mm/yy)? " FOR p_fecha2
PROMPT "Esta seguro de proceder (S/N)? " FOR opt1
DISPLAY "En Proceso... Espere Por Favor" AT 23,1 ATTRIBUTE (BOLD)
# Introduce Informacion al Historico
INSERT INTO istb00003 SELECT *FROM istb00006
WHERE fecha between p_fecha1 and p_fecha2
# Borra las Informacion del historico
DELETE FROM istb00006 WHERE fecha between p_fecha1 and p_fecha2
DECLARE busca CURSOR FOR
SELECT cod_n,cod_grupo,cod_tipo,cod_Sec,sum(cantidad_2)
FROM istb00003
WHERE fecha <= p_fecha2 and status_t is null
GROUP BY 1,2,3,4
FOREACH busca INTO datos.*
INSERT INTO istb00006(num_doc,fecha,cod_mov,cod_n,cod_grupo,cod_tipo,cod_sec,
cantidad_2,us_crea,fech_crea)
VALUES (1,p_fecha2,99,datos.cod_n,datos.cod_grupo,datos.cod_tipo,datos.cod_sec,
datos.cantidad,user,current)
END FOREACH
END FUNCTION
PROYECTOS/isdir/isprmt005.4gl
+343
View File
@@ -0,0 +1,343 @@
{
------------------------------------------------------------------
PROGRAMA : ISPRMT005
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Tipos de Movimientos.
PROGRAMADOR : Ing. Juan Soto
FECHA REALIZACION : Octubre 21, 1992.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt005()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt005 FROM "isfmmt005"
DISPLAY FORM isfmmt005
CALL pantalla()
DISPLAY "isprmt005" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Tipos de Movimientos" AT 6,30 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
let int_flag = false
CLEAR FORM
let int_flag = false
CALL ispcad005()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
CALL ispcmf005()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad005()
## Captura los datos que va a contener el registro
WHENEVER ERROR CONTINUE
INPUT BY NAME transacc.*
## Verifica que el codigo no exista en el catalogo de transacciones. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_mov
IF transacc.cod_mov = 0 OR
transacc.cod_mov IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_mov
ELSE
SELECT * INTO transacc.* FROM istb00005
WHERE cod_mov = transacc.cod_mov
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
IF transacc.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
DISPLAY BY NAME transacc.*
LET numero_msg = 12
CALL msg(numero_msg)
LET transacc.descrip_mov = NULL
LET transacc.status_mov = NULL
LET transacc.cuenta_1 = NULL
LET transacc.cuenta_2 = NULL
LET transacc.cuenta_3 = NULL
NEXT FIELD cod_mov
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
AFTER FIELD descrip_mov
IF transacc.descrip_mov IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_mov
END IF
AFTER FIELD cuenta_1
IF transacc.cuenta_1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_1
END IF
AFTER FIELD cuenta_2
IF transacc.cuenta_2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_2
END IF
# IF transacc.cuenta_1 = transacc.cuenta_2 THEN
# LET numero_msg = 24
# CALL msg(numero_msg)
# NEXT FIELD cuenta_2
# END IF
AFTER FIELD cuenta_3
IF (transacc.cuenta_3 = transacc.cuenta_1) OR
(transacc.cuenta_3 = transacc.cuenta_2) THEN
LET numero_msg = 24
CALL msg(numero_msg)
NEXT FIELD cuenta_3
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF transacc.descrip_mov IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_mov
ELSE
INSERT INTO istb00005 VALUES (transacc.cod_mov,
transacc.descrip_mov, transacc.status_mov,
transacc.cuenta_1, transacc.cuenta_2,
transacc.cuenta_3, null,USER, CURRENT, null, null)
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET transacc.cod_mov = NULL
LET transacc.descrip_mov = NULL
LET transacc.status_mov = NULL
LET transacc.cuenta_1 = NULL
LET transacc.cuenta_2 = NULL
LET transacc.cuenta_3 = NULL
NEXT FIELD cod_mov
END IF
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION ispcmf005()
## Aqui se prepara para la captura del criterio de seleccion
WHENEVER ERROR CONTINUE
CONSTRUCT BY NAME criterio ON istb00005.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM istb00005 where ",
" status_t is null and ",
criterio clipped,
" ORDER BY 1"
PREPARE busca FROM selec
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO transacc.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
DISPLAY BY NAME transacc.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO transacc.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
DISPLAY BY NAME transacc.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO transacc.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
DISPLAY BY NAME transacc.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO transacc.*
DISPLAY BY NAME transacc.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO transacc.*
DISPLAY BY NAME transacc.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME transacc.descrip_mov,
transacc.status_mov,
transacc.cuenta_1,
transacc.cuenta_2,
transacc.cuenta_3,
transacc.us_crea,
transacc.fech_crea,
transacc.us_mod,
transacc.fech_mod WITHOUT DEFAULTS
AFTER FIELD descrip_mov
IF transacc.descrip_mov IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_mov
END IF
AFTER FIELD cuenta_1
IF transacc.cuenta_1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_1
END IF
AFTER FIELD cuenta_2
IF transacc.cuenta_2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cuenta_2
END IF
IF transacc.cuenta_1 = transacc.cuenta_2 THEN
LET numero_msg = 24
CALL msg(numero_msg)
NEXT FIELD cuenta_2
END IF
AFTER FIELD cuenta_3
IF (transacc.cuenta_3 = transacc.cuenta_1) OR
(transacc.cuenta_3 = transacc.cuenta_2) THEN
LET numero_msg = 24
CALL msg(numero_msg)
NEXT FIELD cuenta_3
END IF
AFTER INPUT
#### Verifica si el usuario presiono la tecla <Supr>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE istb00005 SET descrip_mov = transacc.descrip_mov,
status_mov = transacc.status_mov,
cuenta_1 = transacc.cuenta_1,
cuenta_2 = transacc.cuenta_2,
cuenta_3 = transacc.cuenta_3,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_mov = transacc.cod_mov
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE istb00005 SET status_t = "E"
WHERE cod_mov = transacc.cod_mov
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
PROYECTOS/isdir/isprmt007.4gl
+256
View File
@@ -0,0 +1,256 @@
{
------------------------------------------------------------------
PROGRAMA : INPRMT007
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Unidades de Medidas.
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Agosto 1, 1992.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt007()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt007 FROM "isfmmt007"
DISPLAY FORM isfmmt007
CALL pantalla()
DISPLAY "isprmt007" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Mantenimiento Unidades de Medidas" AT 6,23 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
let int_flag = false
CLEAR FORM
CALL ispcad007()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
let int_flag = false
CALL ispcmf007()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad007()
WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME medidas.*
## Verifica que el codigo no exista en el catalogo de unidades. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD codigo_unidad
IF medidas.codigo_unidad IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD codigo_unidad
ELSE
SELECT * INTO medidas.* FROM intb00007
WHERE codigo_unidad = medidas.codigo_unidad
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF medidas.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD codigo_unidad
END IF
DISPLAY BY NAME medidas.*
LET numero_msg = 12
CALL msg(numero_msg)
LET medidas.descripcion = NULL
NEXT FIELD codigo_unidad
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
END IF
AFTER FIELD descripcion
IF medidas.descripcion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF medidas.descripcion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
ELSE
INSERT INTO intb00007 VALUES (medidas.codigo_unidad,medidas.descripcion,
null, USER, CURRENT, null, null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET medidas.codigo_unidad = NULL
LET medidas.descripcion = NULL
NEXT FIELD codigo_unidad
END IF
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION ispcmf007()
## Aqui se prepara para la captura del criterio de seleccion
WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON intb00007.* FROM intb00007.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM intb00007 where ",
" status_t is null and ",
criterio clipped,
" ORDER BY 1"
PREPARE busca FROM selec
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO medidas.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
end if
DISPLAY BY NAME medidas.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO medidas.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME medidas.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO medidas.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME medidas.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO medidas.*
DISPLAY BY NAME medidas.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO medidas.*
DISPLAY BY NAME medidas.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
IF medidas.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME medidas.descripcion,
medidas.us_crea,
medidas.fech_crea,
medidas.us_mod,
medidas.fech_mod WITHOUT DEFAULTS
AFTER FIELD descripcion
IF medidas.descripcion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
END IF
#### Verifica si el usuario presiono la tecla <Supr>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
UPDATE intb00007 SET descripcion = medidas.descripcion,
us_mod = USER,
fech_mod = CURRENT
WHERE codigo_unidad = medidas.codigo_unidad
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE intb00007 SET status_t = "E"
WHERE codigo_unidad = medidas.codigo_unidad
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
PROYECTOS/isdir/isprmt008.4gl
+302
View File
@@ -0,0 +1,302 @@
{
------------------------------------------------------------------
PROGRAMA : ISPRMT008
OBJETIVO : Capturar Informacion del Conteo Fisico del
Inventario Suministro.
PROGRAMADOR : Ing. Juan Fco. Soto.
FECHA REALIZACION : Octubre 21, 1993.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt008()
DEFINE p_hoy DATE
DEFINE documen INTEGER
DEFINE documento CHAR(6)
DEFINE ano CHAR (4)
DEFINE existe,salir,otra,de,mueve CHAR(1)
DEFINE dife_ant,diferencia,cant_ex,cant_ant,balance_in,ex_mov DECIMAL(10,2)
OPEN WINDOW cuenta AT 8,7 WITH FORM "isfmmt008" ATTRIBUTE (BORDER,
FORM LINE FIRST + 1,COMMENT LINE LAST -1, PROMPT LINE LAST)
WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
LET p_conteo.fecha = today
LABEL volver:
CLEAR FORM
LET cant_ex = 0
LET p_hoy = p_conteo.fecha
INITIALIZE p_conteo.* to null
LET p_conteo.fecha = p_hoy
INPUT BY NAME p_conteo.* WITHOUT DEFAULTS ATTRIBUTE (YELLOW)
BEFORE FIELD fecha
IF otra != "S" THEN
INITIALIZE p_conteo.* TO NULL
LET documento = null
END IF
LET otra = null
AFTER FIELD fecha
LET p_fechas = p_conteo.fecha using "ddmmyy"
#CALL prd(p_fechas)
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
AFTER FIELD bodega
SELECT * FROM istb00009 WHERE cod_bodega = p_conteo.bodega
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
AFTER FIELD cod_sec
## Verifica que el codigo no exista en el catalogo de unidades. Si existe,
## entonces despliega los datos del registro existente.
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp, articulos.unidad_med
FROM intb00001 a,istb00002 b
WHERE a.cod_n = p_conteo.cod_n and
a.cod_grupo = p_conteo.cod_grupo and
a.cod_tipo = p_conteo.cod_tipo and
a.cod_sec = p_conteo.cod_sec and
b.cod_n = p_conteo.cod_n and
b.cod_grupo = p_conteo.cod_grupo and
b.cod_tipo = p_conteo.cod_tipo and
b.cod_sec = p_conteo.cod_sec and
b.bodega = p_conteo.bodega
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
DISPLAY BY NAME articulos.descrip_esp
DISPLAY BY NAME articulos.unidad_med
LET documen = documento
AFTER FIELD cantidad
IF p_conteo.cantidad IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
LET salir = "S"
GOTO sale
END IF
SELECT sum(cantidad_2) INTO balance FROM istb00006 WHERE
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
status_t is null and
fecha <= p_conteo.fecha
LET ex_mov = balance
LET ex_mov = ex_mov USING "---,---,---.##"
DISPLAY BY NAME ex_mov
LABEL sale:
EXIT INPUT
END INPUT
IF salir = "S" THEN
GOTO sale1
END IF
LET diferencia = ex_mov - p_conteo.cantidad
IF diferencia < 0 THEN
LET datos_gen.cod_mov = 52
LET diferencia = diferencia * -1
ELSE
LET datos_gen.cod_mov = 25
END IF
DISPLAY BY NAME diferencia
#A1 COMIENZA
IF diferencia = 0 THEN
PROMPT "No tiene Diferencia, Desea Proseguir (S/N)" FOR CHAR OPC
IF opc = "N" or opc = "n" THEN
GOTO volver
LET OPC = NULL
ELSE
SELECT unique cod_n FROM istb00011
WHERE fecha = p_conteo.fecha and
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
bodega = p_conteo.bodega
IF STATUS = NOTFOUND THEN
INSERT INTO istb00011 values
(p_conteo.*,ex_mov,user,current,null,null)
ELSE
UPDATE istb00011 set cantidad = p_conteo.cantidad,
us_mod = user,
fech_mod = current
WHERE fecha = p_conteo.fecha and
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
bodega = p_conteo.bodega
END IF
GOTO dif
LET OPC = NULL
END IF
END IF
LABEL dif:
#A1 TERMINA
IF ex_mov != p_conteo.cantidad THEN
PROMPT "Tiene Diferencia el Conteo, Desea Hacer Ajuste (S/N)" FOR CHAR OPC
#A1 COMIENZA
IF opc = "S" OR opc = "s" THEN
DISPLAY "Codigo de Movimiento" AT 11,3
DISPLAY "Numero Documento " AT 12,3
SELECT descrip_mov,status_mov INTO datos_gen.descrip_mov,mueve
FROM istb00005 WHERE cod_mov = datos_gen.cod_mov
DISPLAY BY NAME datos_gen.descrip_mov,datos_gen.cod_mov
LABEL err1:
INPUT BY NAME datos_gen.num_doc ATTRIBUTE (YELLOW)
# Ejecuta los movimientos dependiendo si es de entrada o salida
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
GOTO sale1
END IF
LET documento = datos_gen.num_doc
# Llama a la funcion que actializa las tablas que se afectara por el ajuste
CALL introduce(documento,mueve,diferencia,de,cant_ex,ex_mov)
END IF
END IF
CLEAR FORM
GOTO volver
LABEL sale1:
CLOSE WINDOW cuenta
END FUNCTION
FUNCTION introduce(documento,mueve,diferencia,de,cant_ex,ex_mov)
# Funcion actualizadora de las tablas del ajuste y conteo fisico
DEFINE documento CHAR(6)
DEFINE documen INTEGER
DEFINE mueve,de CHAR(1)
DEFINE ex_mov,cant_ex, diferencia DECIMAL(10,2)
LET documen = documento
DELETE FROM istb00006 WHERE num_doc = documen and
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
cod_mov = datos_gen.cod_mov
IF datos_gen.cod_mov = 25 THEN
LET diferencia = diferencia * -1
END IF
INSERT INTO istb00006(num_doc,cod_mov,fecha,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad_2,bodega,us_crea,fech_crea)
VALUES
(documento,datos_gen.cod_mov,p_conteo.fecha,
p_conteo.cod_n,p_conteo.cod_grupo,p_conteo.cod_tipo,
p_conteo.cod_sec,diferencia,p_conteo.bodega,
user,current)
UPDATE istb00002 set existencia = p_conteo.cantidad
WHERE
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
bodega = p_conteo.bodega
SELECT unique cantidad FROM istb00011
WHERE fecha = p_conteo.fecha and
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
bodega = p_conteo.bodega
IF STATUS = NOTFOUND THEN
INSERT INTO istb00011 values
(p_conteo.*,ex_mov,user,current,null,null)
ELSE
# Si el conteo existe busca la cantidad que se le digito anterior a este
# conteo
SELECT unique cantidad_2 INTO cant_ex FROM istb00006
WHERE num_doc = documen and
cod_mov = datos_gen.cod_mov and
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
bodega = p_conteo.bodega
UPDATE istb00011 set cantidad = p_conteo.cantidad,
us_mod = user,
fech_mod = current
WHERE fecha = p_conteo.fecha and
cod_n = p_conteo.cod_n and
cod_grupo = p_conteo.cod_grupo and
cod_tipo = p_conteo.cod_tipo and
cod_sec = p_conteo.cod_sec and
bodega = p_conteo.bodega
IF datos_gen.cod_mov = 52 THEN
LET p_conteo.cantidad = (ex_mov - cant_ex) + diferencia
ELSE
LET p_conteo.cantidad = (ex_mov+ cant_ex) + diferencia
END IF
END IF
IF de = "S" THEN
LET numero_msg = 13
CALL msg(numero_msg)
ELSE
LET numero_msg = 1
CALL msg(numero_msg)
END IF
let de = null
END FUNCTION
PROYECTOS/isdir/isprmt013.4gl
+462
View File
@@ -0,0 +1,462 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISTB00013
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Costos Estandares
PROGRAMADOR : Ing. Juan Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt013()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt013 FROM "isfmmt013"
DISPLAY FORM isfmmt013
CALL pantalla()
DISPLAY "isprmt013" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Costos Estandares" AT 6,31 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET int_flag = false
CALL ispcad013()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET int_flag = false
CALL ispcmf013()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcad013()
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME costos.mes_ini THRU costos.costo_st
## Verifica que el costo exista en el catalogo de costos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD mes_ini
IF costos.mes_ini IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_ini
ELSE
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME descrip1
END IF
AFTER FIELD mes_fin
IF costos.mes_fin IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_fin
ELSE
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD mes_fin
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME descrip2
END IF
AFTER FIELD ano
IF costos.ano IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano
END IF
AFTER FIELD cod_sec
SELECT mes_ini,mes_fin,ano,cod_n,cod_grupo,cod_tipo,cod_sec
FROM istb00013
WHERE mes_ini = costos.mes_ini AND
mes_fin = costos.mes_fin AND
ano = costos.ano AND
cod_n = costos.cod_n AND
cod_grupo = costos.cod_grupo AND
cod_tipo = costos.cod_tipo AND
cod_sec = costos.cod_sec
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
IF ( costos.cod_n = 0 AND costos.cod_grupo = 0 AND
costos.cod_tipo = 0 AND costos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, istb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec AND
a.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME articulos.descrip_esp,articulos.unidad_med
END IF
AFTER FIELD costo_st
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
ELSE
INSERT INTO istb00013 VALUES (costos.mes_ini,costos.mes_fin,
costos.ano,costos.cod_n,costos.cod_grupo,
costos.cod_tipo,costos.cod_sec,costos.costo_st,
null,USER,CURRENT,null, null)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET costos.mes_ini = NULL
LET costos.mes_fin = NULL
LET costos.ano = NULL
LET costos.cod_n = NULL
LET costos.cod_grupo = NULL
LET costos.cod_tipo = NULL
LET costos.cod_sec = NULL
LET costos.costo_st = NULL
NEXT FIELD mes_ini
END IF
END INPUT
END FUNCTION
FUNCTION ispcmf013()
#WHENEVER ERROR CONTINUE
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON c.mes_ini,c.mes_fin,c.ano,
c.cod_n,c.cod_grupo,
c.cod_tipo,c.cod_sec,c.costo_st
FROM mes_ini,mes_fin,ano,
cod_n,cod_grupo,
cod_tipo,cod_sec,costo_st
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE c.mes_ini,c.mes_fin,c.ano, ",
" d.cod_n,d.cod_grupo,d.cod_tipo, ",
" d.cod_sec,c.costo_st,c.us_crea,",
"c.fech_crea, ",
" c.us_mod,c.fech_mod ",
" FROM istb00013 c, intb00001 d where ",
"c.cod_n = d.cod_n and ",
"c.cod_grupo = d.cod_grupo and ",
"c.cod_tipo = d.cod_tipo and ",
"c.cod_sec = d.cod_sec and ",
"c.status_t is null and ",
criterio clipped,
" ORDER BY 4,5,6,7"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
FETCH FIRST datos INTO costos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, istb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
MENU "OPCIONES"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO costos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, istb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO costos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, istb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO costos.*
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, istb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO costos.*
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = costos.mes_ini and
status_t is null
DISPLAY BY NAME descrip1
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = costos.mes_fin and
status_t is null
DISPLAY BY NAME descrip2
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, istb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = costos.cod_n AND
b.cod_grupo = costos.cod_grupo AND
b.cod_tipo = costos.cod_tipo AND
b.cod_sec = costos.cod_sec
DISPLAY BY NAME costos.*,articulos.descrip_esp,articulos.unidad_med
DISPLAY costos.costo_st USING "##,###,###.####" AT 13,17
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME costos.costo_st,
costos.us_crea,
costos.fech_crea,
costos.us_mod,
costos.fech_mod WITHOUT DEFAULTS
AFTER FIELD costo_st
IF costos.costo_st IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_st
END IF
## Verifica si el usuario presiono la tecla <Supr>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE istb00013 SET costo_st = costos.costo_st,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = costos.cod_n and
cod_grupo = costos.cod_grupo and
cod_tipo = costos.cod_tipo and
cod_sec = costos.cod_sec
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE istb00013 SET status_t = "E"
WHERE cod_n = costos.cod_n and
cod_grupo = costos.cod_grupo and
cod_tipo = costos.cod_tipo and
cod_sec = costos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
PROYECTOS/isdir/isprmt016.4gl
+665
View File
@@ -0,0 +1,665 @@
{
--------------------------------------------------------------------------
PROGRAMA : ISPRMT016
OBJETIVO : Programa Captura Documento Movimiento:
DEVOLUCION A SUPLIDOR
de Inventario de Suministro.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 22, 1993.
--------------------------------------------------------------------------
}
GLOBALS
"isprgb000.4gl"
FUNCTION isprmt016()
DEFINE fecha CHAR(10)
DEFINE hora CHAR(5)
CLEAR SCREEN
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY "R A Y . O . V A C D O M I N I C A N A" AT 1,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 1,70 ATTRIBUTE (RED)
DISPLAY hora AT 2,73 ATTRIBUTE (RED)
DISPLAY "Suministro(s) Devuelto(s) al Suplidor" AT 2,21 ATTRIBUTE(BLACK)
DISPLAY "isprmt016" AT 1,3 ATTRIBUTE (RED)
DISPLAY "<Esc> Adiciona Registro" AT 3,2 ATTRIBUTE (RED,REVERSE)
DISPLAY "<Supr> Cancela Operacion" AT 3,56 ATTRIBUTE (RED,REVERSE)
OPEN FORM isfmmt016 FROM "isfmmt016"
DISPLAY FORM isfmmt016
LET actual = "UPDATE istb00002 SET existencia = existencia + ? ",
"WHERE cod_n = ? and ",
"cod_grupo = ? and ",
"cod_tipo = ? and ",
"cod_sec = ? "
CALL isprad016()
END FUNCTION
FUNCTION isprad016()
DEFINE idx1 SMALLINT
DEFINE r_cantidad,recibida,ordenada,total_cantidad,porciento DECIMAL(12,2)
DEFINE devuelta CHAR(1)
#WHENEVER ERROR CONTINUE
LET int_flag = FALSE
LET OPC = null
INITIALIZE datos_gen.* TO NULL
PREPARE actualiza FROM actual
LABEL otra_vez:
LABEL vuelve:
IF (OPC = "S" OR OPC = "s") OR opc is null THEN
INITIALIZE datos_gen.* TO NULL
END IF
LET datos_gen.cod_mov = cod_mov_ant
LET datos_gen.cod_mov = 38
LET datos_gen.fecha = today
LET devuelta = "N"
INPUT BY NAME datos_gen.num_doc,datos_gen.tipo,datos_gen.orden_compra,
datos_gen.fecha,datos_gen.bodega
WITHOUT DEFAULTS
AFTER FIELD bodega
SELECT *FROM istb00009 WHERE cod_bodega = datos_gen.bodega
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
AFTER FIELD fecha
LET datos_gen.bodega = 1
DISPLAY BY NAME datos_gen.bodega
IF datos_gen.fecha is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
LET p_fechas = datos_gen.fecha using "ddmmyyyy"
CALL prd(p_fechas)
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
AFTER FIELD num_doc
IF datos_gen.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
SELECT * FROM istb00005 WHERE cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 34
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT UNIQUE cod_sp,cod_sp_sec,fecha,tipo,orden_compra
INTO datos_gen.cod_sp,datos_gen.cod_sp_sec,
datos_gen.fecha,datos_gen.tipo,datos_gen.orden_compra
FROM istb00006
WHERE
num_doc = datos_gen.num_doc and
cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF status != NOTFOUND THEN
SELECT UNIQUE nom_sp INTO datos_gen.nom_sp FROM cotb00001 WHERE
cod_sp = datos_gen.cod_sp and
cod_sp_sec = datos_gen.cod_sp_sec and
status_t is null
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME datos_gen.cod_sp,datos_gen.fecha,
datos_gen.nom_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
END IF
IF OPC = "S" OR OPC = "s" OR OPC is null THEN
INITIALIZE datos_gen.cod_sp, datos_gen.nom_sp,
datos_gen.cod_sp_sec,datos_gen.tipo,
datos_gen.orden_compra
TO NULL
DISPLAY BY NAME datos_gen.cod_sp,
datos_gen.nom_sp,datos_gen.cod_sp_sec,
datos_gen.tipo,datos_gen.orden_compra
END IF
END IF
AFTER FIELD tipo
IF datos_gen.tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
AFTER FIELD orden_compra
# Verifica que la orden de compra este en el archivo y
# ademas obliga a que el usuario tenga que digitar este campo
IF datos_gen.orden_compra IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD orden_compra
ELSE
SELECT unique a.orden_compra FROM istb00006 a
WHERE a.tipo = datos_gen.tipo AND
a.orden_compra = datos_gen.orden_compra
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 73
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT cod_sp,cod_sp_sec,cierre INTO datos_gen.cod_sp,datos_gen.cod_sp_sec,
devuelta
FROM cotb00014 WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD orden_compra
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT UNIQUE nom_sp INTO datos_gen.nom_sp FROM cotb00001 WHERE
cod_sp = datos_gen.cod_sp and
cod_sp_sec = datos_gen.cod_sp_sec and
status_t is null
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.cod_sp,datos_gen.cod_sp_sec
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
SLEEP 1
RETURN
END IF
IF datos_gen.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
SELECT UNIQUE num_doc FROM istb00006 WHERE num_doc = datos_gen.num_doc and
cod_mov = datos_gen.cod_mov and
status_t is null
IF status >= 0 THEN
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
END IF
END IF
# Verifica que la orden de compra este en el archivo y
# ademas obliga a que el usuario tenga que digitar este campo
IF datos_gen.orden_compra IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD orden_compra
ELSE
SELECT cod_sp,cod_sp_sec INTO datos_gen.cod_sp,datos_gen.cod_sp_sec
FROM cotb00014 WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD orden_compra
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT UNIQUE nom_sp INTO datos_gen.nom_sp FROM cotb00001 WHERE
cod_sp = datos_gen.cod_sp and
cod_sp_sec = datos_gen.cod_sp_sec and
status_t is null
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.cod_sp,datos_gen.cod_sp_sec
END IF
EXIT INPUT
END INPUT
INITIALIZE ant_art.* TO NULL
IF opc = "S" or opc = "s" OR opc IS NULL THEN
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_2 = null
LET movi[idx].cantidad_1 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
END IF
IF opc = "S" or opc = "s" or opc is null THEN
DECLARE materiales CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.cantidad,a.cantidad,
b.unidad_med,b.descrip_esp
FROM cotb00015 a,intb00001 b
WHERE a.tipo = datos_gen.tipo and
a.num_oc = datos_gen.orden_compra and
a.cod_n = b.cod_n and
a.cod_grupo = b.cod_grupo and
a.cod_tipo = b.cod_tipo and
a.cod_sec = b.cod_sec
LET idx = 1
FOREACH materiales INTO movi[idx].*
IF status = notfound THEN
EXIT FOREACH
END IF
IF OPC = "S" OR opc = "s" or opc is null THEN
LET movi[idx].cantidad_1 = null
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx - 1)
END IF
LABEL volver:
INPUT ARRAY movi WITHOUT DEFAULTS FROM s_movi1.*
AFTER FIELD cantidad_1
LET p_act = arr_curr()
LET scr_l = scr_line()
IF movi[p_act].cantidad_1 is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
status_t is null
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
IF movi[p_act].cantidad_1 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET cant = chequea.existe - movi[p_act].cantidad_1
IF cant <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
LET cant = 0
END IF
# Verifica que la cantidad recibida mas las que se han recibida de
# la orden no exceda de un 10% de la cantidad total de la orden
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE tipo = datos_gen.tipo and
orden_compra = datos_gen.orden_compra and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF recibida is null THEN
LET numero_msg = 73
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
SELECT cantidad INTO ordenada FROM cotb00015
WHERE tipo = datos_gen.tipo and
num_oc = datos_gen.orden_compra and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
IF movi[p_act].cantidad_1 > recibida THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
LET r_cantidad = recibida + porciento
IF movi[p_act].cantidad_1 > r_cantidad THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
SLEEP 1
RETURN
END IF
IF movi[p_act].cantidad_1 is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
status_t is null
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
IF movi[p_act].cantidad_1 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET cant = chequea.existe - movi[p_act].cantidad_1
IF cant <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
LET cant = 0
END IF
# Verifica que la cantidad recibida mas las que se han recibida de
# la orden no exceda de un 10% de la cantidad total de la orden
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE tipo = datos_gen.tipo and
orden_compra = datos_gen.orden_compra and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 73
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT cantidad INTO ordenada FROM cotb00015
WHERE tipo = datos_gen.tipo and
num_oc= datos_gen.orden_compra and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
LET r_cantidad = recibida + porciento
IF movi[p_act].cantidad_1 > r_cantidad THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_1
END IF
END IF
LET total_cantidad = 0
FOR idx = 1 to arr_count()
IF movi[idx].cantidad_1 is not null THEN
LET total_cantidad = movi[idx].cantidad_1 + total_cantidad
END IF
END FOR
IF movi[p_act].cod_n is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_grupo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_tipo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_sec is null THEN
CALL limpia()
END IF
EXIT INPUT
END INPUT
PROMPT "Toda la Informacion Esta Correcta? (S/N)" FOR CHAR opc
IF OPC = "S" or OPC = "s" THEN
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE orden_compra = datos_gen.orden_compra
SELECT sum(cantidad) INTO ordenada FROM cotb00015
WHERE num_oc = datos_gen.orden_compra
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
LET r_cantidad = ordenada + porciento
IF total_cantidad >= r_cantidad THEN
LET devuelta = "S"
END IF
FOR idx = 1 TO arr_count()
IF movi[idx].cantidad_1 is not null THEN
LET movi[idx].cantidad_1 = movi[idx].cantidad_1 * -1
INSERT INTO istb00006 VALUES
(datos_gen.num_doc,datos_gen.fecha,datos_gen.fact_no,
datos_gen.conduce_no,datos_gen.orden_compra,datos_gen.tipo,
datos_gen.cod_sp,datos_gen.cod_sp_sec,datos_gen.cod_mov,
movi[idx].cod_n,movi[idx].cod_grupo,
movi[idx].cod_tipo,movi[idx].cod_sec,movi[idx].cantidad_2,
movi[idx].cantidad_1,null,null,null,
ultimo.cond_recep,ultimo.uso_tiempo,datos_gen.bodega,
null,user,current,null,null)
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
EXECUTE actualiza USING movi[idx].cantidad_2,
movi[idx].cod_n,movi[idx].cod_grupo,
movi[idx].cod_tipo,movi[idx].cod_sec
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END FOR
IF devuelta = "S" OR devuelta = "D" THEN
UPDATE cotb00014 set cierre = "D"
WHERE tipo = datos_gen.tipo AND
num_oc = datos_gen.orden_compra
END IF
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
DISPLAY movi[idx].cod_n to s_movi1[idx].cod_n
DISPLAY movi[idx].cod_grupo to s_movi1[idx].cod_grupo
DISPLAY movi[idx].cod_tipo to s_movi1[idx].cod_tipo
DISPLAY movi[idx].cod_sec to s_movi1[idx].cod_sec
DISPLAY movi[idx].descrip_esp to s_movi1[idx].descrip_esp
DISPLAY movi[idx].unidad_med to s_movi1[idx].unidad_med
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
ELSE
GOTO otra_vez
END IF
GOTO vuelve
END FUNCTION
PROYECTOS/isdir/isprmt036.4gl
+742
View File
@@ -0,0 +1,742 @@
{
----------------------------------------------------------------------------
PROGRAMA : ISPRMT036
OBJETIVO : Programa Captura Documento Movimiento:
REQUISICION DE SUMINISTROS de Inventario de Suministros
PROGRAMADOR : Ing. Juan Fco. Soto (Copiado del INPRMT016)
FECHA REALIZACION : octubre 21, 1993.
----------------------------------------------------------------------------
}
GLOBALS
"isprgb000.4gl"
FUNCTION isprmt036()
DEFINE fecha CHAR(10)
DEFINE hora CHAR(5)
CLEAR SCREEN
OPTIONS
ERROR LINE 24,
FORM LINE 4,
COMMENT LINE 22,
PROMPT LINE 23
LET fecha = today USING "dd/mm/yyyy"
LET hora = time
DISPLAY " R A Y . O . V A C D O M I N I C A N A " AT 1,21
ATTRIBUTE (REVERSE,BLUE)
DISPLAY fecha AT 1,70 ATTRIBUTE (RED)
DISPLAY hora AT 2,73 ATTRIBUTE (RED)
DISPLAY "Requisicion de Suministros" AT 2,27 ATTRIBUTE(BLACK)
DISPLAY "isprmt036" AT 1,3 ATTRIBUTE (RED)
DISPLAY "<Esc> Adiciona Registro" AT 3,2 ATTRIBUTE (RED,REVERSE)
DISPLAY "<Supr> Cancela Operacion" AT 3,56 ATTRIBUTE (RED,REVERSE)
OPEN FORM isfmmt036 FROM "isfmmt036"
DISPLAY FORM isfmmt036
LET actual = "UPDATE istb00002 SET existencia = existencia - ? ",
"WHERE cod_n = ? and ",
"cod_grupo = ? and ",
"cod_tipo = ? and ",
"cod_sec = ? "
CALL isprad036()
END FUNCTION
FUNCTION isprad036()
# WHENEVER ERROR CONTINUE
LET opc = null
LET int_flag = FALSE
INITIALIZE datos1.* TO NULL
PREPARE actualiza FROM actual
LABEL otra_vez:
LABEL vuelve:
IF (OPC = "S" OR OPC = "s") OR opc is null THEN
INITIALIZE datos1.* TO NULL
END IF
INPUT BY NAME datos1.* WITHOUT DEFAULTS
AFTER FIELD cod_mov
IF datos1.cod_mov is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
SELECT @descrip_mov INTO datos1.descrip_mov
FROM istb00005
WHERE @cod_mov = datos1.cod_mov and
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 datos1.descrip_mov
BEFORE FIELD bodega
LET datos1.bodega = 1
DISPLAY BY NAME datos1.bodega
AFTER FIELD bodega
SELECT *FROM istb00009 WHERE cod_bodega = datos1.bodega
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
BEFORE FIELD num_doc
LET datos1.fecha = today
DISPLAY BY NAME datos1.fecha
# Verifica que el numero del documento de entrada no este en el archivo de
# movimientos.
AFTER FIELD fecha
IF datos1.fecha IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
LET p_fechas = datos1.fecha using "ddmmyyyy"
CALL prd()
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
AFTER FIELD num_doc
IF datos1.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
SELECT * FROM istb00005 where cod_mov = 36
and status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 34
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT UNIQUE depto_a,fecha INTO datos1.depto_a,datos1.fecha
FROM istb00006 WHERE num_doc = datos1.num_doc and
cod_mov = 36 AND
status_t is null
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
SELECT UNIQUE nom_dpto INTO datos1.nom_dpto FROM adtb00001
WHERE departamento = datos1.depto_a
and status_t is null
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME datos1.depto_a,datos1.fecha,datos1.nom_dpto
NEXT FIELD num_doc
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
IF OPC = "S" or OPC = "s" or opc is null THEN
INITIALIZE datos1.depto_a,datos1.nom_dpto TO NULL
DISPLAY BY NAME datos1.depto_a,datos1.nom_dpto
END IF
END IF
AFTER FIELD depto_a
IF datos1.depto_a IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD depto_a
ELSE
SELECT UNIQUE nom_dpto INTO datos1.nom_dpto FROM adtb00001
WHERE departamento = datos1.depto_a and
status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD depto_a
END IF
else
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
DISPLAY BY NAME datos1.nom_dpto
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
SLEEP 3
RETURN
END IF
IF datos1.num_doc IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_doc
ELSE
SELECT UNIQUE num_doc FROM istb00006
WHERE num_doc = datos1.num_doc and
cod_mov = 36 and
status_t is null
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_doc
END IF
else
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
IF datos1.depto_a IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
ELSE
SELECT UNIQUE nom_dpto INTO datos1.nom_dpto FROM adtb00001
WHERE departamento = datos1.depto_a and
status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END IF
EXIT INPUT
END INPUT
INITIALIZE ant_art.* TO NULL
IF opc = "S" or opc = "s" OR opc IS NULL THEN
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_2 = null
LET movi[idx].cantidad_1 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
END IF
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
INPUT ARRAY movi WITHOUT DEFAULTS FROM s_movi1.*
BEFORE ROW
LET p_act = arr_curr()
LET scr_l = scr_line()
AFTER ROW
IF movi[p_act].cod_n is not null and
movi[p_act].cod_grupo is not null and
movi[p_act].cod_tipo is not null and
movi[p_act].cod_sec is not null then
LET p_act = arr_curr()
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET numero_msg = 21
CALL msg(numero_msg)
LET p_act = p_act - 1
NEXT FIELD cod_n
END IF
END IF
END FOR
IF movi[p_act].cantidad_1 IS NULL and movi[p_act].cantidad_2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
AFTER FIELD cod_n
LET p_act = arr_curr()
IF movi[p_act].cod_n is not null then
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET p_act = p_act - 1
NEXT FIELD cod_grupo
END IF
END IF
END FOR
END IF
AFTER FIELD cod_grupo
IF movi[p_act].cod_grupo is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET p_act = arr_curr()
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET p_act = p_act - 1
NEXT FIELD cod_tipo
END IF
END IF
END FOR
AFTER FIELD cod_tipo
IF movi[p_act].cod_tipo is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET p_act = arr_curr()
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET p_act = p_act - 1
NEXT FIELD cod_sec
END IF
END IF
END FOR
AFTER FIELD cod_sec
LET p_act = arr_curr()
IF movi[p_act].cod_sec is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
IF movi[p_act].cod_n is null AND movi[p_act].cod_sec is not null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
IF movi[p_act].cod_n is not null and
movi[p_act].cod_grupo is not null and
movi[p_act].cod_tipo is not null and
movi[p_act].cod_sec is not null then
SELECT descrip_esp,unidad_med INTO descrip1,descrip2
FROM intb00001
WHERE cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
and status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
else
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
SELECT * FROM istb00002 WHERE cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_Act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
and status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 35
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
ELSE
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
LET movi[p_act].descrip_esp = descrip1
LET movi[p_act].unidad_med = descrip2 clipped
DISPLAY movi[p_act].descrip_esp TO s_movi1[scr_l].descrip_esp
DISPLAY movi[p_act].unidad_med TO s_movi1[scr_l].unidad_med
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET numero_msg = 21
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
END FOR
END IF
AFTER FIELD cantidad_1
IF movi[p_act].cantidad_1 IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
END IF
AFTER FIELD cantidad_2
IF movi[p_act].cod_n is not null and
movi[p_act].cod_grupo is not null and
movi[p_act].cod_tipo is not null and
movi[p_act].cod_sec is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
and status_t is null
#Verifica que la cantidad digitada no exceda a la existencia
IF movi[p_act].cantidad_2 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
#Verifica el punto de reorden y da mensaje
LET cant = chequea.existe - movi[p_act].cantidad_2
IF cant < chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
END IF
IF movi[p_act].cantidad_2 > movi[p_act].cantidad_1 THEN
LET numero_msg = 28
CALL msg(numero_msg)
END IF
IF movi[p_act].cantidad_2 IS NULL then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
FOR idx = 1 to arr_count()
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
END FOR
SLEEP 3
RETURN
END IF
IF movi[p_act].cod_n is not null and
movi[p_act].cod_grupo is not null and
movi[p_act].cod_tipo is not null and
movi[p_act].cod_sec is not null then
SELECT descrip_esp,unidad_med INTO descrip1,descrip2
FROM intb00001
WHERE cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
and status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
SELECT * FROM istb00002 WHERE cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_Act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
and status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 35
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
LET movi[p_act].descrip_esp = descrip1
LET movi[p_act].unidad_med = descrip2 clipped
DISPLAY movi[p_act].descrip_esp TO s_movi1[scr_l].descrip_esp
DISPLAY movi[p_act].unidad_med TO s_movi1[scr_l].unidad_med
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET numero_msg = 21
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
END FOR
IF movi[p_act].cod_n is not null and
movi[p_act].cod_grupo is not null and
movi[p_act].cod_tipo is not null and
movi[p_act].cod_sec is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
and status_t is null
#Verifica que la cantidad digitada no exceda a la existencia
IF movi[p_act].cantidad_2 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET cant = chequea.existe - movi[p_act].cantidad_2
IF cant < chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
END IF
END IF
IF movi[p_act].cantidad_1 IS NULL and movi[p_act].cantidad_2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
IF movi[p_act].cod_n is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_grupo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_tipo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_sec is null THEN
CALL limpia()
END IF
EXIT INPUT
END INPUT
PROMPT "Toda la Informacion Esta Correcta? (S/N)" FOR CHAR opc
IF OPC = "S" or OPC = "s" THEN
FOR idx = 1 TO arr_count()
IF movi[idx].cod_n is not null and movi[idx].cod_grupo is not null and
movi[idx].cod_tipo is not null and movi[idx].cod_sec is not null THEN
LET movi[idx].cantidad_2 = movi[idx].cantidad_2 * -1
INSERT INTO istb00006 VALUES
(datos1.num_doc,datos1.fecha,null,
null,null,null,null,null,
36,movi[idx].cod_n,
movi[idx].cod_grupo,movi[idx].cod_tipo,
movi[idx].cod_sec,movi[idx].cantidad_1,
movi[idx].cantidad_2,null,datos1.depto_a,
null,null,datos1.bodega,null,user,current,
null,null)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET movi[idx].cantidad_2 = movi[idx].cantidad_2 * -1
EXECUTE actualiza USING movi[idx].cantidad_2,
movi[idx].cod_n,movi[idx].cod_grupo,
movi[idx].cod_tipo,movi[idx].cod_sec
CALL integridad()
if bandera = 1 THEN
LET bandera = 0
RETURN
end if
END IF
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
FOR idx = 1 to 6
LET movi[idx].cod_n = null
LET movi[idx].cod_grupo = null
LET movi[idx].cod_tipo = null
LET movi[idx].cod_sec = null
LET movi[idx].cantidad_1 = null
LET movi[idx].cantidad_2 = null
LET movi[idx].unidad_med = null
LET movi[idx].descrip_esp = null
DISPLAY movi[idx].cod_n to s_movi1[idx].cod_n
DISPLAY movi[idx].cod_grupo to s_movi1[idx].cod_grupo
DISPLAY movi[idx].cod_tipo to s_movi1[idx].cod_tipo
DISPLAY movi[idx].cod_sec to s_movi1[idx].cod_sec
DISPLAY movi[idx].descrip_esp to s_movi1[idx].descrip_esp
DISPLAY movi[idx].unidad_med to s_movi1[idx].unidad_med
END FOR
ELSE
GOTO otra_vez
END IF
GOTO vuelve
END FUNCTION
FUNCTION limpia()
LET movi[p_act].cod_n = null
LET movi[p_act].cod_grupo = null
LET movi[p_act].cod_tipo = null
LET movi[p_act].cod_sec = null
LET movi[p_act].cantidad_1 = null
LET movi[p_act].cantidad_2 = null
LET movi[p_act].unidad_med = null
LET movi[p_act].descrip_esp = null
DISPLAY movi[p_act].cod_n to s_movi1[scr_l].cod_n
DISPLAY movi[p_act].cod_grupo to s_movi1[scr_l].cod_grupo
DISPLAY movi[p_act].cod_tipo to s_movi1[scr_l].cod_tipo
DISPLAY movi[p_act].cod_sec to s_movi1[scr_l].cod_sec
DISPLAY movi[p_act].cantidad_1 to s_movi1[scr_l].cantidad_1
DISPLAY movi[p_act].cantidad_2 to s_movi1[scr_l].cantidad_2
DISPLAY movi[p_act].unidad_med to s_movi1[scr_l].unidad_med
DISPLAY movi[p_act].descrip_esp to s_movi1[scr_l].descrip_esp
END FUNCTION
PROYECTOS/isdir/isprmt056.4gl
+856
View File
@@ -0,0 +1,856 @@
{
------------------------------------------------------------------
PROGRAMA : ISPRMT056
OBJETIVO : Modificar, Eliminar registros de los
Movimientos de Suministro
PROGRAMADOR : Ing. Juan Soto(Johnny)
FECHA REALIZACION : Octubre 21, 1993.
------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprmt056()
#WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS
FORM LINE 4,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmmt056 FROM "isfmmt056"
DISPLAY FORM isfmmt056
DISPLAY "isprmt056" AT 3,3 ATTRIBUTE (RED)
DISPLAY "Correccion Movimientos De Suministros" AT 3,21 ATTRIBUTE (BLACK)
MENU "OPCIONES"
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET INT_FLAG = FALSE
CALL ispcmf056()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ispcmf056()
DEFINE porciento,total_cantidad_ant,total_cantidad,ordenada,recibida,
cantidad1,cant_e,devuelto,r_cantidad1,devuelto1,r_cantidad,
cantidad_1_ant DECIMAL(12,2)
DEFINE codigo_ant ARRAY[100] OF CHAR(7)
DEFINE devuelta,cerrada,actualiza CHAR(1)
#WHENEVER ERROR CONTINUE
LET int_flag = false
LET existe = null
## Aqui se prepara para la captura del criterio de seleccion
CLEAR FORM
CONSTRUCT criterio ON a.cod_mov,a.num_doc FROM cod_mov,num_doc
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
LET SELEC = " SELECT UNIQUE a.cod_mov,a.num_doc,a.fecha,a.conduce_no, ",
"a.fact_no,a.tipo,a.orden_compra,a.cod_sp,a.cod_sp_sec, ",
"a.depto_a,a.bodega ",
" FROM istb00006 a,istb00005 b ",
"WHERE ",
criterio clipped,
"and a.cod_mov = b.cod_mov ",
" and a.status_t is null and ",
" a.cod_mov != 99 ",
" ORDER BY 1,2 "
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO movimientos.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
SELECT status_mov,descrip_mov INTO transacc.status_mov,datos_gen.descrip_mov
FROM istb00005
WHERE cod_mov = movimientos.cod_mov
CALL buscame()
DISPLAY BY NAME datos_gen.descrip_mov
DISPLAY BY NAME datos_gen.nom_sp
DISPLAY BY NAME movimientos.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO movimientos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip_mov INTO datos_gen.descrip_mov FROM istb00005
WHERE cod_mov = movimientos.cod_mov
CALL buscame()
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.descrip_mov
DISPLAY BY NAME movimientos.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO movimientos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip_mov INTO datos_gen.descrip_mov FROM istb00005
WHERE cod_mov = movimientos.cod_mov
CALL buscame()
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.descrip_mov
DISPLAY BY NAME movimientos.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO movimientos.*
CALL buscame()
SELECT descrip_mov INTO datos_gen.descrip_mov FROM istb00005
WHERE cod_mov = movimientos.cod_mov
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.descrip_mov
DISPLAY BY NAME movimientos.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO movimientos.*
CALL buscame()
SELECT descrip_mov INTO datos_gen.descrip_mov FROM istb00005
WHERE cod_mov = movimientos.cod_mov
DISPLAY BY NAME datos_gen.nom_sp,datos_gen.descrip_mov
DISPLAY BY NAME movimientos.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
LET cerrada = "N"
LET total_cantidad = 0
LET total_cantidad_ant = 0
INPUT BY NAME movimientos.* WITHOUT DEFAULTS
BEFORE FIELD cod_mov
LET cod_mov_ant = movimientos.cod_mov
AFTER FIELD cod_mov
IF movimientos.cod_mov is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
SELECT descrip_mov INTO otros_mov.descrip_mov FROM
istb00005 where cod_mov = movimientos.cod_mov
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_mov
END IF
DISPLAY BY NAME otros_mov.descrip_mov
NEXT FIELD fecha
AFTER FIELD bodega
IF movimientos.bodega is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD bodega
ELSE
SELECT * FROM istb00009 WHERE cod_bodega = movimientos.bodega
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
END IF
AFTER FIELD fecha
LET p_fechas = movimientos.fecha using "ddmmyy"
CALL prd(p_fechas)
IF bandera = 1 THEN
LET bandera = 0
NEXT FIELD fecha
END IF
AFTER FIELD depto_de
IF movimientos.depto_de is not null THEN
SELECT nom_dpto INTO datos.nom_dpto FROM adtb00001
WHERE departamento = movimientos.depto_de and
status_t is null
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD depto_de
END IF
END IF
DISPLAY BY NAME datos.nom_dpto
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
EXIT INPUT
END INPUT
DECLARE buscate CURSOR FOR
SELECT b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_sec,c.cantidad_1,c.cantidad_2,
b.unidad_med,b.descrip_esp
FROM istb00006 c,intb00001 b
WHERE c.num_doc = movimientos.num_doc and
c.cod_mov = cod_mov_ant and
c.cod_n = b.cod_n and
c.cod_grupo = b.cod_grupo and
c.cod_tipo = b.cod_tipo and
c.cod_sec = b.cod_sec AND
c.status_t is null
LET idx = 1
FOREACH buscate INTO movi[idx].*
IF movi[idx].cantidad_2 < 0 THEN
LET movi[idx].cantidad_2 = movi[idx].cantidad_2 * -1
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx -1)
INPUT ARRAY movi WITHOUT DEFAULTS FROM s_movi1.*
ON KEY(CONTROL-B)
LET p_act = arr_curr()
LET scr_l = scr_line()
SELECT existencia INTO chequea.existe FROM istb00002
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF transacc.status_mov = "1" THEN
IF movi[p_act].cantidad_2 > chequea.existe THEN
LET numero_msg = 6
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
UPDATE istb00006 set us_mod = user,
fech_mod = current,
status_t = "E"
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
num_doc = movimientos.num_doc and
cod_mov = movimientos.cod_mov
SELECT sum(cantidad_2) INTO chequea.existe FROM istb00006
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
status_t is null
UPDATE istb00002 set existencia = chequea.existe
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
CALL limpia()
LET numero_msg = 39
CALL msg(numero_msg)
NEXT FIELD cod_n
BEFORE FIELD cantidad_2
IF movimientos.cod_mov != 38 THEN
IF numero_msg != 30 THEN
LET movi_ant[p_act].cant_ant = movi[p_act].cantidad_2
END IF
END IF
BEFORE ROW
LET p_Act = arr_curr()
LET codigo_ant[p_act] = movi[p_act].cod_n using "&",
movi[p_act].cod_grupo using "&",
movi[p_act].cod_tipo using "&&",
movi[p_act].cod_sec using "&&&"
LET movi_ant[p_act].cant_ant = movi[p_Act].cantidad_2
# Chequeo si es un reporte de entrada para mandar la secuencia del porgrama a
# La Cantidad Recibida
IF movimientos.cod_mov = 34 or movimientos.cod_mov = 35 THEN
NEXT FIELD cantidad_2
END IF
# Chequeo si es una devolucion para mandar la secuencia del porgrama a
# La Cantidad devuelta
IF movimientos.cod_mov = 38 THEN
NEXT FIELD cantidad_2
END IF
AFTER FIELD cod_n
LET scr_l = scr_line()
LET p_Act = arr_curr()
LET ya = "N"
CALL repetir()
IF existe = "S" THEN
NEXT FIELD cod_grupo
LET existe = "N"
END IF
AFTER FIELD cod_grupo
IF movi[p_act].cod_grupo is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET ya = "N"
CALL repetir()
IF existe = "S" THEN
NEXT FIELD cod_tipo
LET existe = "N"
END IF
AFTER FIELD cod_tipo
IF movi[p_act].cod_tipo is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET ya = "N"
CALL repetir()
IF existe = "S" THEN
NEXT FIELD cod_sec
LET existe = "N"
END IF
AFTER FIELD cod_sec
IF movi[p_act].cod_sec is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
IF movi[p_act].cod_n is null AND movi[p_act].cod_grupo is null AND
movi[p_act].cod_tipo is null AND movi[p_act].cod_sec is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
LET ya = "N"
CALL repetir()
IF existe = "S" THEN
LET existe = "N"
NEXT FIELD cod_n
END IF
SELECT a.descrip_esp ,a.unidad_med
INTO articulos.descrip_esp ,articulos.unidad_med
FROM intb00001 a
WHERE a.cod_n = movi[p_act].cod_n and
a.cod_grupo = movi[p_act].cod_grupo and
a.cod_tipo = movi[p_act].cod_tipo and
a.cod_sec = movi[p_act].cod_sec and
a.status_t is null
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT status_t INTO articulos.status_t FROM istb00006
WHERE
cod_n = movi[p_act].cod_n AND
cod_grupo = movi[p_act].cod_grupo AND
cod_tipo = movi[p_act].cod_tipo AND
cod_sec = movi[p_act].cod_sec and
num_doc = movimientos.num_doc and
cod_mov = movimientos.cod_mov and
status_t = "E"
IF status != notfound THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
CLEAR FORM
RETURN
END IF
END IF
LET movi[p_act].descrip_esp = articulos.descrip_esp
LET movi[p_act].unidad_med = articulos.unidad_med
DISPLAY movi[p_act].descrip_esp TO s_movi1[scr_l].descrip_esp
ATTRIBUTE (BOLD)
DISPLAY movi[p_act].unidad_med TO s_movi1[scr_l].unidad_med
ATTRIBUTE (BOLD)
END IF
BEFORE FIELD cantidad_1
IF movimientos.cod_mov = 38 THEN
NEXT FIELD cantidad_2
END IF
AFTER FIELD cantidad_2
IF movi[p_act].cantidad_2 < 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad_2
END IF
# Chequea la existencia cuando el movimiento es de salida para
# que por medio a la modificacion no ponga la existencia en negativa
IF transacc.status_mov = "2" THEN
SELECT existencia,pto_reorden INTO chequea.existe,chequea.pto
FROM istb00002
WHERE cod_n = movi[p_act].cod_n AND
cod_grupo = movi[p_act].cod_grupo AND
cod_tipo = movi[p_act].cod_tipo AND
cod_sec = movi[p_act].cod_sec
LET cantidad1 = (chequea.existe + movi_ant[p_act].cant_ant)
IF movi[p_act].cantidad_2 > cantidad1 THEN
LET numero_msg = 30
CALL msg(numero_msg)
LET numero_msg = 30
NEXT FIELD cantidad_2
END IF
IF cantidad1 <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
END IF
END IF
# Verifica que la cantidad recibida mas las que se han recibida de
# la orden no exceda de un 10% de la cantidad total de la orden
IF movi[p_act].cantidad_2 IS NOT NULL THEN
IF transacc.status_mov = "1" THEN
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE orden_compra = movimientos.orden_compra and
tipo = movimientos.tipo and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
SELECT cantidad INTO ordenada FROM cotb00015
WHERE num_oc = movimientos.orden_compra and
tipo = movimientos.tipo and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
LET recibida = recibida - movi_ant[p_act].cant_ant
+ movi[p_act].cantidad_2
LET r_cantidad = ordenada + porciento
IF recibida > r_cantidad THEN
LET numero_msg = 28
CALL msg(numero_msg)
NEXT FIELD cantidad_2
END IF
END IF
END IF
IF movi[p_act].cantidad_2 < 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad_2
END IF
IF movimientos.cod_mov = 38 THEN
IF movi[p_act].cantidad_2 is not null THEN
SELECT pto_reorden,existencia INTO chequea.* FROM istb00002
WHERE
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec and
status_t is null
CALL integridad()
if bandera = 1 THEN
CLEAR SCREEN
RETURN
end if
IF movi[p_act].cantidad_2 > chequea.existe THEN
LET numero_msg = 30
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET cantidad1 = chequea.existe - movi[p_act].cantidad_2
IF cantidad1 <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
LET cant = 0
END IF
# Verifica que la cantidad recibida mas las que se han recibida de
# la orden no exceda de un 10% de la cantidad total de la orden
SELECT sum(cantidad_2) INTO devuelto FROM istb00006
WHERE orden_compra = movimientos.orden_compra and
tipo = movimientos.tipo and
cod_n = movi[p_act].cod_n and
cod_grupo = movi[p_act].cod_grupo and
cod_tipo = movi[p_act].cod_tipo and
cod_sec = movi[p_act].cod_sec
IF devuelto is null THEN
LET numero_msg = 73
CALL msg(numero_msg)
NEXT FIELD cantidad_2
END IF
LET devuelto = devuelto + movi_ant[p_act].cant_ant
IF movi[p_act].cantidad_2 > devuelto THEN
LET numero_msg = 33
CALL msg(numero_msg)
NEXT FIELD cantidad_2
END IF
END IF
IF transacc.status_mov != "1" THEN
IF movi[p_act].cantidad_2 > cantidad1 THEN
LET numero_msg = 30
CALL msg(numero_msg)
LET numero_msg = 30
NEXT FIELD cantidad_2
END IF
END IF
IF cantidad1 <= chequea.pto THEN
LET numero_msg = 31
CALL msg(numero_msg)
END IF
END IF
BEFORE FIELD cantidad_1
IF movimientos.cod_mov != 34 AND movimientos.cod_mov != 35 AND
movimientos.cod_mov != 38 AND movimientos.cod_mov != 36 AND
movimientos.cod_mov != 48 THEN
NEXT FIELD cantidad_2
END IF
AFTER INPUT
#### Verifica si el usuario presiono la tecla <Supr>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
{IF movi[p_act].cod_n is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_grupo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_tipo is null THEN
CALL limpia()
END IF
IF movi[p_act].cod_sec is null THEN
CALL limpia()
END IF}
IF movi3[p_act].codigo = codigo_ant[p_act] THEN
FOR idx = 1 to arr_count()
# Suma La cantidad total del arreglo para este documento para saber si
# la orden se cierra con esta cantidad o no
IF movi[idx].cantidad_2 is not null THEN
LET total_cantidad = total_cantidad + movi[idx].cantidad_2
LET total_cantidad_ant = total_cantidad_ant + movi_ant[idx].cant_ant
END IF
LET movi_ant[idx].cod_n = movi[idx].cod_n
LET movi_ant[idx].cod_grupo = movi[idx].cod_grupo
LET movi_ant[idx].cod_tipo = movi[idx].cod_tipo
LET movi_ant[idx].cod_sec = movi[idx].cod_sec
END FOR
END IF
EXIT INPUT
END INPUT
# Actualizacion de la orden de compra cuando se devuelve mateial
IF movimientos.cod_mov = 38 THEN
UPDATE cotb00014 set cierre = "N"
WHERE num_oc = movimientos.orden_compra
and tipo = movimientos.tipo
END IF
IF movimientos.cod_mov = 34 or movimientos.cod_mov = 35 THEN
SELECT sum(cantidad_2) INTO recibida FROM istb00006
WHERE orden_compra = movimientos.orden_compra
and tipo = movimientos.tipo
SELECT sum(cantidad) INTO ordenada FROM cotb00015
WHERE num_oc = movimientos.orden_compra
and tipo = movimientos.tipo
IF recibida is null THEN
LET recibida = 0
END IF
IF ordenada is null THEN
LET ordenada = 0
END IF
LET porciento = ordenada * 0.10
LET recibida = recibida - total_cantidad_ant + total_cantidad
LET r_cantidad = ordenada - porciento
LET r_cantidad1 = ordenada + porciento
IF recibida >= r_cantidad and recibida <= r_cantidad1 THEN
LET cerrada = "S"
END IF
IF cerrada = "S" THEN
UPDATE cotb00014 set cierre = cerrada
WHERE num_oc = movimientos.orden_compra
and tipo = movimientos.tipo
END IF
END IF
FOR idx = 1 TO arr_count()
LET movi3[idx].codigo = movi[idx].cod_n using "&",
movi[idx].cod_grupo using "&",
movi[idx].cod_tipo using "&&",
movi[idx].cod_sec using "&&&" CLIPPED
LET actualiza = "S"
IF movi[idx].cod_n is not null or movi[idx].cod_grupo is not null or
movi[idx].cod_tipo is not null or movi[idx].cod_sec is not null THEN
IF transacc.status_mov = "2" THEN
LET movi[idx].cantidad_2 = movi[idx].cantidad_2 * -1
END IF
SELECT * FROM istb00006
WHERE cod_n = movi[idx].cod_n and
cod_grupo = movi[idx].cod_grupo and
cod_tipo = movi[idx].cod_tipo and
cod_sec = movi[idx].cod_sec and
num_doc = movimientos.num_doc and
cod_mov = cod_mov_ant and
status_t is null
IF STATUS = NOTFOUND THEN
INSERT INTO istb00006
(cod_mov,num_doc,fecha,conduce_no,fact_no,
tipo,orden_compra,cod_sp,cod_sp_sec,depto_de,
bodega,cod_n,cod_grupo,cod_tipo,cod_sec,
cantidad_1,cantidad_2,us_mod,fech_mod)
VALUES (movimientos.*,movi[idx].cod_n,movi[idx].cod_grupo,
movi[idx].cod_tipo,movi[idx].cod_sec,movi[idx].cantidad_1,
movi[idx].cantidad_2,user,current)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET actualiza = "N"
END IF
UPDATE istb00006 SET cod_mov = movimientos.cod_mov,
fecha = movimientos.fecha,
conduce_no = movimientos.conduce_no,
fact_no = movimientos.fact_no,
tipo = movimientos.tipo,
orden_compra = movimientos.orden_compra,
depto_de = movimientos.depto_de,
cantidad_1 = movi[idx].cantidad_1,
cantidad_2 = movi[idx].cantidad_2,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = movi[idx].cod_n AND
cod_grupo = movi[idx].cod_grupo AND
cod_tipo = movi[idx].cod_tipo AND
cod_sec = movi[idx].cod_sec and
num_doc = movimientos.num_doc and
cod_mov = cod_mov_ant and
bodega = movimientos.bodega
IF movi[idx].cantidad_2 < 0 THEN
LET movi[idx].cantidad_2 = movi[idx].cantidad_2 * -1
END IF
IF movi3[idx].codigo = codigo_ant[idx] THEN
IF transacc.status_mov = "1" THEN
UPDATE istb00002 SET existencia = (existencia - movi_ant[idx].cant_ant) +
movi[idx].cantidad_2
WHERE cod_n = movi[idx].cod_n AND
cod_grupo = movi[idx].cod_grupo AND
cod_tipo = movi[idx].cod_tipo AND
cod_sec = movi[idx].cod_sec and
bodega = movimientos.bodega
ELSE
UPDATE istb00002 SET existencia = (existencia + movi_ant[idx].cant_ant) -
movi[idx].cantidad_2
WHERE cod_n = movi[idx].cod_n AND
cod_grupo = movi[idx].cod_grupo AND
cod_tipo = movi[idx].cod_tipo AND
cod_sec = movi[idx].cod_sec and
bodega = movimientos.bodega
END IF
END IF
IF movi3[idx].codigo != codigo_ant[idx] THEN
IF transacc.status_mov = "1" THEN
UPDATE istb00002 SET existencia = existencia - movi_ant[idx].cant_ant
WHERE cod_n = movi_ant[idx].cod_n AND
cod_grupo = movi_ant[idx].cod_grupo AND
cod_tipo = movi_ant[idx].cod_tipo AND
cod_sec = movi_ant[idx].cod_sec and
bodega = movimientos.bodega
UPDATE istb00002 SET existencia = existencia + movi[idx].cantidad_2
WHERE cod_n = movi[idx].cod_n AND
cod_grupo = movi[idx].cod_grupo AND
cod_tipo = movi[idx].cod_tipo AND
cod_sec = movi[idx].cod_sec and
bodega = movimientos.bodega
ELSE
UPDATE istb00002 SET existencia = existencia + movi_ant[idx].cant_ant
WHERE cod_n = movi_ant[idx].cod_n AND
cod_grupo = movi_ant[idx].cod_grupo AND
cod_tipo = movi_ant[idx].cod_tipo AND
cod_sec = movi_ant[idx].cod_sec and
bodega = movimientos.bodega
UPDATE istb00002 SET existencia = existencia - movi[idx].cantidad_2
WHERE cod_n = movi[idx].cod_n AND
cod_grupo = movi[idx].cod_grupo AND
cod_tipo = movi[idx].cod_tipo AND
cod_sec = movi[idx].cod_sec and
bodega = movimientos.bodega
END IF
END IF
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION buscame()
IF movimientos.cod_sp is not null THEN
SELECT nom_sp INTO datos_gen.nom_sp FROM cotb00001
WHERE cod_sp = movimientos.cod_sp and
cod_sp_sec = movimientos.cod_sp_sec
END IF
END FUNCTION
FUNCTION repetir()
LET ant_art.cod_n = movi[p_act].cod_n
LET ant_art.cod_grupo = movi[p_act].cod_grupo
LET ant_art.cod_tipo = movi[p_act].cod_tipo
LET ant_art.cod_sec = movi[p_act].cod_sec
FOR idx = 1 TO arr_count()
IF idx != p_act THEN
IF movi[idx].cod_n = ant_art.cod_n AND
movi[idx].cod_grupo = ant_art.cod_grupo AND
movi[idx].cod_tipo = ant_art.cod_tipo AND
movi[idx].cod_sec = ant_art.cod_sec THEN
LET numero_msg = 21
CALL msg(numero_msg)
LET existe = "S"
LET ya = "S"
ELSE
IF ya = "N" THEN
LET existe = "N"
END IF
END IF
END IF
END FOR
END FUNCTION
PROYECTOS/isdir/isprrp002.4gl
+244
View File
@@ -0,0 +1,244 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP002
OBJETIVO : CATALOGO DE SUMINISTRO
PROGRAMADOR : Ing. Juan Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp002()
DEFINE idx_c SMALLINT
DEFINE salir CHAR(1)
DEFINE mes CHAR(2)
DEFINE materia RECORD
cod_n LIKE istb00002.cod_n,
cod_grupo LIKE istb00002.cod_grupo,
cod_tipo LIKE istb00002.cod_tipo,
cod_sec LIKE istb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
existencia LIKE istb00002.existencia,
pto_reorden LIKE istb00002.pto_reorden,
dia_llegada LIKE istb00002.dia_llegada,
cod_nab LIKE istb00002.cod_nab,
bodega LIKE istb00002.bodega ,
unidad_med LIKE intb00001.unidad_med,
base LIKE istb00002.base,
costo LIKE istb00013.costo_st
END RECORD,
cod smallint
DEFINE select_cost CHAR(1000)
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
fecha CHAR(2),
costo LIKE istb00013.costo_st
END RECORD
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM isfmrp002 FROM "isfmrp002"
DISPLAY FORM isfmrp002
CALL pantalla()
DISPLAY "isprrp002" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Catalogo de Suministros" AT 6,28 ATTRIBUTE(BLACK)
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
INPUT BY NAME decide
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER FIELD decide
IF decide IS NULL THEN
NEXT FIELD decide
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
CONSTRUCT BY NAME criterio ON a.cod_grupo,
a.cod_tipo,a.cod_sec
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DISPLAY " "
AT 19,14
IF decide = "A" THEN
LET SELEC =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" a.existencia,a.pto_reorden,a.dia_llegada,a.cod_nab, ",
" a.bodega,b.unidad_med,a.base ",
"FROM istb00002 a, intb00001 b ",
"WHERE a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND a.cod_sec = b.cod_sec AND ",
" a.cod_n = 2 AND ",
" a.status_t is NULL AND ",criterio clipped,
" ORDER BY 5"
ELSE
LET SELEC =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" a.existencia,a.pto_reorden,a.dia_llegada,a.cod_nab,",
" a.bodega,b.unidad_med,a.base ",
"FROM istb00002 a, intb00001 b ",
"WHERE a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND a.cod_sec = b.cod_sec AND ",
" a.cod_n = 2 AND ",
" a.status_t is NULL AND ",criterio clipped,
" ORDER BY 1,2,3,4"
END IF
DISPLAY "<< Estoy Buscando Los Suministros. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
display "opdeodod"
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion
DISPLAY " "
AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
START REPORT maestra TO archivo
FOREACH accion INTO materia.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
OUTPUT TO REPORT maestra(materia.*)
END FOREACH
FINISH REPORT maestra
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT maestra(x)
DEFINE x RECORD
cod_n LIKE istb00002.cod_n,
cod_grupo LIKE istb00002.cod_grupo,
cod_tipo LIKE istb00002.cod_tipo,
cod_sec LIKE istb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
existencia LIKE istb00002.existencia,
pto_reorden LIKE istb00002.pto_reorden,
dia_llegada LIKE istb00002.dia_llegada,
cod_nab LIKE istb00002.cod_nab,
bodega LIKE istb00002.bodega,
unidad_med LIKE intb00001.unidad_med,
base LIKE istb00002.base,
costo LIKE istb00013.costo_st
END RECORD
DEFINE l SMALLINT
DEFINE hora CHAR(5)
DEFINE varia CHAR(19)
OUTPUT
LEFT MARGIN 2
FORMAT
PAGE HEADER
LET hora = time
PRINT COLUMN 1, letras.comp_on
PRINT COLUMN 1, "isprrp002",
COLUMN 48, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 135, "Pag. ",
COLUMN 140, pageno using "###"
PRINT COLUMN 1,
COLUMN 51, "Sistema de Inventario de Suministro",
COLUMN 135, today using "dd/mm/yyyy"
PRINT COLUMN 1,
COLUMN 56, "Catalogo de Suministro",
COLUMN 138, hora
IF decide = "N" THEN
LET varia = "N u m e r i c o" #clipped
ELSE
LET varia = "A l f a b e t i c o"
END IF
LET l = (142 - LENGTH(varia)) / 2
PRINT COLUMN l, varia
# ESTA LINEA TIENE 50 GUIONES
PRINT COLUMN 1, letras.comp_on
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"------------------------------------------"
PRINT COLUMN 76, "Punto",
COLUMN 93, "Base De",
COLUMN 105, "Dia de"
PRINT COLUMN 1, "Nivel",
COLUMN 15, "Descripcion",
COLUMN 59, "Existencia",
COLUMN 76, "Reorden ",
COLUMN 93, "Cotizacion",
COLUMN 105, "Llegada",
COLUMN 120, "Arancel",
COLUMN 131, "Bodega"
# ESTA LINEA TIENE 50 GUIONES
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"------------------------------------------"
ON EVERY ROW
PRINT COLUMN 1, x.cod_n USING "&","-",
COLUMN 3, x.cod_grupo USING "&","-",
COLUMN 5, x.cod_tipo USING "&&","-",
COLUMN 8, x.cod_sec USING "&&&",
COLUMN 15, x.descrip_esp,
COLUMN 46, x.unidad_med,
COLUMN 53, x.existencia USING "##,###.##",
COLUMN 70, x.pto_reorden USING "##,###.##",
COLUMN 88, x.base using "##,###,###.##",
COLUMN 105, x.dia_llegada USING "###",
COLUMN 116, x.cod_nab clipped,
COLUMN 135, x.bodega USING "&&"
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 3, "Total de Registros Impresos = ", count(*) USING "####"
PRINT COLUMN letras.comp_off
END REPORT
PROYECTOS/isdir/isprrp003.4gl
+232
View File
@@ -0,0 +1,232 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP003
OBJETIVO : REPORTE DE MOVIMIENTOS
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp003()
DEFINE idx_b SMALLINT
DEFINE salir CHAR(1)
DEFINE transacc RECORD
cod_n LIKE istb00002.cod_n,
cod_grupo LIKE istb00002.cod_grupo,
cod_tipo LIKE istb00002.cod_tipo,
cod_sec LIKE istb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
fecha LIKE istb00006.fecha,
num_doc LIKE istb00006.num_doc,
cod_mov LIKE istb00006.cod_mov,
descrip_mov CHAR(30),
cantidad_2 LIKE istb00006.cantidad_2
END RECORD
DEFINE codigo_ant RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT
END RECORD
DEFINE balances RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE istb00006.cantidad_2
END RECORD
DEFINE select_balan CHAR(1000)
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmrp003 FROM "isfmrp003"
DISPLAY FORM isfmrp003
CALL pantalla()
DISPLAY "isprrp003" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Movimientos" AT 6,34 ATTRIBUTE(BLACK)
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*,archivo
IF int_flag != 0 THEN
let numero_msg = 2
CALL msg(numero_msg)
SLEEP 1
LET int_flag = 0
RETURN
END IF
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER INPUT
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
CLEAR SCREEN
RETURN
END IF
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM cod_n,cod_grupo,cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
LET select_balan =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" b.unidad_med,a.fecha,a.num_doc,a.cod_mov,c.descrip_mov, ",
" a.cantidad_2 ",
"FROM istb00006 a,intb00001 b,istb00005 c ",
"WHERE a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND a.cod_sec = b.cod_sec AND ",
criterio clipped," AND a.cod_mov=c.cod_mov AND a.status_t IS NULL AND ",
" a.fecha BETWEEN ? AND ? "
DISPLAY "<< Buscando Informacion ... Espere Por Favor"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca_balan FROM select_balan
DECLARE accion SCROLL CURSOR FOR busca_balan
OPEN accion USING datos_cons.fech_in,datos_cons.fech_fi
START REPORT reporte3 TO archivo
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
WHILE STATUS != NOTFOUND
FETCH accion INTO transacc.*
IF status = notfound THEN
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT WHILE
END IF
OUTPUT TO REPORT reporte3(transacc.*)
END WHILE
FINISH REPORT reporte3
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT reporte3(x)
DEFINE x RECORD
cod_n LIKE istb00002.cod_n,
cod_grupo LIKE istb00002.cod_grupo,
cod_tipo LIKE istb00002.cod_tipo,
cod_sec LIKE istb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
fecha LIKE istb00006.fecha,
num_doc LIKE istb00006.num_doc,
cod_mov LIKE istb00006.cod_mov,
descrip_mov CHAR(30),
cantidad_2 LIKE istb00006.cantidad_2
END RECORD,
cantidad DECIMAL(12,2)
DEFINE nombre CHAR(8),
und CHAR(3) ,
primera, busca,imprime CHAR(1),
hora CHAR(5),
balance_in,balan_ini,canti,balance_rp DECIMAL(12,2),
entrada,salida DECIMAL(12,2)
OUTPUT
LEFT MARGIN 0
ORDER BY x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec,x.fecha,x.num_doc
FORMAT
PAGE HEADER
LET hora = time
PRINT letras.doce
PRINT COLUMN 1, "isprrp003",
COLUMN 22, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 93, "Pag. ",
COLUMN 98, pageno using "<&&"
PRINT COLUMN 1,
COLUMN 25, "Sistema de Inventario de Suministros",
COLUMN 93, today using "dd/mm/yyyy"
PRINT COLUMN 34, "Movimientos",
COLUMN 96, hora
SKIP 2 LINES
PRINT COLUMN 1, "Desde ",datos_cons.fech_in using "dd/mm/yyyy",
COLUMN 18, "Hasta ",datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 1, "Suministro",
COLUMN 64, "Entradas",
COLUMN 79, "Salidas",
COLUMN 93, "Balance"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
BEFORE GROUP OF x.cod_sec
LET balance_in = 0
SELECT SUM(a.cantidad_2) INTO balance_in FROM istb00006 a
WHERE a.cod_n = x.cod_n AND a.cod_grupo = x.cod_grupo AND
a.cod_tipo = x.cod_tipo AND a.cod_sec = x.cod_sec AND
a.status_t IS NULL AND a.fecha < datos_cons.fech_in
IF balance_in is null THEN
LET balance_in = 0
END IF
LET canti = balance_in
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
" ",x.descrip_esp,
#COLUMN 51, x.unidad_med
COLUMN 73, "Inicial ---> ",
COLUMN 89, balance_in using "---,---,---.##"
ON EVERY ROW
LET salida = null
LET entrada = null
IF x.cantidad_2 > 0 THEN
LET salida = null
LET entrada = x.cantidad_2
ELSE
LET salida = x.cantidad_2
LET entrada = null
END IF
LET canti = canti + x.cantidad_2
PRINT COLUMN 8, x.num_doc USING "&&&&&&"," ",x.fecha USING "dd/mm/yyyy",
COLUMN 24, "(",x.cod_mov using "&&",") ",x.descrip_mov CLIPPED,
COLUMN 59, entrada USING "---,---,---.##",
COLUMN 74, salida USING "---,---,---.##",
COLUMN 89, canti USING "---,---,---.##"
AFTER GROUP OF x.cod_sec
SKIP 1 LINE
END REPORT
PROYECTOS/isdir/isprrp008.4gl
+177
View File
@@ -0,0 +1,177 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP008
OBJETIVO : TIPOS DE MOVIMIENTOS
PROGRAMADOR : Ing. Juan Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp008()
DEFINE tipo RECORD
cod_mov LIKE istb00005.cod_mov,
descrip_mov LIKE istb00005.descrip_mov,
status_mov LIKE istb00005.status_mov,
cuenta_1 LIKE istb00005.cuenta_1,
cuenta_2 LIKE istb00005.cuenta_2,
cuenta_3 LIKE istb00005.cuenta_3
END RECORD
WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM isfmrp008 FROM "isfmrp008"
DISPLAY FORM isfmrp008
CALL pantalla()
DISPLAY "isprrp008" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Tipos de Movimientos" AT 6,30 ATTRIBUTE(BLACK)
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
INPUT BY NAME decide
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER FIELD decide
IF decide IS NULL THEN
NEXT FIELD decide
END IF
END INPUT
CONSTRUCT criterio ON istb00005.cod_mov
FROM cod_mov
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
IF decide = "A" THEN
LET SELEC = "SELECT cod_mov,descrip_mov,status_mov,cuenta_1, ",
"cuenta_2,cuenta_3 ",
" FROM istb00005 ",
" WHERE ",
criterio clipped,
"AND status_t is null ",
" ORDER BY 2"
ELSE
LET SELEC = "SELECT cod_mov,descrip_mov,status_mov,cuenta_1, ",
"cuenta_2,cuenta_3 ",
" FROM istb00005 ",
" WHERE ",
criterio clipped,
"AND status_t is null ",
" ORDER BY 1"
END IF
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DECLARE accion CURSOR FOR busca
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
START REPORT movimiento TO archivo
FOREACH accion INTO tipo.*
IF status = NOTFOUND THEN
EXIT FOREACH
ELSE
OUTPUT TO REPORT movimiento(tipo.*)
END IF
END FOREACH
FINISH REPORT movimiento
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT movimiento(x)
DEFINE x RECORD
cod_mov LIKE istb00005.cod_mov,
descrip_mov LIKE istb00005.descrip_mov,
status_mov LIKE istb00005.status_mov,
cuenta_1 LIKE istb00005.cuenta_1,
cuenta_2 LIKE istb00005.cuenta_2,
cuenta_3 LIKE istb00005.cuenta_3
END RECORD
DEFINE hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 1
FORMAT
PAGE HEADER
LET hora = time
PRINT COLUMN 1 ,letras.doce
PRINT COLUMN 1, "isprrp008",
COLUMN 22, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 93, "Pag. ",
COLUMN 96, pageno using "###"
PRINT COLUMN 1,
COLUMN 25, "Sistema de Inventario de Suministros",
COLUMN 93, today using "dd/mm/yyyy"
PRINT COLUMN 1,
COLUMN 34, "Tipos de Movimientos",
COLUMN 96, hora
SKIP 1 LINE
PRINT COLUMN 1, "----------------------------------------------------",
"-----------------------------------------------"
PRINT COLUMN 1, "Codigo",
COLUMN 9, "Descripcion del Movimiento",
COLUMN 53, "Status",
COLUMN 61, "Cuenta_1",
COLUMN 72, "Cuenta_2",
COLUMN 83, "Cuenta_3"
PRINT COLUMN 1, "----------------------------------------------------",
"-----------------------------------------------"
ON EVERY ROW
PRINT COLUMN 3, x.cod_mov using "<<",
COLUMN 9, x.descrip_mov,
COLUMN 55, x.status_mov,
COLUMN 63, x.cuenta_1,
COLUMN 74, x.cuenta_2,
COLUMN 85, x.cuenta_3
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 3, "Total de Registros Impresos = ", count(*) USING "####"
PRINT COLUMN 3, ASCII 27, ASCII 80
END REPORT
PROYECTOS/isdir/isprrp009.4gl
+246
View File
@@ -0,0 +1,246 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP009
OBJETIVO : REPORTE EXISTENCIAS
PROGRAMADOR : Ing. Juan Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp009()
DEFINE mes CHAR(2)
DEFINE idx_ant,idx_cos,idx_act SMALLINT
DEFINE ano_act CHAR(4)
DEFINE salir,primera CHAR(1)
DEFINE balance_in DECIMAL(12,2)
DEFINE existe RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
base LIKE istb00002.base,
fecha DATE,
cantidad DECIMAL(10,2),
codigo CHAR(10)
END RECORD
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
fecha CHAR(2),
costo_st LIKE istb00013.costo_st
END RECORD
DEFINE actual RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE istb00006.cantidad_2
END RECORD
DEFINE anterior RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
balance LIKE istb00006.cantidad_2
END RECORD
DEFINE select_cost,select_act,select_ant CHAR(1000)
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmrp009 FROM "isfmrp009"
DISPLAY FORM isfmrp009
CALL pantalla()
DISPLAY "isprrp009" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Existencia Anterior y Actual" AT 6,26 ATTRIBUTE(BLACK)
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
LABEL vuelve:
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER INPUT
EXIT INPUT
END INPUT
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
GOTO vuelve
END IF
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
GOTO vuelve
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET ano_act = year(datos_cons.fech_fi)
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM cod_n,cod_grupo, cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET select_cost =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" b.unidad_med,c.base,a.fecha,a.cantidad_2 ",
"FROM istb00006 a,intb00001 b,OUTER istb00002 c ",
"WHERE a.cod_n = b.cod_n and a.cod_grupo = b.cod_grupo and ",
" a.cod_tipo = b.cod_tipo and a.cod_sec = b.cod_sec and ",
" a.cod_n = c.cod_n and a.cod_grupo = c.cod_grupo and ",
" a.cod_tipo = c.cod_tipo and a.cod_sec = c.cod_sec and ",
" a.fecha <= ? AND a.status_t is null AND ",criterio CLIPPED
DISPLAY "<< Buscandi Informacion... Espere Por Favor" AT 19,14
PREPARE busca_costo FROM select_cost
DECLARE accion CURSOR FOR busca_costo
OPEN accion USING datos_cons.fech_fi
START REPORT paul TO archivo
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>" AT 19,14
FOREACH accion INTO existe.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF existe.base IS NULL THEN
LET existe.base = 1
END IF
LET existe.codigo = existe.cod_n USING "&","-",
existe.cod_grupo USING "&","-",
existe.cod_tipo USING "&&","-",
existe.cod_sec USING "&&&"
OUTPUT TO REPORT paul(existe.*)
END FOREACH
FINISH REPORT paul
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT paul(x)
DEFINE x RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
base LIKE istb00002.base,
fecha DATE,
cantidad DECIMAL(10,2),
codigo CHAR(10)
END RECORD
DEFINE costo,total_c,total_p DECIMAL (12,2)
DEFINE hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.codigo,x.fecha
FORMAT
PAGE HEADER
LET hora = time
PRINT letras.negrillas_off,letras.comp_on
PRINT COLUMN 1, "isprrp009",
COLUMN 27, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 100, "Pag. ",pageno using "###"
PRINT COLUMN 27, " Sistema de Inventario de Suministros",
COLUMN 100, today using "dd/mm/yyyy"
PRINT COLUMN 27, " Existencia Anterior y Actual",
COLUMN 103, hora
SKIP 1 LINES
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"-------"
PRINT COLUMN 51, "Existencia",
COLUMN 68, "Existencia",
COLUMN 84, "Costo",
COLUMN 97, "Total"
PRINT COLUMN 1, "Suministro",
COLUMN 51, "Al ",datos_cons.fech_in using "dd/mm/yyyy",
COLUMN 68, "Al ", datos_cons.fech_fi using "dd/mm/yyyy",
COLUMN 84, "Standard",
COLUMN 97, "Al ",datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"-------"
PRINT letras.negrillas_off
BEFORE GROUP OF x.codigo
SELECT MAX(a.costo_st) INTO costo FROM istb00013 a
WHERE a.status_t IS NULL AND a.cod_n = x.cod_n AND
a.cod_grupo = x.cod_grupo AND a.cod_tipo = x.cod_tipo AND
a.cod_sec = x.cod_sec AND a.ano = YEAR(datos_cons.fech_fi) AND
a.mes_fin = 12
IF costo IS NULL THEN
LET costo = 0
END IF
PRINT COLUMN 1, x.codigo," ",x.descrip_esp CLIPPED;
AFTER GROUP OF x.codigo
PRINT COLUMN 48, GROUP SUM(x.cantidad)
WHERE x.fecha <=datos_cons.fech_in
USING "###,###,###.##",
COLUMN 65, GROUP SUM(x.cantidad) USING "###,###,###.##",
COLUMN 81, costo USING "###,###.##",
COLUMN 95, GROUP SUM(x.cantidad) * costo
USING "###,###,###.##"
ON LAST ROW
print letras.negrillas_on
PRINT COLUMN 1,"Total de Registros ---> ",COUNT(*) USING "###,###"
print letras.negrillas_off,letras.comp_off
END REPORT
PROYECTOS/isdir/isprrp010.4gl
+270
View File
@@ -0,0 +1,270 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP010
OBJETIVO : Acumulado por Tipo de Movimiento
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp010()
DEFINE salir CHAR(1)
DEFINE select_ac,select_ant,select_p CHAR(1000)
DEFINE idx_ac,ano,idx_a,idx_c SMALLINT
DEFINE ano_act,c_ano CHAR(4)
DEFINE fecha_2 CHAR(8)
DEFINE fecha_ini_per CHAR(8)
DEFINE acumulado_a RECORD
cod_mov LIKE istb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
consumo LIKE istb00006.cantidad_2
END RECORD
DEFINE acumulado_ac RECORD
cod_mov LIKE istb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
consumo LIKE istb00006.cantidad_2
END RECORD
DEFINE acumulado_m RECORD
cod_mov LIKE istb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
consumo LIKE istb00006.cantidad_2
END RECORD
DEFINE acumulado RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
base LIKE intb00002.base,
cod_mov LIKE istb00006.cod_mov,
fecha DATE,
consumo DECIMAL(10,2)
END RECORD
WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmrp010 FROM "isfmrp010"
DISPLAY FORM isfmrp010
CALL pantalla()
DISPLAY "isprrp010" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Acumulado por Tipo de Movimiento" AT 6,24 ATTRIBUTE(BLACK)
LET tipo_papel = 2
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER FIELD fech_in
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
AFTER FIELD fech_fi
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_fi
END IF
LET ano_act = year(datos_cons.fech_fi) USING "&&&&"
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
CONSTRUCT criterio ON c.cod_mov,c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec
FROM cod_mov,cod_n,cod_grupo, cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET ano = year(datos_cons.fech_fi)
LET ano = ano - 1
LET c_ano = ano USING "&&&&"
LET select_ac =
"SELECT c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec,b.descrip_esp, ",
" b.unidad_med,a.base,c.cod_mov,c.fecha,c.cantidad_2 ",
"FROM istb00006 c,istb00002 a,intb00001 b ",
"WHERE c.cod_n = b.cod_n AND c.cod_grupo = b.cod_grupo AND ",
" c.cod_tipo = b.cod_tipo AND c.cod_sec = b.cod_sec AND ",
" c.cod_n = a.cod_n AND c.cod_grupo = a.cod_grupo AND ",
" c.cod_tipo = b.cod_tipo AND c.cod_sec = a.cod_sec AND ",
criterio clipped," AND c.fecha <= ? AND c.cod_mov != 99 AND ",
" c.status_t is null "
DISPLAY "<< Buscando Informacion ... Espere Por Favor " AT 19,14
PREPARE busca_act FROM select_ac
DECLARE actual CURSOR FOR busca_act
OPEN actual USING datos_cons.fech_fi
DISPLAY " " AT 19,14
START REPORT clase TO archivo
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>" AT 19,14
FOREACH actual INTO acumulado.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF acumulado.consumo IS NULL THEN
LET acumulado.consumo = 0
END IF
IF acumulado.base IS NULL THEN
LET acumulado.base = 1
END IF
OUTPUT TO REPORT clase(acumulado.*,c_ano)
END FOREACH
FINISH REPORT clase
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT clase(x,c_ano1)
DEFINE x RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
base LIKE intb00002.base,
cod_mov LIKE istb00006.cod_mov,
fecha DATE,
consumo DECIMAL(10,2)
END RECORD
DEFINE descrip_mov CHAR(30)
DEFINE c_ano1 char(4)
DEFINE hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.cod_mov,x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec,x.fecha
FORMAT
PAGE HEADER
LET hora = time
PRINT letras.doce
PRINT COLUMN 2, "isprrp010",
COLUMN 28, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 93, "Pag. ",
COLUMN 98, pageno using "###"
PRINT COLUMN 33, "Sistema de Inventario de Suministro",
COLUMN 93, today using "dd/mm/yyyy"
PRINT COLUMN 35, "Acumulado por Tipo de Movimiento",
COLUMN 96, hora
SKIP 1 LINES
PRINT COLUMN 2, "Desde ",datos_cons.fech_in using "dd/mm/yyyy",
COLUMN 21, "Hasta ", datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 65, "Acumulado",
COLUMN 79, "Acumulado Ano",
COLUMN 93, "Porciento de"
PRINT COLUMN 1, "Suministros",
COLUMN 50, "Periodo",
COLUMN 65, "Al ",datos_cons.fech_fi using "dd/mm/yyyy",
COLUMN 79, "Anterior ",c_ano1,
COLUMN 93, "Variacion"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
BEFORE GROUP OF x.cod_mov
SELECT a.descrip_mov INTO descrip_mov FROM istb00005 a
WHERE a.cod_mov = x.cod_mov
PRINT COLUMN 1, "Movimiento",
COLUMN 13, x.cod_mov using "<<",
COLUMN 17, "Descripcion",
COLUMN 30, descrip_mov
skip 1 line
# ON EVERY ROW
AFTER GROUP OF x.cod_sec
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
" ",x.descrip_esp," ",x.unidad_med CLIPPED,
COLUMN 47, GROUP SUM(x.consumo/x.base)
WHERE x.fecha >= datos_cons.fech_in AND
x.fecha <= datos_cons.fech_fi
USING "##,###,###.##",
COLUMN 61, GROUP SUM(x.consumo/x.base) USING "##,###,###.##",
COLUMN 75, GROUP SUM(x.consumo/x.base)
WHERE YEAR(x.fecha) = (c_ano1) USING "##,###,###.##",
COLUMN 89, ((GROUP SUM(x.consumo/x.base)
WHERE x.fecha >= datos_cons.fech_in AND
x.fecha <= datos_cons.fech_fi)/
(GROUP SUM(x.consumo/x.base)
WHERE YEAR(x.fecha) = (c_ano1))-1)*100
USING "#,###.##"," %"
AFTER GROUP OF x.cod_mov
SKIP TO TOP OF PAGE
ON LAST ROW
SKIP 2 LINES
PRINT COLUMN 1, "==================================================",
"==================================================",
"==============================="
PRINT COLUMN 4, "Total Registros Impresos =", count(*) USING "<<<<"
PRINT COLUMN 4, ASCII 27, ASCII 80
END REPORT
PROYECTOS/isdir/isprrp011.4gl
+251
View File
@@ -0,0 +1,251 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP011
OBJETIVO : Acumulado por Tipo de Movimiento
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Octubre 21, 1993
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
FUNCTION isprrp011()
DEFINE salir CHAR(1)
DEFINE select_ac,select_ant,select_p CHAR(1000)
DEFINE idx_ac,ano,idx_a,idx_c SMALLINT
DEFINE ano_act,c_ano CHAR(4)
DEFINE fecha_2 CHAR(8)
DEFINE fecha_ini_per CHAR(8)
DEFINE acumulado_a RECORD
cod_mov LIKE istb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
consumo LIKE istb00006.cantidad_2
END RECORD
DEFINE acumulado_ac RECORD
cod_mov LIKE istb00005.cod_mov,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
consumo LIKE istb00006.cantidad_2
END RECORD
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
mes CHAR(2),
costo LIKE istb00013.costo_st
END RECORD
DEFINE acumulado RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
fecha DATE,
cod_mov LIKE istb00006.cod_mov,
base LIKE istb00002.base,
costo LIKE istb00013.costo_st,
consumo DECIMAL(10,2)
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmrp011 FROM "isfmrp011"
DISPLAY FORM isfmrp011
CALL pantalla()
DISPLAY "isprrp011" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Operaciones Por Movimientos" AT 6,26 ATTRIBUTE(BLACK)
LET tipo_papel = 2
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER FIELD fech_in
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
AFTER FIELD fech_fi
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_fi
END IF
LET c_ano = YEAR(datos_cons.fech_fi) USING "&&&&"
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
CONSTRUCT criterio ON c.cod_mov,c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec
FROM cod_mov,cod_n,cod_grupo,cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET select_ac =
"SELECT c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec,b.descrip_esp, ",
" b.unidad_med,c.fecha,c.cod_mov,a.base,d.costo_st,c.cantidad_2 ",
"FROM istb00006 c,istb00002 a,intb00001 b,OUTER istb00013 d ",
"WHERE c.cod_n=b.cod_n AND c.cod_grupo=b.cod_grupo AND c.cod_tipo=b.cod_tipo ",
" AND c.cod_sec=b.cod_sec AND c.cod_n=a.cod_n AND c.cod_grupo=a.cod_grupo ",
" AND c.cod_tipo=a.cod_tipo AND c.cod_sec=a.cod_sec AND c.cod_n=d.cod_n AND ",
" c.cod_grupo = d.cod_grupo AND c.cod_tipo = d.cod_tipo AND ",
" c.cod_sec=d.cod_sec AND d.mes_fin=12 AND d.ano=? AND ",criterio clipped,
" and c.fecha BETWEEN ? AND ? and c.status_t is NULL and c.cod_mov < 99"
DISPLAY "<< Estoy Buscando Informacion... Espere Por Favor "
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca_ant FROM select_ac
DECLARE actual SCROLL CURSOR FOR busca_ant
OPEN actual USING c_ano,datos_cons.fech_in,datos_cons.fech_fi
DISPLAY " "
AT 19,14
LET ano_act = year(datos_cons.fech_fi)
START REPORT opera TO archivo
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
FOREACH actual INTO acumulado.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF acumulado.base IS NULL THEN
LET acumulado.base = 1
END IF
IF acumulado.costo IS NULL THEN
LET acumulado.costo = 0
END IF
OUTPUT TO REPORT opera(acumulado.*)
END FOREACH
FINISH REPORT opera
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT opera(x)
DEFINE x RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
fecha DATE,
cod_mov LIKE istb00006.cod_mov,
base LIKE istb00002.base,
costo LIKE istb00013.costo_st,
consumo DECIMAL(10,2)
END RECORD
DEFINE descrip_mov CHAR(30)
DEFINE c_ano1 char(4)
DEFINE hora CHAR(5)
DEFINE total_p,total_m DECIMAL(12,2)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.cod_mov,x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec,x.fecha
FORMAT
PAGE HEADER
LET hora = time
PRINT letras.doce
PRINT COLUMN 1, "isprrp011",
COLUMN 28, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 93, "Pag. ",
COLUMN 98, pageno using "###"
PRINT COLUMN 31, "Sistema de Inventario de Suministros",
COLUMN 93, today using "dd/mm/yyyy"
PRINT COLUMN 33, "Operacion por Tipo de Movimiento",
COLUMN 96, hora
SKIP 1 LINES
PRINT COLUMN 2, "Desde ",datos_cons.fech_in using "dd/mm/yyyy",
COLUMN 21, "Hasta ", datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 63, "Costo"
PRINT COLUMN 1, "Suministro",
COLUMN 50, "Cantidad",
COLUMN 63, "Standard",
COLUMN 86, "Total"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
BEFORE GROUP OF x.cod_mov
SELECT a.descrip_mov INTO descrip_mov FROM istb00005 a
WHERE a.cod_mov = x.cod_mov
PRINT COLUMN 1, x.cod_mov using "##"," ",descrip_mov
SKIP 1 LINE
PRINT COLUMN 4, "Suministro Oficina"
LET total_m = 0
AFTER GROUP OF x.cod_sec
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
" ",x.descrip_esp," ",x.unidad_med CLIPPED," ",
COLUMN 46, GROUP SUM(x.consumo/x.base) USING "##,###,###.##",
COLUMN 60, GROUP AVG(x.costo) USING "#,###,###.####",
COLUMN 79, GROUP SUM(x.consumo/x.base)* GROUP AVG(x.costo)
USING "##,###,###.##"
AFTER GROUP OF x.cod_mov
PRINT COLUMN 79, "-------------"
PRINT COLUMN 63, "Total ---->",
COLUMN 79, GROUP SUM(x.consumo/x.base)* GROUP AVG(x.costo)
USING "##,###,###.##"
SKIP TO TOP OF PAGE
END REPORT
PROYECTOS/isdir/isprrp012.4gl
+153
View File
@@ -0,0 +1,153 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP012
FUNCION : Comparativo de la existencia calculada por movimientos y
existencia en la maestra
PROGRAMADOR : Juan Fco. Soto
FECHA : Noviembre 24, 1992.
-------------------------------------------------------------------------------
}
GLOBALS
"isprgb000.4gl"
FUNCTION isprrp012()
DEFINE comparativo RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip_esp CHAR(30),
unidad_med CHAR(3),
base LIKE istb00002.base,
existencia LIKE istb00002.existencia,
movimiento LIKE istb00006.cantidad_2
END RECORD
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 21
OPEN FORM isfmrp012 FROM "isfmrp012"
DISPLAY FORM isfmrp012
CALL pantalla()
DISPLAY "isprrp012" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Comparativo Existencias" AT 6,28 ATTRIBUTE(BLACK)
# OPEN FORM INFMRP012 FROM "isfmrp012"
# DISPLAY FORM INFMRP012
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM cod_n,cod_grupo,cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET selec =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,c.descrip_esp, ",
" c.unidad_med,a.base,a.existencia,sum(b.cantidad_2) ",
"FROM istb00002 a,intb00001 c,istb00006 b ",
"WHERE a.cod_n = b.cod_n and a.cod_grupo = b.cod_grupo and ",
" a.cod_tipo = b.cod_tipo and a.cod_sec = b.cod_sec and ",
" a.cod_n = c.cod_n and a.cod_grupo = c.cod_grupo and ",
" a.cod_tipo = c.cod_tipo and a.cod_sec = c.cod_sec and ",
criterio clipped," GROUP BY 1,2,3,4,5,6,7,8"
DISPLAY "<< Buscando Informacion ... Espere Por Favor. >>" AT 19,14
ATTRIBUTE (REVERSE,BOLD)
PREPARE busca_maestra FROM selec
DECLARE diferencia CURSOR FOR busca_maestra
OPEN diferencia
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>" AT 19,14
ATTRIBUTE (REVERSE)
START REPORT dife TO archivo
FOREACH diferencia INTO comparativo.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
OUTPUT TO REPORT dife(comparativo.*)
END FOREACH
FINISH REPORT dife
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT dife(x)
DEFINE x RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip_esp CHAR(30),
unidad_med CHAR(3),
base LIKE istb00002.base,
existencia LIKE istb00002.existencia,
movimiento LIKE istb00006.cantidad_2
END RECORD,
hora char(5)
OUTPUT
LEFT MARGIN 0
FORMAT
PAGE HEADER
LET hora = time
PRINT COLUMN 1, "isprrp012",
COLUMN 19, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 73, "Pag. ",
COLUMN 76, pageno using "###"
PRINT COLUMN 24, "Sistema de Inventario de Suministros",
COLUMN 73, today using "dd/mm/yyyy"
PRINT COLUMN 20, "Comparativo Existencia Maestra - S/ Movtos.",
COLUMN 76, hora
PRINT COLUMN 1,
"--------------------------------------------------------------------------------"
PRINT COLUMN 50, "Existencia",
COLUMN 69, "Existencia"
PRINT COLUMN 1, "Suministros",
COLUMN 13, "Descripcion",
COLUMN 50, "S/Maestra",
COLUMN 69, "S/Movtos."
PRINT COLUMN 1,
"--------------------------------------------------------------------------------"
ON EVERY ROW
IF x.base IS NULL THEN
LET x.base = 1
END IF
PRINT COLUMN 1, x.cod_n using "&","-",
COLUMN 3, x.cod_grupo using "&","-",
COLUMN 5, x.cod_tipo using "&&","-",
COLUMN 8, x.cod_sec using "&&&",
COLUMN 13, x.descrip_esp,
COLUMN 34, x.unidad_med,
COLUMN 38, x.existencia/x.base using "---,---,---.##",
COLUMN 65, x.movimiento/x.base using "---,---,---.##"
ON LAST ROW
PRINT COLUMN 10, "Total Registros ==> ",count(*) using "#,###"
END REPORT
PROYECTOS/isdir/isprrp013.4gl
+233
View File
@@ -0,0 +1,233 @@
{
-------------------------------------------------------------------------------
PROGRAMA : ISPRRP013
OBJETIVO : Detallado por Tipo de Movimiento Modificado
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Diciembre 13, 1994.
-------------------------------------------------------------------------------
}
GLOBALS "isprgb000.4gl"
DEFINE ventas CHAR(1)
DEFINE salir CHAR(1)
DEFINE select_ac,select_ant,select_p CHAR(1000)
DEFINE idx_ac,ano,idx_a,idx_c SMALLINT
DEFINE ano_act CHAR(4)
DEFINE fecha_1,fecha_2 DATETIME YEAR TO DAY
DEFINE fecha_ini_per CHAR(8)
DEFINE reg_elim RECORD
cod_mov LIKE intb00005.cod_mov,
descripcion CHAR(30),
num_doc INTEGER,
fecha_doc DATE,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
cantidad LIKE vetb00014.cantidad,
descrip_esp CHAR(30),
unidad_med CHAR(3),
fech_crea LIKE intb00006.fech_crea,
fech_mod LIKE intb00006.fech_mod,
status_t LIKE intb00006.status_t
END RECORD
FUNCTION isprrp013()
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM isfmrp013 FROM "isfmrp013"
DISPLAY FORM isfmrp013
CALL pantalla()
DISPLAY "isprrp013" AT 4,3 ATTRIBUTE(RED)
DISPLAY " Documentos Modificados " AT 6,30 ATTRIBUTE(BLACK)
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
CALL defecto(impresor) RETURNING imprime, letras.*, archivo
CONSTRUCT criterio ON c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec
FROM cod_n,cod_grupo,cod_tipo,cod_sec
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER CONSTRUCT
EXIT CONSTRUCT
END CONSTRUCT
INPUT BY NAME fecha_1,fecha_2
ON KEY(CONTROL-P)
CALL busca_printer() RETURNING imprime, letras.*, archivo
AFTER FIELD fecha_1
IF fecha_1 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_1
END IF
AFTER FIELD fecha_2
IF fecha_2 IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_2
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
{LET YEAR(fecha_1) = YEAR(datos_cons.fech_in) USING "yyyy","-",
LET MONTH(fecha_1) = MONTH(datos_cons.fech_in) USING "mm","-",
LET DAY(fecha_1) = DAY(datos_cons.fech_in) USING "dd"
LET YEAR(fecha_2) = YEAR(datos_cons.fech_fi) USING "yyyy","-",
LET MONTH(fecha_2) = MONTH(datos_cons.fech_fi) USING "mm","-",
LET DAY(fecha_2) = DAY(datos_cons.fech_fi) USING "dd"
}
LET selec =
"SELECT c.cod_mov,a.descrip_mov,c.num_doc,c.fecha,c.cod_n,c.cod_grupo, ",
" c.cod_tipo,c.cod_sec,c.cantidad_2,b.descrip_esp,b.unidad_med, ",
" c.fech_crea,c.fech_mod,c.status_t ",
"FROM istb00006 c,intb00001 b,istb00005 a ",
"WHERE c.fech_mod between (?) AND (?) AND ",
" c.us_mod IS NOT NULL AND ",
" c.cod_n = b.cod_n AND c.cod_grupo=b.cod_grupo AND ",
" c.cod_tipo = b.cod_tipo AND c.cod_sec = b.cod_sec AND ",
" c.cod_mov = a.cod_mov AND ",criterio CLIPPED
DISPLAY "<< Estoy Buscando Documentos... Espere Por favor >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE comando FROM selec
DECLARE actual CURSOR FOR COMANDO
OPEN actual USING fecha_1,fecha_2
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
START REPORT reporte_23 TO archivo
WHILE STATUS != NOTFOUND
FETCH actual INTO reg_elim.*
IF STATUS = NOTFOUND THEN
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
DISPLAY "DATOS: ",reg_elim.cod_sec USING "&&&","-",
reg_elim.cantidad USING "##,###,###.##" AT 20,14
OUTPUT TO REPORT reporte_23(reg_elim.*)
END WHILE
FINISH REPORT reporte_23
RUN imprime
CLEAR SCREEN
END FUNCTION
REPORT reporte_23(x)
DEFINE x RECORD
cod_mov LIKE intb00005.cod_mov,
descripcion CHAR(30),
num_doc INTEGER,
fecha_doc DATE,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_Tipo SMALLINT,
cod_Sec SMALLINT,
cantidad LIKE vetb00014.cantidad,
descrip_esp CHAR(30),
unidad_med CHAR(3),
fech_crea LIKE intb00006.fech_crea,
fech_mod LIKE intb00006.fech_mod,
status_t LIKE intb00006.status_t
END RECORD
DEFINE primera CHAR(1)
DEFINE c_ano1 char(4)
DEFINE hora CHAR(5)
DEFINE total_p,total_m DECIMAL(12,2)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 2
ORDER BY x.cod_mov,x.num_doc
FORMAT
PAGE HEADER
LET hora = time
PRINT letras.comp_on
PRINT COLUMN 1, "isprrp013",
COLUMN 28, "R A Y . O . V A C D O M I N I C A N A, S. A.",
COLUMN 91, "Pag. ",
COLUMN 96, pageno using "###"
PRINT COLUMN 28, " Sistema de Inventario de Suministro Oficina",
COLUMN 91, today using "dd/mm/yyyy"
PRINT COLUMN 28, " Operacion de Registros Modificados",
COLUMN 94, hora
SKIP 1 LINE
PRINT COLUMN 2, "Desde ",fecha_1,
" Hasta ",fecha_2
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"--------------------------------------"
PRINT COLUMN 1, "Docto",
COLUMN 10, "Fecha",
COLUMN 22, "Articulo",
COLUMN 80, "Cantidad",
COLUMN 95, "Fecha Creacion",
COLUMN 115, "Fecha Modif.",
COLUMN 133, "Status"
PRINT letras.comp_on
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"--------------------------------------"
BEFORE GROUP OF x.cod_mov
PRINT letras.negrillas_on
PRINT COLUMN 1, x.cod_mov using "##"," ",x.descripcion
PRINT letras.negrillas_off
BEFORE GROUP OF x.num_doc
PRINT COLUMN 1, x.num_doc USING "######",
COLUMN 10, x.fecha_doc USING "dd/mm/yyyy";
ON EVERY ROW
PRINT COLUMN 22, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&"," ",
x.descrip_esp clipped,
COLUMN 75, x.cantidad USING "###,###,###.##",
COLUMN 95, x.fech_crea,
COLUMN 115, x.fech_mod," ",x.status_t
AFTER GROUP OF x.cod_mov
SKIP 1 LINE
PRINT COLUMN 1, "Total Registros Por Movimiento ",
GROUP COUNT(*) USING "###,###"
ON LAST ROW
PRINT letras.normal
END REPORT
PROYECTOS/isdir/isrp.bat
+12
View File
@@ -0,0 +1,12 @@
fgl2p ismnrp000.4gl
fgl2p isprrp002.4gl
fgl2p isprrp003.4gl
fgl2p isprrp008.4gl
fgl2p isprrp009.4gl
fgl2p isprrp010.4gl
fgl2p isprrp011.4gl
fgl2p isprrp012.4gl
fgl2p isprrp013.4gl
fgl2p -o ismnrp000.42r ismnrp000.42m isprrp002.42m isprrp003.42m isprrp008.42m isprrp009.42m isprrp010.42m isprrp011.42m isprrp012.42m isprrp013.42m msg.42m seg000.42m msgrp000.42m
PROYECTOS/isdir/istb02.unl
+1039
View File
File diff suppressed because it is too large Load Diff
PROYECTOS/isdir/menues/ismnmt006.4gl
+72
View File
@@ -0,0 +1,72 @@
{
----------------------------------------------------------------------------
PROGRAMA : ISMNMT06
OBJETIVO : Sub Menu Mantenimiento Movimientos
Inventario de Suministro.
PROGRAMADOR : Juan Fco. Soto (Johnny)
FECHA REALIZACION : Octubre 22, 1993.
----------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA REALIZACION : Marzo 19, 1999.
OBJETIVO : Utilizar COMMAND para los menues de este sistema.
Optimizar el procedimiento de llamadas de programas.
---------------------------------------------------------------------------
}
DATABASE rayovac
DEFINE bandera,numero_msg INTEGER
FUNCTION ismnmt06()
CLEAR SCREEN
CALL opciones_ismnmt006()
END FUNCTION
FUNCTION opciones_ismnmt006()
DEFINE opt CHAR(2)
DEFINE p_user CHAR(9)
DEFINE luz CHAR(5)
OPTIONS
PROMPT LINE 8,
ERROR LINE 24
CALL desplega_mnmt006()
MENU "Mantenimientos: "
COMMAND "1"
CALL seg000(1,"ismnmt006") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\isprmt016()"
CALL desplega_mnmt006()
END IF
COMMAND "2"
CALL seg000(2,"ismnmt006") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\isprmt036()"
CALL desplega_mnmt006()
END IF
COMMAND "3"
CALL seg000(3,"ismnmt006") RETURNING luz
IF luz = "azul" THEN
RUN "fglrun %FGLPROG%\\isprmt056()"
CALL desplega_mnmt006()
END IF
COMMAND "Retornar" "Retorna Menu Principal"
EXIT MENU
END MENU
END FUNCTION
FUNCTION desplega_mnmt006()
CLEAR SCREEN
CALL pantalla()
DISPLAY " Movimientos De Almacen " AT 6,22
DISPLAY "ismnmt006" AT 4,3 ATTRIBUTE(RED)
DISPLAY "1- Suministros Devueltos al Suplidor isprmt016" AT 10,1
DISPLAY "2- Requisicion Suministros isprmt036" AT 11,1
DISPLAY "3- Actualizacion de Documentos isprmt056" AT 12,1
# DISPLAY "R- Retornar Menu Anterior " AT 15,1
# ATTRIBUTE (RED)
END FUNCTION
PROYECTOS/isdir/menues/msg.4gl
+20
View File
@@ -0,0 +1,20 @@
DATABASE rayovac
FUNCTION msg(numero_msg)
DEFINE numero_msg SMALLINT
DEFINE descripcion CHAR (60)
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = numero_msg
IF status = NOTFOUND THEN
LET numero_msg = 22
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = numero_msg
ERROR descripcion ATTRIBUTE(BOLD)
ELSE
ERROR descripcion ATTRIBUTE(BOLD)
LET numero_msg = 0
END IF
END FUNCTION
PROYECTOS/isdir/menues/msgrp000.4gl
+151
View File
@@ -0,0 +1,151 @@
{
Esta funcion se utiliza para dsplegar mensajes de los reportes de
los sistemas de Ray-O-Vac Dominicana.
Realizada por Lic. Abner Montalvo y Johnny Soto Agosto 21, 1992
}
DATABASE rayovac
FUNCTION msgrp000(tipo_papel)
DEFINE tipo_papel SMALLINT,
longitud CHAR(11),
linea_papel CHAR(50)
CASE
WHEN tipo_papel = 1
LET longitud = " 9 1/2 x 11"
WHEN tipo_papel = 2
LET longitud = "14 7/8 x 11"
END CASE
LET linea_papel = "Coloque papel ",longitud," en la impresora."
DISPLAY linea_papel
AT 15,14
DISPLAY
"<Ctrl-P> Elejir Printer Asegurese de que la impresora este encendida."
AT 16,10 ATTRIBUTE(REVERSE,YELLOW)
DISPLAY "<Esc> Ejecuta impresion <Ctrl-C> Cancela impresion"
AT 18,14
END FUNCTION
FUNCTION busca_printer()
DEFINE pcurr,impresor,idx SMALLINT,
negrillas_on,
negrillas_off,
doble_on,
doble_off,
doce,
comp_on,
comp_off,
normal CHAR(6)
DEFINE dspprt ARRAY[10] OF RECORD
nombre CHAR(30),
codigo SMALLINT,
puerto LIKE prttb00001.puerto,
prtcodigo LIKE prttb00001.prtcodigo
END RECORD,
prt RECORD LIKE prttb00001.*,
prtcodigo LIKE prttb00001.prtcodigo
OPEN WINDOW impresoras AT 10,5 WITH FORM "msgfmrp" ATTRIBUTE
(BORDER,FORM LINE FIRST + 1)
DECLARE busca CURSOR FOR
SELECT * FROM prttb00001
ORDER BY 1
LET idx = 1
FOREACH busca INTO prt.*
LET dspprt[idx].nombre = prt.nombre
LET dspprt[idx].codigo = prt.codigo
LET dspprt[idx].puerto = prt.puerto
LET dspprt[idx].prtcodigo = prt.prtcodigo
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY dspprt TO s_prt.*
LET pcurr = arr_curr()
LET impresor = dspprt[pcurr].codigo
LET prtcodigo = dspprt[pcurr].prtcodigo
LET prt.puerto = dspprt[pcurr].puerto
CASE
WHEN prtcodigo = 1
LET doble_on = ASCII 14
LET doble_off = ASCII 18
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 27,ASCII 77
LET normal = ASCII 27,ASCII 80
EXIT CASE
WHEN prtcodigo = 2
LET doble_on = ASCII 001
LET doble_off = ASCII 002
LET negrillas_on = ASCII 027, ASCII 098
LET negrillas_off = ASCII 027, ASCII 099
LET comp_on = ASCII 031
LET comp_off = ASCII 029
LET doce = ASCII 030
LET normal = ASCII 029
EXIT CASE
END CASE
CLOSE WINDOW impresoras
RETURN prt.puerto,negrillas_on,negrillas_off,doble_on,doble_off,comp_on,comp_off,doce, normal
END FUNCTION
FUNCTION defecto(impresor)
DEFINE impresor,idx SMALLINT,
negrillas_on,
negrillas_off,
doble_on,
doble_off,
doce,
comp_on,
comp_off,
normal CHAR(6),
prt RECORD LIKE prttb00001.*
SELECT * INTO prt.* FROM prttb00001 a
WHERE codigo = impresor
CASE
WHEN prt.prtcodigo = 1
LET doble_on = ASCII 14
LET doble_off = ASCII 18
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 27,ASCII 77
LET normal = ASCII 27,ASCII 80
EXIT CASE
WHEN prt.prtcodigo = 2 {Printer Central. Contabilidad}
LET doble_on = ASCII 001
LET doble_off = ASCII 002
LET negrillas_on = ASCII 027, ASCII 098
LET negrillas_off = ASCII 027, ASCII 099
LET comp_on = ASCII 031
LET comp_off = ASCII 029
LET doce = ASCII 030
LET normal = ASCII 029
EXIT CASE
WHEN impresor = 3
LET doble_on = ASCII 14
LET doble_off = ASCII 18
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comp_on = ASCII 15
LET comp_off = ASCII 18
LET doce = ASCII 27,ASCII 77
LET normal = ASCII 27,ASCII 80
EXIT CASE
END CASE
RETURN prt.puerto,negrillas_on,negrillas_off,doble_on,doble_off,
comp_on,comp_off,doce,normal
END FUNCTION
PROYECTOS/isdir/menues/seg000.4gl
+60
View File
@@ -0,0 +1,60 @@
{
-----------------------------------------------------------------------------
PROGRAMA : SEG000
OBJETIVO : Controlar el acceso de los usuarios a los sistemas de la
Empresa.
PROGRAMADOR : Ing. Juan Soto
FECHA : Marzo 17, 1994.
-----------------------------------------------------------------------------
PROGRAMADOR : Lic. Abner Montalvo
FECHA : Marzo 2, 1999
OBJETIVO : Optimizacion de la funcion. No es necesario recibir el parametro
"usuarios" porque el mismo se obtiene de la funcion "user".
Este cambio elimina el select que busca el codigo del usuario en
todos los menues de los sistemas.
-----------------------------------------------------------------------------
}
FUNCTION seg000(opt,p_menu)
DEFINE opt CHAR(2)
DEFINE luz CHAR(4)
DEFINE p_menu CHAR(9)
DEFINE usuarios CHAR(9)
DEFINE no_reg,p_opcion,numero SMALLINT
WHENEVER ERROR CONTINUE
OPTIONS
ERROR LINE 24
LET luz = "azul"
LET p_opcion = opt
SELECT count(*) INTO no_reg FROM seg0001
WHERE usuario = user
IF no_reg = 1 THEN
SELECT opcion INTO p_opcion FROM seg0001
WHERE usuario = user
END IF
IF p_opcion != 99 THEN
SELECT UNIQUE a.usuario FROM seg0001 a
WHERE a.usuario = user and
a.opcion = p_opcion and
a.us_menu = p_menu
IF status = notfound THEN
LET status = 0
LET luz = "roja"
END IF
END IF
IF p_opcion = 99 THEN
LET luz = "azul"
END IF
IF luz = "roja" THEN
ERROR "NO TIENE PERMISO PARA UTILIZAR OPCION"
END IF
RETURN luz
END FUNCTION
PROYECTOS/isdir/menues/termo.4gl
+53
View File
@@ -0,0 +1,53 @@
{
============================================================================
PROGRAMA : TERMOMETRO
OBJETIVO : DESPLEGAR TERMOMETRO PORCENTUAL PARA LOS REPORTES
PROGRAMADOR : JUAN F. SOTO
FECHA : MARZO 10, 1995
============================================================================
}
DATABASE rayovac
GLOBALS
DEFINE cuenta1,p,cuenta SMALLINT
END GLOBALS
FUNCTION termometro(registros,primera)
DEFINE registros INTEGER
DEFINE i,veces SMALLINT
DEFINE porcentaje,vez DECIMAL(8,2)
DEFINE primera CHAR(1)
IF primera = "S" THEN
LET porcentaje = 0
LET primera = "N"
LET p = 27
CALL fgl_drawbox(3,8,19,18)
CALL fgl_drawbox(3,35,19,26)
IF registros <= 33 THEN
FOR i = 1 TO 33
LET cuenta1 = 1
DISPLAY " " AT 20,p ATTRIBUTE(REVERSE,BOLD)
LET p = p + 1
END FOR
END IF
END IF
IF registros > 33 THEN
LET vez = registros / 33
LET veces = vez USING "#####"
IF cuenta >= veces THEN
LET cuenta = 0
IF p <= 58 THEN
DISPLAY " " AT 20,p ATTRIBUTE(REVERSE,BOLD)
END IF
LET p = p + 1
END IF
LET porcentaje = (cuenta1/registros) * 100
DISPLAY porcentaje using "###","%" AT 20,19 ATTRIBUTE(BOLD)
LET cuenta = cuenta + 1
LET cuenta1 = cuenta1 + 1
END IF
END FUNCTION
PROYECTOS/isdir/oscar
+1386
View File
File diff suppressed because it is too large Load Diff
PROYECTOS/isdir/rayovac
View File
PROYECTOS/isdir/rayovac.sch
+6287
View File
File diff suppressed because it is too large Load Diff
PROYECTOS/isdir/termo.4gl
+53
View File
@@ -0,0 +1,53 @@
{
============================================================================
PROGRAMA : TERMOMETRO
OBJETIVO : DESPLEGAR TERMOMETRO PORCENTUAL PARA LOS REPORTES
PROGRAMADOR : JUAN F. SOTO
FECHA : MARZO 10, 1995
============================================================================
}
DATABASE rayovac
GLOBALS
DEFINE cuenta1,p,cuenta SMALLINT
END GLOBALS
FUNCTION termometro(registros,primera)
DEFINE registros INTEGER
DEFINE i,veces SMALLINT
DEFINE porcentaje,vez DECIMAL(8,2)
DEFINE primera CHAR(1)
IF primera = "S" THEN
LET porcentaje = 0
LET primera = "N"
LET p = 27
CALL fgl_drawbox(3,8,19,18)
CALL fgl_drawbox(3,35,19,26)
IF registros <= 33 THEN
FOR i = 1 TO 33
LET cuenta1 = 1
DISPLAY " " AT 20,p ATTRIBUTE(REVERSE,BOLD)
LET p = p + 1
END FOR
END IF
END IF
IF registros > 33 THEN
LET vez = registros / 33
LET veces = vez USING "#####"
IF cuenta >= veces THEN
LET cuenta = 0
IF p <= 58 THEN
DISPLAY " " AT 20,p ATTRIBUTE(REVERSE,BOLD)
END IF
LET p = p + 1
END IF
LET porcentaje = (cuenta1/registros) * 100
DISPLAY porcentaje using "###","%" AT 20,19 ATTRIBUTE(BOLD)
LET cuenta = cuenta + 1
LET cuenta1 = cuenta1 + 1
END IF
END FUNCTION