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 if ThisForcedValue[1,1] = '@' then ForcedValues = 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 = 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 = 'No matching data found for ':quote( DataIo ):'...' *MsgInfo = '!' *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