added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
155
LSL2/STPROC/KEY_CONV.txt
Normal file
155
LSL2/STPROC/KEY_CONV.txt
Normal file
@ -0,0 +1,155 @@
|
||||
COMPILE SUBROUTINE KEY_CONV( ConvType, DataIo, SubrLabel, ReturnedValue )
|
||||
|
||||
declare subroutine btree.extract, update_index, make.list
|
||||
declare function verifile, msg, fieldcount, entid, popup, set_property
|
||||
declare function get_property
|
||||
|
||||
$insert popup_equates
|
||||
$INSERT LOGICAL
|
||||
$insert msg_equates
|
||||
|
||||
equ valid$ to 0 ;* successful
|
||||
equ invalid_msg$ to 1 ;* bad data - print error message window
|
||||
equ invalid_conv$ to 2 ;* bad conversion - " "
|
||||
equ invalid_nomsg$ to 3 ;* bad but do not print the error message window
|
||||
|
||||
status() = Valid$
|
||||
* Allows you to force the current username in forced fields
|
||||
convert '|' to @fm in SubrLabel
|
||||
swap '@USERNAME' with @user4 in SubrLabel
|
||||
ForcedValues = field( SubrLabel<4>, '*', 2 )
|
||||
convert '^' to @fm in ForcedValues
|
||||
Fcnt = fieldcount( ForcedValues, @fm )
|
||||
Done = false$
|
||||
OrigForcedValues = ForcedValues
|
||||
for i = 1 to Fcnt
|
||||
ThisForcedValue = ForcedValues<i>
|
||||
if ThisForcedValue[1,1] = '@' then
|
||||
ForcedValues<i> = get_property( @window:'.':ThisForcedValue[2,999], 'TEXT' )
|
||||
end
|
||||
next i
|
||||
if ForcedValues <> OrigForcedValues then
|
||||
convert @fm to '^' in ForcedValues
|
||||
SubrLabel<4> = field( SubrLabel<4>, '*', 1 ):'*':ForcedValues
|
||||
end
|
||||
begin case
|
||||
case ConvType = 'ICONV'
|
||||
ReturnedValue = DataIo
|
||||
DataIo = trimf(DataIo)
|
||||
* see if the data is a proper key
|
||||
FileToUse = SubrLabel<1>
|
||||
*if num(DataIo) then
|
||||
* * is possibly a key, do nothing
|
||||
* if verifile(DataIo, FileToUse) then
|
||||
* status() = valid$
|
||||
* end else
|
||||
* * was not a key - invalid
|
||||
* status() = invalid_conv$
|
||||
* end
|
||||
*end else
|
||||
* might be a name, let's see
|
||||
FieldToUse = SubrLabel<2>
|
||||
ForcedItems = SubrLabel<4>
|
||||
SearchStr = FieldToUse:@vm:DataIo:"]":@FM
|
||||
if verifile(DataIo, FileToUse) and ( ForcedItems = '' ) then
|
||||
status() = valid$
|
||||
end else
|
||||
*debug
|
||||
if verifile( DataIo, FileToUse ) then
|
||||
* READ THE RECORD
|
||||
if len(ForcedItems) then
|
||||
convert '*^' to @fm:@vm in ForcedItems
|
||||
ForcedFields = ForcedItems<1>
|
||||
ForcedValues = ForcedItems<2>
|
||||
NumItems = fieldcount(ForcedFields, @vm)
|
||||
for i = 1 to NumItems
|
||||
FieldValue = xlate( FileToUse, DataIo, ForcedFields<1,i>, 'X' )
|
||||
if FieldValue = ForcedValues<1,i> then
|
||||
* VALIDATED OK
|
||||
end else
|
||||
* COULD BE A MULTI-VALUED FIELD SO TRY TO LOCATE
|
||||
locate ForcedValues<1,i> in FieldValue using @vm setting FPos else
|
||||
ReturnedValue = DataIo
|
||||
status() = invalid_nomsg$
|
||||
end
|
||||
end
|
||||
next i
|
||||
end
|
||||
end else
|
||||
if len(ForcedItems) then
|
||||
convert '*^' to @fm:@vm in ForcedItems
|
||||
ForcedFields = ForcedItems<1>
|
||||
ForcedValues = ForcedItems<2>
|
||||
NumItems = fieldcount(ForcedFields, @vm)
|
||||
for i = 1 to NumItems
|
||||
SearchStr := ForcedFields<1,i>:@vm:ForcedValues<1,i>:@fm
|
||||
next i
|
||||
end
|
||||
open 'DICT', FileToUse to FileToUseDict else
|
||||
Void = msg( '', 'Unable to open DICT.':FileToUse )
|
||||
return
|
||||
end
|
||||
open FileToUse to FileToUseVar else
|
||||
Void = msg( '', 'Unable to open ':FileToUse )
|
||||
return
|
||||
end
|
||||
|
||||
TSearchStr = SearchStr<1>
|
||||
convert ']' to '' in TSearchStr
|
||||
* Following added by JCHenry on Oct 24, 2003 - Skips numeric cross references now
|
||||
|
||||
IF NUM(TSearchStr) THEN
|
||||
KeyIds = TSearchStr
|
||||
END ELSE
|
||||
btree.extract(SearchStr, FileToUse, FileToUseDict, KeyIds, 'S', '')
|
||||
Tvar = status()
|
||||
status() = valid$
|
||||
END
|
||||
* End of changes by JCH
|
||||
|
||||
if KeyIds then
|
||||
if fieldcount(KeyIds, @vm) = 1 then
|
||||
ReturnedValue = KeyIds
|
||||
end else
|
||||
|
||||
CONVERT @VM TO @FM IN KEYIDS
|
||||
Make.List(0, KEYIDS, FileToUseVar, FileToUseDict)
|
||||
|
||||
PopupToUse = SubrLabel<3>
|
||||
|
||||
PopRec = xlate( 'SYSREPOSPOPUPS', @appid<1>:'**':PopupToUse, '', 'X' )
|
||||
|
||||
PopRec<pselect$> = 1 ;* can only choose one
|
||||
Choice = popup( @window, PopRec )
|
||||
if choice <> '' then
|
||||
*status() = valid$
|
||||
ReturnedValue = Choice
|
||||
end else
|
||||
ReturnedValue = DataIo
|
||||
status() = invalid_nomsg$
|
||||
end
|
||||
end
|
||||
end else
|
||||
* no keys returned, invalid data
|
||||
*MsgInfo = ''
|
||||
*MsgInfo<mtext$> = 'No matching data found for ':quote( DataIo ):'...'
|
||||
*MsgInfo<micon$> = '!'
|
||||
*Void = msg( '', MsgInfo )
|
||||
status() = invalid_nomsg$
|
||||
end
|
||||
end ;* verifile 2
|
||||
end ;* verifile 1
|
||||
IconvMode = SubrLabel<5>
|
||||
if IconvMode = 'VM' then
|
||||
convert @fm to @vm in ReturnedValue
|
||||
end
|
||||
*end ;* num(dataio)
|
||||
|
||||
case ConvType = 'OCONV'
|
||||
ReturnedValue = DataIo
|
||||
|
||||
case otherwise$
|
||||
status() = invalid_msg$
|
||||
end case
|
||||
return
|
||||
|
||||
Reference in New Issue
Block a user