COMPILE FUNCTION obj_RDS_Audit(Method,Parms) /* Methods for RDS_AUDIT table 01/12/2005 JCH - Initial Coding Properties: Methods: Update(RDS,UserName,FieldNos) ;* Create/Update UserName and DTM fields Delete(RDS) ;* Delete RDS Audit Record when RDS record goes away Display(RDS,WindowName) ;* Displays just the fields found in the CtrlMap of the window */ DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Get_Property, Dialog_Box DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, obj_WO_Step $INSERT DICT_EQUATES $INSERT MSG_EQUATES $INSERT RDS_AUDIT_EQUATES $INSERT RDS_EQU ErrTitle = 'Error in Stored Procedure "obj_RDS_Audit"' ErrorMsg = '' IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine' IF NOT(ASSIGNED(Parms)) THEN Parms = '' IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) RETURN '' END Result = '' BEGIN CASE CASE Method = 'Update' ; GOSUB Update CASE Method = 'Delete' ; GOSUB Delete CASE Method = 'FieldNames' ; GOSUB FieldNames CASE Method = 'Display' ; GOSUB Display CASE Method = 'Convert' ; GOSUB Convert CASE 1 END CASE IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * Update: * * * * * * * RDSNo = Parms[1,@RM] ModIDs = Parms[COL2()+1,@RM] ModFields = Parms[COL2()+1,@RM] IF RDSNo = '' THEN RETURN atParms = 'RDS_AUDIT':@RM:RDSNo AuditRecord = obj_Tables('ReadRec',atParms) errCode = '' IF Get_Status(errCode) THEN RETURN LastDtm = IConv(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'), "DT") CurrWindow = @WINDOW IF CurrWindow = 'RDS' THEN CurrWindow = 'RDS_FIRST_WAFER' DictLayout = XLATE('DICT.RDS','%FIELDS%','','X') FOR N = 1 TO COUNT(ModFields,@VM) + (ModFields NE '') UserName = ModIDs<1,N> FieldName = ModFields<1,N> GOSUB LoadAuditRec NEXT N atParms = FIELDSTORE(atParms,@RM,4,0,AuditRecord) obj_Tables('WriteRec',atParms) IF Get_Status(errCode) THEN ErrorMsg = 'Unable to WRITE RDS_Audit Record' END RETURN * * * * * * * Display: * * * * * * * RDSNo = Parms[1,@RM] CurrWindow = Parms[COL2()+1,@RM] IF RDSNo = '' THEN RETURN IF CurrWindow NE '' THEN WindowColumns = Get_Property(CurrWindow,'CTRLMAP') ;* Limits results to the controls on the window END ELSE WindowColumns = '' END CONVERT @FM TO @RM IN WindowColumns WinFieldNames = Get_Property(WindowColumns,'COLUMN') CONVERT @RM TO @FM IN WinFieldNames CONVERT @VM:@SVM TO @FM:@FM IN WinFieldNames AuditRec = XLATE('RDS_AUDIT',RDSNo,'','X') ;* RDS_AUDIT record @VM:@SVM by UserName/FieldNos AllColNames = XLATE('RDS_AUDIT',RDSNo,'FIELD_NAME','X') ;* Dictionary field names logged in audit record @VM:@SVM by UserName/FieldNos ResColNames = '' ResDispTexts = '' ResUserNames = '' ResLastDTMs = '' ResLastWindows = '' FOR I = 1 TO COUNT(AuditRec,@VM) + (AuditRec NE '') UserName = AuditRec LastDTM = OCONV(AuditRec,'DT4/^HS') LastWindow = AuditRec NameFieldNos = AuditRec FieldCnt = COUNT(NameFieldNos,@SVM) + (NameFieldNos NE '') FOR N = 1 TO FieldCnt ResColName = AllColNames<1,I,N> ResUserName = UserName ResLastDTM = LastDTM ResLastWindow = LastWindow ResDispText = XLATE('DICT.RDS',ResColName,DICT_DISPLAY$,'X') CONVERT @VM TO ' ' IN ResDispText IF WindowColumns = '' THEN LOCATE ResDispText IN ResDispTexts BY 'AL' USING @FM SETTING NPos ELSE ResUserNames = INSERT(ResUserNames,NPos,0,0,ResUserName) ResColNames = INSERT(ResColNames,NPos,0,0,ResColName) ResDispTexts = INSERT(ResDispTexts,NPos,0,0,ResDispText) ResLastDTMs = INSERT(ResLastDTMs,NPos,0,0,ResLastDTM) ResLastWindows = INSERT(ResLastWindows,NPos,0,0,ResLastWindow) END END ELSE LOCATE ResColName IN WinFieldNames USING @FM SETTING Pos THEN LOCATE ResDispText IN ResDispTexts BY 'AL' USING @FM SETTING NPos ELSE ResUserNames = INSERT(ResUserNames,NPos,0,0,ResUserName) ResColNames = INSERT(ResColNames,NPos,0,0,ResColName) ResDispTexts = INSERT(ResDispTexts,NPos,0,0,ResDispText) ResLastDTMs = INSERT(ResLastDTMs,NPos,0,0,ResLastDTM) ResLastWindows = INSERT(ResLastWindows,NPos,0,0,ResLastWindow) END END END NEXT N NEXT I IF ResColNames NE '' AND ResUserNames NE '' THEN Result = ResDispTexts:@RM:ResUserNames:@RM:ResLastDTMs:@RM:ResLastWindows END RETURN * * * * * * * Convert: * * * * * * * RDSNo = Parms[1,@RM] RDSRec = Parms[COL2()+1,@RM] IF RDSNo = '' THEN RETURN IF RDSRec = '' THEN RDSRec = XLATE('RDS',RDSNo,'','X') RDSOrgLen = LEN(RDSRec) atParms = 'RDS_AUDIT':@RM:RDSNo AuditRecord = obj_Tables('ReadRec',atParms) DictLayout = XLATE('DICT.RDS','%FIELDS%','','X') FOR N = 1 TO COUNT(RDSRec,@VM) + (RDSRec NE '') UserName = RDSRec FieldName = RDSRec GOSUB LoadAuditRec NEXT N RDSRec = '' RDSRec = '' FOR N = 1 TO COUNT(RDSRec,@VM) + (RDSRec NE '') UserName = RDSRec FieldName = RDSRec GOSUB LoadAuditRec NEXT N RDSRec = '' RDSRec = '' FOR N = 1 TO COUNT(RDSRec,@VM) + (RDSRec NE '') UserName = RDSRec FieldName = RDSRec GOSUB LoadAuditRec NEXT N RDSRec = '' RDSRec = '' FOR N = 1 TO COUNT(RDSRec,@VM) + (RDSRec NE '') UserName = RDSRec FieldName = RDSRec GOSUB LoadAuditRec NEXT N RDSRec = '' RDSRec = '' RDSNewLen = LEN(RDSRec) RecLen = LEN(AuditRecord) *Result = 'Len Audit: ':FMT(RecLen,"R#6"):' RDS Org: ':FMT(RDSOrgLen,'R#6'):' RDS New: ':FMT(RDSNewLen,'R#5'):' Delta: ':RDSOrgLen - RDSNewLen IF RecLen = 0 THEN obj_Tables('UnlockRec',atParms) END ELSE atParms = FIELDSTORE(atParms,@RM,4,0,AuditRecord) obj_Tables('WriteRec',atParms) IF Get_Status(errCode) THEN DEBUG END RETURN * * * * * * * LoadAuditRec: * * * * * * * * Local Subroutine LOCATE FieldName IN DictLayout USING @VM SETTING DPos THEN FieldNo = DictLayout IF FieldNo = '' THEN RETURN END Done = 0 NameCnt = COUNT(AuditRecord,@VM) + (AuditRecord NE '') FOR X = 1 TO NameCnt FNCnt = COUNT(AuditRecord,@SVM) + (AuditRecord NE '') FOR Y = 1 TO FNCnt IF AuditRecord = FieldNo THEN AuditRecord = DELETE(AuditRecord,RDS_AUDIT_FIELD_NO$,X,Y) ;* Remove the field no. sub-value if it's here IF AuditRecord = '' THEN AuditRecord = DELETE(AuditRecord,RDS_AUDIT_USER_NAME$,X,0) ;* If the user name field is empty -> remove it AuditRecord = DELETE(AuditRecord,RDS_AUDIT_FIELD_NO$,X,0) ;* Remove the associated sub-value field AuditRecord = DELETE(AuditRecord,RDS_AUDIT_LAST_DTM$,X,0) AuditRecord = DELETE(AuditRecord,RDS_AUDIT_WINDOW$,X,0) END Done = 1 END UNTIL Done NEXT Y UNTIL Done NEXT X LOCATE UserName IN AuditRecord USING @VM SETTING NPos THEN LineItemFNos = AuditRecord LOCATE FieldNo IN LineItemFNos BY 'AR' USING @SVM SETTING FNPos ELSE AuditRecord = INSERT(AuditRecord,RDS_AUDIT_FIELD_NO$,NPos,FNPos,FieldNo) ;* Username already in record - add the field no sub-value END AuditRecord = LastDTM ;* Update last DTM for this user AuditRecord = CurrWindow END ELSE AuditRecord = INSERT(AuditRecord,RDS_AUDIT_USER_NAME$,NPos,0,UserName) ;* New user name - add to list AuditRecord = INSERT(AuditRecord,RDS_AUDIT_FIELD_NO$,NPos,1,FieldNo) ;* Put field no. sub-value in associated list AuditRecord = INSERT(AuditRecord,RDS_AUDIT_LAST_DTM$,NPos,0,LastDTM) ;* Put current date and time on user name AuditRecord = INSERT(AuditRecord,RDS_AUDIT_WINDOW$,NPos,0,CurrWindow) ;* Put the window name with the initial use of the name END RETURN * * * * * * * FieldNames: * * * * * * * RDSNo = Parms[1,@RM] RDSAuditRec = Parms[COL2()+1,@RM] IF RDSNo = '' THEN RETURN IF RDSAuditRec = '' THEN RDSAuditRec = XLATE('RDS_AUDIT',RDSNo,'','X') DictLayout = XLATE('DICT.RDS','%FIELDS%','','X') AuditFieldNos = RDSAuditRec VMCnt = COUNT(AuditFieldNos,@VM) + (AuditFieldNos NE '') FOR I = 1 TO VMCnt ItemFieldNos = AuditFieldNos<1,I> SVMCnt = COUNT(ItemFieldNos,@SVM) + (ItemFieldNos NE '') FOR N = 1 TO SVMCnt FieldNo = ItemFieldNos<1,1,N> LOCATE FieldNo IN DictLayout USING @VM SETTING DPos THEN Result<1,I,N> = DictLayout END NEXT N NEXT I RETURN * * * * * * * Delete: * * * * * * * RdsNos = Parms[1,@RM] IF RdsNos = '' THEN RETURN RETURN