Tweet
Okay im working in an environment where we have multiple companies on one box.
There are some tables (for example inventory) that are in corporate environment
(library) and are shared across comanies with a unique key of company number.
while other tables are unique to companies (for example customer master) and
are kept in that companies library. That said I needed a program to copy a
quote from one company to the other....So I wrote a version of the below code
to do this. It first grabs the incoming library list....then changes the library
list depending on the incoming company number. Then at the end of program it
reads thru all the libraries skipping the system, current and product libraries
and builds a chglibl command with the remaining user library list to return to
the original library list. I guess the point I wanted to share was the
change of the library list on the fly....I will compile this program in its
activation group so as to not be effected by other programs that may do
returns rather than seton *INLR.
There are some tables (for example inventory) that are in corporate environment
(library) and are shared across comanies with a unique key of company number.
while other tables are unique to companies (for example customer master) and
are kept in that companies library. That said I needed a program to copy a
quote from one company to the other....So I wrote a version of the below code
to do this. It first grabs the incoming library list....then changes the library
list depending on the incoming company number. Then at the end of program it
reads thru all the libraries skipping the system, current and product libraries
and builds a chglibl command with the remaining user library list to return to
the original library list. I guess the point I wanted to share was the
change of the library list on the fly....I will compile this program in its
activation group so as to not be effected by other programs that may do
returns rather than seton *INLR.
PHP Code:
the code
//-------------------------------------------------------
// compile with activation group *NEW
//
//-------------------------------------------------------
//
// PROGRAM - OENBE1
// PURPOSE - run Quotes update program(s) after copy
// quote from one company to another.
// WRITTEN -
// AUTHOR -
//
//-------------------------------------------------------
//
// Entry Plist
//
d OENBE1 pr
d InToComp 15 5
d OENBE1 pi
d InToComp 15 5
//
// Program Info
//
d SDS
d @PGM 1 10
d @PARMS 37 39 0
d @MSGDTA 91 170
d @MSGID 171 174
d @JOB 244 253
d @USER 254 263
d @JOB# 264 269 0
//
// Variables
//
d AllLibs s 6 0
d ChrQuote s 7
d cmdlength s 15 5
d cmdstring s 256
d Count s 3 0
d DecQuote s 7 0 inz
d LibraryList s 11 dim(1000)
d LX s 3 0
d OutType s 1
d skiplibs s 3 0
d str s 9 0
//
// External Calls
//
d $GetLibList PR ExtPgm('QUSRJOBI')
d RcvVar 32767 Options(*VarSize)
d LengthRcv 10I 0 Const
d FormatName 8A Const
d QualJobName 26 Const
d InternalJobId 16 Const
d Error_ds 15
//
// Data Structures
//
d ds_job10700 Ds 32767
d BYTRTN 10i 0
d BYTVAL 10i 0
d QJOBNM 9 34
d JOBNAM 9 18
d USRNAM 19 28
d JOBNBR 29 34
d INTID 35 50
d JOBSTS 51 60
d JOBTYP 61 61
d SUBTYP 62 62
d RESRV 63 64
d SYSLIB 10i 0
d PRDLIB 10i 0
d CURLIB 10i 0
d USRLIB 10i 0
d LIB1 81 2000
d ds_Error Ds 15
d BytesProvided 10I 0 inz(%size(ds_Error))
d BytesAvail 10I 0
d ErrorId 7
//
// External Calls
//
d $command pr extpgm('QCMDEXC')
d command 5000 options(*varsize)
d Length 15 5
d $oen32 pr extpgm('OEN32')
d Type 1 const
d Quote# 7 const
d QuoteLine# 3 options(*nopass)
d $oen33 pr extpgm('OEN33')
d Type 1 const
d Quote# 7 const
d $oen43 pr extpgm('OEN43')
d Quote# 7 const
d Type 1 const
d $oen06 pr extpgm('OEN06')
d Type 1 const
d DecQuote# 7 0 const
d $oen141 pr extpgm('OEN141')
d Type 1 const
d DecQuote# 7 0 const
d $oen142 pr extpgm('OEN142')
d Type 1 const
d DecQuote# 7 0 const
d $oen13 pr extpgm('OEN13')
d Type 1 const
d DecQuote# 7 0 const
d $oen131 pr extpgm('OEN131')
d Type 1 const
d DecQuote# 7 0 const
d $oen10 pr extpgm('OEN10')
d Type 1 const
d DecQuote# 7 0 const
d $oen23 pr extpgm('OEN23')
d Type 1 const
d DecQuote# 7 0 const
d $oen161 pr extpgm('OEN161')
d Type 1 const
/Free
//------------------------------------------------
// C a l c u l a t i o n S p e c s
//------------------------------------------------
$getLibList(ds_job10700:%Size(ds_job10700):'JOBI0700'
:'*' : *Blanks : ds_Error);
AllLibs = (SysLib + PrdLib + CurLib + UsrLib);
SkipLibs = (SysLib + PrdLib + CurLib);
str = 1;
for count = 1 to AllLibs;
LX +=1;
if %subst(LIB1:str:11) <> *blanks;
libraryList(LX) = %subst(LIB1:str:11);
endif;
str += 11;
endfor;
select;
when InToComp = 15;
cmdstring = 'RMVLIBLE LBIQUOTES';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'RMVLIBLE LBIOBJ';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'RMVLIBLE LBIFIL';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE LBIOBJ';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE LBIFIL';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE LBIQUOTES';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
when InToComp = 18;
cmdstring = 'RMVLIBLE LSNQUOTES';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'RMVLIBLE LSNOBJ';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'RMVLIBLE LSNFIL';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE LSNOBJ';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE LSNFIL';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE LSNQUOTES';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
when InToComp = 30;
cmdstring = 'RMVLIBLE PDMQUOTES';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'RMVLIBLE PDMOBJ';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'RMVLIBLE PDMFIL';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE PDMOBJ';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE PDMFIL';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
cmdstring = 'ADDLIBLE PDMQUOTES';
cmdlength = %len(%trim(cmdstring));
exsr $runCommand;
endsl;
exsr $callprograms;
exsr $replaceLibl;
*inlr = *on;
//--------------------------------------------------------
// $runCommand - run commands
//--------------------------------------------------------
begsr $runCommand;
monitor;
$command (cmdstring:cmdlength);
on-error;
endmon;
endsr;
//--------------------------------------------------------
// $callprograms - call the programs to update quote
//--------------------------------------------------------
begsr $callprograms;
//
// call the program with corrected library list
//
ChrQuote = *all'0';
OutType = *blanks;
$OEN32(OutType : ChrQuote);
$OEN33(OutType : ChrQuote);
OutType = 'Q';
$OEN43(ChrQuote : OutType);
$OEN06(OutType : DecQuote);
cmdstring = 'OVRDBF FILE(OEIDORDB) TOFILE(OEIDORDQ)';
cmdlength = %len(%trim(cmdstring));
$command (cmdstring:cmdlength);
$OEN141(OutType : DecQuote);
$OEN142(OutType : DecQuote);
$OEN13 (OutType : DecQuote);
$OEN131(OutType : DecQuote);
$OEN10 (OutType : DecQuote);
$OEN23 (OutType : DecQuote);
cmdstring = 'DLTOVR FILE(OEIDORDB)';
cmdlength = %len(%trim(cmdstring));
$command (cmdstring:cmdlength);
$OEN161(OutType);
endsr;
//--------------------------------------------------------
// $replacelibl - replace the library list
//--------------------------------------------------------
begsr $replacelibl;
//
// CHGLIBL LIBL(EDI4XXPGM EDI4XXDTA FAXN2OBJ)
//
cmdstring = 'CHGLIBL LIBL(';
for count = 1 to AllLibs;
if LibraryList(count) <> *blanks and
count > SkipLibs;
cmdstring = %trim(cmdstring) +
%trim(LibraryList(count)) + '@';
endif;
str += 11;
endfor;
cmdstring = %trim(cmdstring) + ')';
cmdstring = %xlate('@':' ':cmdstring);
cmdlength = %len(%trim(cmdstring));
$command (cmdstring:cmdlength);
endsr;
//--------------------------------------------------------
/end-free