open-insight/LSL2/STPROC/IMPORT_COMPANY.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

225 lines
8.4 KiB
Plaintext

compile function import_company()
begin condition
pre:
post:
end condition
declare subroutine rlist
declare function msg, fieldcount
$insert logical
$insert rlist_equates
$insert company_equ
open 'TCOMPANY' to Tcompany else
void = msg( '', 'Unable to open Tcompany...' )
return 0
end
open 'TCUSTOMER' to Tcustomer else
void = msg( '', 'Unable to open Tcustomer...' )
return 0
end
open 'COMPANY' to CompanyFile else
void = msg( '', 'Unable to open Company...' )
return 0
end
rlist( 'SELECT TCOMPANY', target_activelist$, '', '', '' )
Eof = false$
NumKeys = @reccount
Cnt = 0
loop
readnext TcompId else Eof = true$
until Eof
read TcompRec from Tcompany, TcompId else
void = msg( '', 'Unable to read ':TcompId:' from Tcompany' )
return 0
end
CompanyRec = ''
CompanyRec<company_entry_date$> = TcompRec<8> ;* entry date
CompanyRec<company_entry_id$> = TcompRec<46,1> ;* entry id
UlVal = TcompRec<1>
gosub MakeUpperLower
CompanyRec<company_co_name$> = UlVal ;* company name
UlVal = TcompRec<3>
gosub MakeUpperLower
CompanyRec<company_address$> = UlVal ;* company address
UlVal = TcompRec<4>
gosub MakeUpperLower
CompanyRec<company_city$> = UlVal ;* city
CompanyRec<company_state$> = TcompRec<5> ;* state
CompanyRec<company_zip$> = TcompRec<6>
Phone = TcompRec<7>
Fax = TcompRec<10>
IPhone = TcompRec<50>
IFax = TcompRec<51>
if Phone then
CompanyRec<company_phones$> = Phone
CompanyRec<company_phone_types$> = 'Office'
end
if Fax then
CompanyRec<company_phones$,2> = Fax
CompanyRec<company_phone_types$,2> = 'Fax'
end
if IPhone then
CompanyRec<company_intl_phones$> = IPhone
CompanyRec<company_intl_phone_types$> = 'Office'
end
if IFax then
CompanyRec<company_intl_phones$,2> = IFax
CompanyRec<company_intl_phone_types$,2> = 'Fax'
end
Notes = TcompRec<35>
convert @vm to ' ' in Notes
convert @tm to ' ' in Notes
CompanyRec<company_note$> = Notes ;* notes
CatNo = TcompRec<12> ;*
Category = TcompRec<9>
Catcnt = fieldcount( Category, @vm )
TCategory = Category
for i = CatCnt to 1 step -1
ThisCat = TCategory<1,i>
if ThisCat = 'VENDOR' or ThisCat = 'CUSTOMER' then
Tcategory = delete( TCategory, 1, i, 0 )
end
next i
UlVal = TCategory<1,1>
gosub MakeUpperLower
CompanyRec<company_category$> = UlVal
if CatCnt then
WroteOne = false$
for i = 1 to CatCnt
ThisCat = Category<1,i>
CustToUse = CatNo<1,i>
if ThisCat = 'CUSTOMER' or ThisCat = 'VENDOR' then
* need to go get customer or vendor info
if ThisCat = 'CUSTOMER' then
CustRec = xlate( 'TCUSTOMER', CustToUse, '', 'X' )
if CustRec then
NewCompanyRec = CompanyRec
UlVal = CustRec<43>
gosub MakeUpperLower
NewCompanyRec<company_division$> = UlVal ;*division
UlVal = CustRec<80>
gosub MakeUpperLower
NewCompanyRec<company_terms$> = UlVal ;*terms
UlVal = CustRec<72>
gosub MakeUpperLower
NewCompanyRec<company_shipper_info$> = UlVal ;*shipper_info
UlVal = CustRec<74>
gosub MakeUpperLower
NewCompanyRec<company_bill_to_attn$> = UlVal ;*bill_to_attn
UlVal = CustRec<78>
gosub MakeUpperLower
NewCompanyRec<company_bill_to_co$> = UlVal ;*bill_To_company
UlVal = CustRec<49>
gosub MakeUpperLower
NewCompanyRec<company_bill_to_address$> = UlVal ;*bill_To_address
UlVal = CustRec<50>
gosub MakeUpperLower
NewCompanyRec<company_bill_to_city$> = UlVal ;*bill_To_city
NewCompanyRec<company_bill_to_state$> = CustRec<51> ;*bill_To_state
NewCompanyRec<company_bill_to_zip$> = CustRec<52> ;*bill_To_zip
UlVal = CustRec<75>
gosub MakeUpperLower
NewCompanyRec<company_ship_to_attn$> = UlVal ;*ship_To_attn
UlVal = CustRec<79>
gosub MakeUpperLower
NewCompanyRec<company_ship_to_co$> = UlVal ;*ship_To_company
UlVal = CustRec<53>
gosub MakeUpperLower
NewCompanyRec<company_ship_to_address$> = UlVal ;*ship_To_addr
UlVal = CustRec<54>
gosub MakeUpperLower
NewCompanyRec<company_ship_to_city$> = UlVal ;*ship_To_city
NewCompanyRec<company_ship_to_state$> = CustRec<55> ;*ship_To_state
NewCompanyRec<company_ship_to_zip$> = CustRec<56> ;*ship_To_zip
Tnotes = CustRec<59> ;* notes
convert @vm to ' ' in Tnotes
convert @tm to ' ' in Tnotes
NewCompanyRec<company_note$> = NewCompanyRec<company_note$>:' ':Tnotes
NewCompanyRec<company_co_type$> = 'C' ;* it is a customer
write NewCompanyRec on CompanyFile, CustToUse else
void = msg( '', 'Unable to write ':CustToUse:' in Company file...' )
return 0
end
WroteOne = true$
end else
* do not write
end
end else
* it is a vendor
VendorRec = xlate( 'TVENDOR', CustToUse, '', 'X' )
if VendorRec then
NewCompanyRec = CompanyRec
NewCompanyRec<company_vacct_no$> = VendorRec<79>
UlVal = VendorRec<71>
gosub MakeUpperLower
NewCompanyRec<company_vremit_addr$> = UlVal
UlVal = VendorRec<72>
gosub MakeUpperLower
NewCompanyRec<company_vremit_city$> = UlVal
NewCompanyRec<company_vremit_state$> = VendorRec<73>
NewCompanyRec<company_vremit_zip$> = VendorRec<74>
NewCompanyRec<company_vremit_phone$> = VendorRec<75>
NewCompanyRec<company_vremit_phone_types$> = 'Office'
NewCompanyRec<company_co_type$> = 'V' ;*it is a vendor
Write NewCompanyRec on CompanyFile, CustToUse else
void = msg( '', 'Unable to write ':CustToUse:' in Company file...' )
return 0
end
WroteOne = true$
end else
* do nothing
end
end
end
next i
if WroteOne else
if index( Category, 'CUSTOMER', 1 ) then
CompanyRec<company_co_type$> = 'C'
end else
if index( Category, 'VENDOR', 1 ) then
CompanyRec<company_co_type$> = 'V'
end else
CompanyRec<company_co_type$> = 'O'
end
end
write CompanyRec on CompanyFile, TcompId else
void = msg( '', 'Unable to write ':TcompId:' in Company...' )
return 0
end
end
end else
CompanyRec<company_co_type$> = 'O' ;* it is an other
write CompanyRec on CompanyFile, TcompId else
void = msg( '', 'Unable to write ':TcompId:' in Company...' )
return 0
end
end
Cnt += 1
Percent = oconv( iconv(Cnt/NumKeys, 'MD2'), 'MD0' ):'%'
Void = send_info( Percent:' Complete Importing Companies...' )
repeat
return 0
*===========================================================================*
MakeUpperLower:
convert ' ' to @fm in UlVal
convert '.' to @fm in UlVal
Wcnt = fieldcount( UlVal, @fm )
for i = 1 to Wcnt
ThisWord = UlVal<i>
if alpha( ThisWord[1,1] ) then
if index( ThisWord, '&', 1 ) else
FirstLetter = ThisWord[1,1]
RestOfWord = ThisWord[2,999]
convert @lower.case to @upper.case in FirstLetter
convert @upper.case to @lower.case in RestOfWord
UlVal<i> = FirstLetter:RestOfWord
end
end
next i
convert @fm to ' ' in UlVal
return
*===========================================================================*