locals bMoreUsers : boolean; nAns : integer; bcont : boolean; bok : boolean; sProjName : string; sStart : string; sEnd : string; gid : integer; szTime : string; sCount : string; sDumpFile : string; nNextID : integer; nID : integer; sUserName : string; cur : integer; bUseProjects: boolean; projid : integer; nMaxProjId : integer; title : string; nCount : integer; nVaultId : integer; sVaultName : string; sVaultClass : string; szStem : string; szStartDate : string; szEndDate : string; szTmpTable : string; ncur1 : integer; ncur2 : integer; ncur3 : integer; nuid : integer begin -- SQL diagnostics on let sDumpFile="rep.txt@@TEST" let szTmpTable = "USER_ACTIVITY_REPORT" let bUseProjects = true -- Set up form defaults: let sProjName = "All Projects" let szStartDate = '-7' let szEndDate = RTODAY runa checkdat.hcl@@GENutils ( szStartDate bok ) runa checkdat.hcl@@GENutils ( szEndDate bok ) label START System delete sDumpFile EndSystem -- Generate Picklist of Projects gosub ListProjects let nNextID = 0 -- Positions Form passive gid size 4000 1000 style 3 X 2 "User Activity Report" "Project:" sProjName layout 1 combo "Start Date:" szStartDate layout 3 "End Date:" szEndDate layout 6 2 "OK" "Cancel" EndForm let Qopttype = 0 let bcont = true while bcont loop Block Fetch UnBlock case Qopttype is when 1 then case Qoptno is when 1 then --OK runa checkdat.hcl@@GENutils ( szStartDate bok ) if not bok then Moveto form gid 3 else runa checkdat.hcl@@GENutils ( szEndDate bok ) if not bok then Moveto form gid 6 else --runa betdate.hcl@@GENutils ( szStartDate "" szEndDate bok ) --if not bok then -- Alert "Start Date Must be before End Date" -- Moveto form gid 3 --else let bcont = false --endif endif endif when 2 then -- Cancel let bcont = false endcase when 3 then case Qoptno is when 2 then -- Start Date null when 3 then -- End Date null endcase when 5 then Send gid list QEDMreport endcase Update gid endloop Remove gid if Qoptno=2 then goto EXIT endif -- Cancel selected if bUseProjects then Inquire time szTime EndInquire mprint "*********************************************************" nl "Processing started at - " szTime nl endprint let projid = 0 -- should be 1 -- let projid = 755 -- Loop Around All Projects if sProjName = "All Projects" then -- Get The Max Project ID SQL execute cur "SELECT MAX(ID) FROM EDMPROJECTS" EndSQL SQL fetch cur nMaxProjId EndSQL SQL break cur -- let nMaxProjId = 765 -- ******************* else SQL execute cur "SELECT ID FROM EDMPROJECTS WHERE PROJECT=:sProjName AND STATUS=1" EndSQL SQL fetch cur nMaxProjId EndSQL SQL break cur let projid = nMaxProjId endif while projid <= nMaxProjId loop SQL execute cur "SELECT PROJECT, PASSWD FROM EDMPROJECTS WHERE ID=:projid AND STATUS=1" EndSQL SQL fetch cur PROJ_hidname PROJ_hidpass EndSQL SQL break cur let PROJ_login = true -- Log on to a project let PROJ_hidden = true -- Use PROJ_name rather than inquire from the user system errors_off run SQLlogin.hcl@@EDMutils -- connect to DB system errors_on if not Qdblogged then -- logged on to RDB account lprint @(76187,PROJ_hidname) system errors_off run SQLlogin.hcl@@EDMutils -- connect to DB system errors_on else gosub UpdateTotals endif let projid = projid + 1 if rem(projid ,10) = 0 then Inquire time szTime EndInquire mprint "Processed(" projid ") - (" szTime ")" nl endprint endif SQL fetch cur PROJ_hidname PROJ_hidpass EndSQL endloop SQL break cur else gosub UpdateTotals endif gosub CreateReportTable gosub DisplayReport -- Remove Report Table SQL execute "DROP TABLE :szTmpTable:" EndSQL EDM commit goto START goto EXIT ------------------------------------------------------------------------------- label UpdateTotals mprint "---------------------------" nl nl endprint -- SQL diagnostics on lprint "Building Report..." -- Get all the vaults which have been modified after the start date SQL execute ncur1 "SELECT va.id, va.stem, va.name, va.class FROM vaults va, vault_locs locs" " WHERE va.id = locs.vault AND locs.status = 1 AND locs.timelastmod > :szStartDate" -- " AND va.class='draw'" EndSQL SQL fetch ncur1 nVaultId szStem sVaultName sVaultClass EndSQL while Qerrorno = 0 loop -- Loop Vaults -- mprint sVaultName " " sVaultClass nl endprint -- SQL execute ncur2 -- "select userref, count(*) from :szStem:_HS" -- " where done > :szStartDate" -- " AND KIND IN (101, 103, 108)" -- " Group by userref order by userref" -- EndSQL -- SQL fetch ncur2 nuid nCount EndSQL -- SQL execute ncur2 -- "select u.uname, count(*) from :szStem:_HS h, users u" -- " where done > :szStartDate" -- " AND KIND IN (101, 103, 108)" -- " AND h.userref = u.id" -- " Group by h.userref, u.uname order by h.userref" -- EndSQL SQL execute ncur2 "select xpr.inputby, count(*) from :szStem:_HS h, X:szStem:_PR xpr" " where done >= :szStartDate" " AND done <= :szEndDate" " AND KIND IN (101, 103, 108)" " AND h.item = xpr.id" " Group by xpr.inputby order by xpr.inputby desc" EndSQL let bMoreUsers = true while bMoreUsers loop -- Loop Users SQL fetch ncur2 sUserName nCount EndSQL let bMoreUsers = Qerrorno = 0 if bMoreUsers then Function strip sUserName if sUserName = "" then let sUserName = "unknown" endif if sUserName = "jwassell" then mprint PROJ_hidname " " sVaultName " " nl endprint endif openout sDumpFile mprint sUserName " " nCount " " sVaultClass "" nl endprint closeout endif endloop -- End Loop Users SQL break ncur2 SQL fetch ncur1 nVaultId szStem sVaultName EndSQL endloop -- End Loop Vaults SQL break ncur1 EDM commit -- SQL diagnostics off return ------------------------------------------------------------------------------- label CreateReportTable SQL execute "DROP TABLE :szTmpTable:" EndSQL SQL execute "CREATE TABLE :szTmpTable:( ID INTEGER, TOTAL INTEGER, UNAME VARCHAR(255), ACCS INTEGER, COR7 INTEGER, CUTT INTEGER, DRAW INTEGER, FIN INTEGER )" EndSQL FileAction exists sDumpFile nAns EndFileAction if nAns = 0 then openin sDumpFile mget - sUserName sCount sVaultClass endget while Qok loop Function integer sCount nCount -- mprint nCount " " sUserName " " sVaultClass nl endprint SQL execute ncur1 "select id from :szTmpTable: where uname = :sUserName" EndSQL SQL fetch ncur1 nID EndSQL if Qerrorno /= 0 then -- SQL execute ncur1 "select max(id) from :szTmpTable:" EndSQL -- SQL fetch ncur1 nID EndSQL let nNextID = nNextID + 1 let nID = nNextID SQL execute "INSERT INTO :szTmpTable:(ID, TOTAL, UNAME, ACCS, COR7, CUTT, DRAW, FIN) VALUES (:nNextID:, :nCount:, :sUserName, 0, 0, 0, 0, 0)" EndSQL else SQL execute "UPDATE :szTmpTable: set total = total + :nCount: where id=:nID" EndSQL endif SQL execute "UPDATE :szTmpTable: set :sVaultClass: = :sVaultClass: + :nCount: where id=:nID" EndSQL SQL break ncur1 mget - sUserName sCount sVaultClass endget endloop closein EDM commit endif return ------------------------------------------------------------------------------- label DisplayReport System delete QEDMreport EndSystem -- Write report header openout QEDMreport let title = "User Activity Report - " + sProjName + " (" + szStartDate + " to " + szEndDate +")" runa header.rep@@EDMreports ( title ) lprint " " lprint " " -- 1 2 3 4 5 6 7 8 9 -- 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890 lprint "| User Name | Correspondence | Drawings | Accounts / Invoice | Press Cutting | Finance | Total |" let QEDMrepform = "| ^S ^| ^I | ^I | ^I | ^I | ^I | ^I |" lprint "|-----------------------------------|----------------|----------|--------------------|---------------|---------|--------|" closeout SQL execute ncur1 "select uname, cor7, draw, accs, fin, cutt, total" "from :szTmpTable:" " where total <> 0 order by total desc" EndSQL let QEDMreplayout = true EDM report ncur1 openout QEDMreport lprint " " lprint " " closeout if QEDMrepcount > 0 then runa report.hcl@@GENutils ( QEDMreport "User Activity Report" false ) else Alert @(51277) -- 'Nothing selected' endif return ------------------------------------------------------------------------------- label ListProjects -- Generate list of vaults for the form picklist System delete QEDMreport EndSystem openout QEDMreport lprint "All Projects" closeout SQL execute ncur1 "SELECT PROJECT FROM EDMPROJECTS WHERE STATUS=1 ORDER BY project asc" EndSQL let QEDMrepform="^S" EDM report ncur1 return ------------------------------------------------------------------------------- label EXIT -- SQL diagnostics off end