158 lines
6.1 KiB
Plaintext
158 lines
6.1 KiB
Plaintext
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
|
|
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
|
|
|
|
|