Este
es un programa que utiliza una funcion la cual se encarga de hacer la explosion
de todos los componentes de un producto terminado, espero sea lo que
necesitas
Saludos
Gerardo Santillana
IT Department
Delphi Mechatronic
Systems
Phone USA (956) 554 5832
Phone MX 01868 8128163
x.5832
-----Original Message-----
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]On Behalf Of Cordova, Genaro
Sent: Tuesday, November 30, 2004 12:44 PM
To: [EMAIL PROTECTED]
Subject: Estructura de un producto terminadoHola Foro,
Alguien Tiene un programa en RPG para hacer la explosi�n de un producto terminado hasta su �ltimo nivel.
Gracias.
THIS MESSAGE MAY CONTAIN INFORMATION THAT IS CONFIDENTIAL AND/OR PROTECTED BY LAW. IF THE READER OF THIS MESSAGE IS NOT THE INTENDED RECIPIENT, YOU ARE HEREBY NOTIFIED THAT ANY DISSEMINATION, DISTRIBUTION, COPYING OR COMMUNICATION OF THIS MESSAGE IS STRICTLY PROHIBITED. IF YOU HAVE RECEIVED THIS COMMUNICATION IN ERROR, PLEASE CONTACT THE SENDER IMMEDIATELY AND DELETE THE MESSAGE. PLEASE NOTE THAT ALTHOUGH WE WILL TAKE ALL COMMERCIALLY REASONABLE EFFORTS TO PREVENT VIRUSES FROM BEING TRANSMITTED FROM OUR SYSTEMS, IT IS THE RESPONSIBILITY OF THE RECIPIENT TO CHECK FOR AND PREVENT ADVERSE ACTION BY VIRUSES ON ITS OWN SYSTEMS .
| **************************************************************************************** Note: The information contained in this message may be privileged and confidential and thus protected from disclosure. If the reader of this message is not the intended recipient, or an employee or agent responsible for delivering this message to the intended recipient, you are hereby notified that any dissemination, distribution or copying of this communication is strictly prohibited. If you have received this communication in error, please notify us immediately by replying to the message and deleting it from your computer. Thank you. **************************************************************************************** |
H DATEDIT(*MDY) OPTION(*NoDebugIo)
� //---------------------------------------------------------------*
� // DELPHI MECHATRONIC SYSTEM *
� // *
� // PROGRAMA......: NAFTA *
� // AUTOR.........: JOSE GERARDO SANTILLANA *
� // FECHA.........: 4 JUNIO 2003 *
� // *
� //---------------------------------------------------------------*
FPxlref3 IF E K DISK
FMbml08 IF E K DISK
[EMAIL PROTECTED] IF E K DISK
FAvml01 IF E K DISK
FIiml01 IF E K DISK
FIiml0x IF E K DISK Rename(Ipi100im:Iimx)
FNAFTATR O E DISK
� //---------------------------------------------------------------*
� //Prototipos
� //---------------------------------------------------------------
D getcost PR extpgm('GETCOST')
D 15
D 15 5
D 15 5
D 15 5
D 15 5
D 15 5
//
D Explode PR
D Level 3 0 value
D Parent 15 value
//
� //---------------------------------------------------------------*
� //Arreglos y Tablas
D Acomp S 98 DIM(200)
Componentes
D Acont S 16 DIM(10)
DUNS# x cont.
� //---------------------------------------------------------------*
� //Estructura de datos
D RNAFTA1 DS
D NDATS1 3 Inz('DMS')
D NMNI 1 Inz('D')
D* NMN 11 Inz('021553417')
US Location
D NMN 11 Inz('812502961')
MX Location
D NPITEM 25
D NRTYPE 1 Inz('1')
D NPPAPL 1
D NPCC 3 Inz('USD')
D NPKI 1 Inz('N')
D NPGFC 15 4
D NPPM 15 4
D NPRM 15 4
D NPCCT 3 0
D NPCV 15 4
D NPNCCF 1
D NPFILL 7
D NPDRD 10
//
D RNAFTA2 DS
D NDATS2 3 Inz('DMS')
D NMNI2 1 Inz('D')
D* NMN2 11 Inz('021553417')
US Location
D NMN2 11 Inz('812502961')
MX Location
D NPITEM2 25
D NRTYPE2 1 Inz('2')
D NCITEM 25
D NCSNI 1 Inz('D')
D NCSN 11
D NCPM 1
D NCEMC 15 4
D NCMSI 1
D NCDRD 10
D DS
D Dfec1 8 0
D Dmes1 1 2 0
D Ddia1 3 4 0
D Da#o1 5 8 0
D DS
D Dfec2 8 0
D Da#o2 1 4 0
D Dmes2 5 6 0
D Ddia2 7 8 0
� //Variables
D Pcost S 15 5
D Pcmat S 15 5
D Pclab S 15 5
D Pcfix S 15 5
D Pcvar S 15 5
D Xbchld S 15
D cp S 3 0
D cc S 2 0
D x S 3 0
D Ppartno S 15
D bequal S N INZ(*ON)
D nelem S 5 0
� //Estructura de datos del sistema
D SDS SDS
D WSID 244 253
D USER 254 263
D PGMNAM *PROC
� //---------------------------------------------------------------
� // Llaves de acceso
� //---------------------------------------------------------------
C KEY1 KLIST
C KFLD xcmpny 2
C KFLD xpartno 15
C *Entry PLIST
C PARM XPARTNO
� //---------------------------------------------------------------
� // MAIN
� //---------------------------------------------------------------
/Free
Exsr R100;
*Inlr=*ON;
� //---------------------------------------------------------------
� // R100 Lee los numeros de parte final y obtiene el "BOM"
� //---------------------------------------------------------------
Begsr R100;
� //
dfec1=*date;
da#o2=da#o1;
dmes2=dmes1;
ddia2=ddia1;
//
� //Lee archivo de requerimientos (Productos finales)
xcmpny='01';
If xpartno<>'';
Setll key1 Pxlref3;
bequal=%Equal;
Else;
Setll *loval Pxlref3;
Endif;
//si no hay error
If bequal;
//
Read Pxlref3;
Dow not %Eof(Pxlref3);
� //limpia campos de data structure
ExSr R200;
Ppartno=Partno;
� //Checa si el # de parte es valido en BPCS
Chain Partno Iiml0x;
If %Found(Iiml0x);
� //Mueve valores a registro a grabar
Npitem=Partno;
� //Obtiene el "Gross factory Cost of Sales"
getcost (Npitem : Pcost : Pcmat : Pclab : Pcfix : Pcvar);
� //Si el costo es =0 no se procesa y lee el sig.
If Pcost <> 0;
Npgfc=Pcost;
Npitem2=Npitem;
� //Obtiene el "Part application", uso final del producto
Select;
When Cabbv='ITRUCK' or Cabbv='FRECAN' or Cabbv='FREIGH' or
Cabbv='MTRUCK' or Cabbv='TRUCKL';
Nppapl='H';
When Cabbv='GMSPO' or %Scan('-C09 ' : Partno)>0 or
%Scan('-C07 ' : Partno)>0 or %Scan('-S ' : Partno)>1;
Nppapl='S';
Other;
Nppapl='L';
EndSl;
� //Obtiene el BOM del numero de parte, inicializa a 1
� //el contador de comp.
cp=1;
Explode (1 : Npitem );
� //checa si el # de parte padre tiene componentes para
grabarlo
If Acomp(1)<>*Blanks;
� //graba registro del # de parte padre
Ndata=Rnafta1;
Write Rnaftr;
� //graba registros de los componentes
ExSr R205;
Endif;
Endif;
EndIf;
� //Lee reg. del mismo numero de parte hasta encontrar el sig. a
procesar
Dow not %Eof(Pxlref3) and Ppartno=Partno;
Read Pxlref3;
EndDo;
If xpartno<>'';
leave;
EndIf;
� //
EndDo;
� //
Endif;
EndSr;
//----------------------------------------------------------
//R200 Limpia variables
//----------------------------------------------------------
BegSr R200;
//
Npitem='';
Nppapl='';
Npgfc=0;
Nppm=0;
Nprm=0;
Npcct=0;
Npcv=0;
Npnccf='';
Npfill='';
Npdrd='';
//
Npitem2='';
Ncitem='';
Ncsn='';
Ncpm='';
Ncemc=0;
Ncmsi='';
Ncdrd='';
EndSr;
//----------------------------------------------------------
//R205 Graba componentes guardados en arreglo ACOMP
//----------------------------------------------------------
BegSr R205;
//
For x=1 to 200;
� //graba mientras el elemento no este en blanco
If Acomp(x)<>*BLANKS;
Ndata=Acomp(x);
Write Rnaftr;
Else;
Leave;
EndIf;
EndFor;
Clear Acomp;
EndSr;
//----------------------------------------------------------
/End-Free
//-----------------------------------------------------------
//Funciones
//-----------------------------------------------------------
P Explode B
D PI
D Level 3 0 value
D Parent 15 value
// Local variables
D EndOfData s 1
D Sincomp s 1
D Saveseq s like(bseq)
D Sblank s like(bmbomm) inz(' ')
D
C BOMKey klist
C kfld Parent
C kfld Sblank
C kfld Saveseq
C
/FREE
Chain Parent Mbml08;
� //Si lo encuentra %Found regresa '1', entonces con NOT le cambia el valor
� //a '0' o viceversa para que entre al DoW y no afecte el ciclo del ReadE
EndOfData= Not %Found(Mbml08);
DoW EndOfData= '0';
� //checa si el componente tiene uso para continuar con el proceso
� //y si la fecha de "Discontinue" es > o = a la fecha actual
� //y si el "Facility" = 04
If bqreq>0 and Bddis >= Dfec2 and bmwhs='04';
Ncitem=Bchld;
Chain Bchld Iiml0x;
If %Found(Iiml0x);
� //Obtiene el costo del componente
getcost(Ncitem : Pcost : Pcmat : Pclab : Pcfix : Pcvar);
DM01d // Eval(H) Ncemc=Pcost*bqreq;
DM01c Eval(H) Ncemc=Pcmat*bqreq;
� //Checa en arch. de contratos para obtener el vendor
� //Contador de contratos
Cc=0;
SetLl Bchld @Hal03;
ReadE Bchld @Hal03;
DoW Not %Eof(@Hal03);
� //Si hay mas de 1 contrato para un # de parte lee todos los
que la
� //fecha "Discontinue" sea mayor o igual a la fecha actual y
obtiene
� //el # de proveedor de cada reg. que cumpla con la condicion
If Hxddat >= Dfec2;
� //Se encadena al archivo de proveedores para obtener
el DUNS#
Chain Hxvend Avml01;
If %Found(Avml01);
� //a peticion del usuario se van a sumar los costos del
� //componente dependiendo del # de proveedores que
tenga
cc=cc+1;
Acont(cc)=Vmfscd;
EndIf;
EndIf;
ReadE Bchld @Hal03;
EndDo;
� //Checa si es "Multiple Supplier"
Select;
When Cc>1;
Ncmsi='M';
Other;
Ncmsi='S'; //Si es 1 o no hay contrato se graba en
blanco el #de supplier
Cc=1; //Se pone en 1 para grabar al menos 1
registro
EndSl;
EndIf;
//
//Guarda la seq. del registro en variable local para que al
terminar
//de buscar sus componentes se posicione en este reg. y lea
el sig.
Saveseq=bseq;
� //graba registro si este componente no tiene subcomponentes
Xbchld=Bchld;
Chain Xbchld Mbml08;
If Not %Found(Mbml08);
//graba registro en arreglo ACOMP por cada elemento en
arreglo Acont
� //Checa el tipo de componente (P)urchase, (R)aw Material
Select;
// se cancela esta linea ya que todos los tipo X, I , P
son comprados
// entonces checo solo los que sean tipo R y el resto
son tipo P
// When Iityp='P' or Iityp='I' or Iityp='X';
// Nppm=Nppm+1;
// Nppm=Nppm+Ncemc;
// Ncpm='P';
When Iityp='R';
// Nprm=Nprm+1;
� //a peticion del usuario se van a sumar los costos del
� //componente dependiendo del # de proveedores que
tenga
Nprm=Nprm+(Ncemc*Cc);
Ncpm='R';
Other;
// Ncpm=Iityp;
Nppm=Nppm+(Ncemc*Cc);
Ncpm='P';
EndSl;
//
For x=1 to Cc;
// If Acont(x)<>*Blanks;
Ncsn=Acont(x);
Acomp(cp)=Rnafta2;
cp=cp+1;
// Else;
// Leave;
// EndIf;
EndFor;
EndIf;
Clear Acont;
//
� //usa recursividad para leer el sig. componente
Explode (Level+1 : Xbchld);
Else;
Saveseq=bseq;
EndIf;
//
SetGt Bomkey Mbml08;
ReadE Parent Mbml08;
EndOfData= %Eof(Mbml08); //Si no lo encuentra o es EOF regresa '1'
EndDo;
/End-Free
