Make your own free website on Tripod.com
Security.SQR

!************************************************************************
! SECURITY.SQR: Security Report
!************************************************************************
! *
!***********************************************************************
! This program writes a security report *
! and accompanying file *
! *
!***********************************************************************

#include 'setenv.sqc' !Set environment
#Include 'setup01.sqc' !Printer and page-size initialization

begin-report

do Init-DateTime
do Init-Number
do Get-Current-DateTime
do Set-Columns
do Init-Report
do Individual-Or-Class
do Create-Action-Array
do Open-File
do Select-PSAUTHITEM-Rows
do Close-File
do Reset
do Stdapi-Term
end-report

begin-procedure Set-Columns
#define col_menuname 1
#define col_barname 32
#define col_baritemname 49
#define col_pnlitemname 81
#define col_display 113

end-procedure

begin-heading 8
#Include 'stdhdg01.sqc'

let $opid='OPRID: ' || $id || ' Class: ' || $class
print $opid (+1,1,35)
print 'Display' (+1,{col_display},7)
print 'Menu Name' (+1,{col_menuname},30)
print 'Bar Name' (0,{col_barname},15)
print 'Bar Item Name' (0,{col_baritemname},30)
print 'Panel Item Name' (0,{col_pnlitemname},30)
print ' Only' (0,{col_display},7)

print '-------------------------------' (+1,{col_menuname},30)
print '----------------' (0,{col_barname},15)
print '-------------------------------' (0,{col_baritemname},30)
print '-------------------------------' (0,{col_pnlitemname},30)
print '-------' (0,{col_display},7)
end-heading

begin-procedure Print-Detail-1
if $menuname <> $old_menuname
print $menuname (0,{col_menuname},30)
let $old_menuname=$menuname
else
print ' ' (0,{col_menuname},30)
end-if
if $barname <> $old_barname
print $barname (0,{col_barname},15)
let $old_barname=$barname
else
print ' ' (0,{col_barname},15)
end-if
if $baritemname <> $old_baritemname
print $baritemname (0,{col_baritemname},30)
let $old_baritemname=$baritemname
if #authorizedactions<> 0
do Print-Action
end-if
else
print ' ' (0,{col_baritemname},30)

end-if
do Print-Detail-2
end-procedure

begin-procedure Print-Detail-2

print $pnlitemname (0,{col_pnlitemname},30)
if #displayonly=0
let $display='No'
else
let $display='Yes'
end-if
let #col={col_display}+2
print $display (0,#col,3)
write 1 from $menuname:30 $filler:2 $barname:15 $filler:2 $baritemname:30 $filler:2 $pnlitemname:30 $filler:2 $display:3
end-procedure

begin-procedure Print-Action
do Clear-Action-Array
if mod(#authorizedactions,2)=1
let $action='Add'
let #authorizedactions=#authorizedactions - 1
else
let $action='NA'
end-if
let #priority=1
do Put-Action-Array
if #authorizedactions >= 114
let $action='Data Entry'
let #authorizedactions=#authorizedactions - 114
else
let $action='NA'
end-if
let #priority=5
do Put-Action-Array
if #authorizedactions >= 8
let $action='Correction'
let #authorizedactions=#authorizedactions - 8
else
let $action='NA'
end-if
let #priority=4
do Put-Action-Array
if #authorizedactions >= 4
let $action='Update/Display All'
let #authorizedactions=#authorizedactions - 4
else
let $action='NA'
end-if
let #priority=3
do Put-Action-Array
if #authorizedactions >= 2
let $action='Update/Display'
let #authorizedactions=#authorizedactions - 2
else
let $action='NA'
end-if
let #priority=2
do Put-Action-Array
if #authorizedactions = 2
let #priority=4
let $action='NA'
let #authorizedactions=#authorizedactions - 2
do Put-Action-Array
end-if
if #authorizedactions = 10
let #priority=3
let $action='NA'
let #authorizedactions=#authorizedactions - 10
do Put-Action-Array
end-if

if #authorizedactions>0 and #authorizedactions<>14
let $action='**Unknown** ' || to_char(#authorizedactions)
else
let $action='NA'
end-if
let #priority=6
do Put-Action-Array

let #priority= 1
while #priority < 7
do Get-Action-Array
if $action <>'NA'
print $action (0,{col_pnlitemname},20)
write 1 from $menuname:30 $filler:2 $barname:15 $filler:2 $baritemname:30 $filler:2 $action:30 $filler:2 $display:3
next-listing
end-if
let #priority=#priority+1
end-while
end-procedure


begin-procedure Init-Report

move 'SECURITY.SQR' to $ReportID
move 'Operator Security Report' to $ReportTitle
display $ReportTitle
do Stdapi-Init

if $prcs_process_instance = ''
do Get-Values
else
! do Select-Parameters
end-if

end-procedure

begin-procedure Get-Values
input $id maxlen=8 'Enter Operator ID or Class '
let $id=upper($id)
while length($filename) < 2
input $filename 'Enter Filename (including path) '
end-while
end-procedure

begin-procedure Individual-Or-Class
begin-SELECT

OPD1.OPRTYPE
OPD1.OPRCLASS
let #oprtype=&OPD1.OPRTYPE
let $oprclass=&OPD1.OPRCLASS


FROM PSOPRDEFN OPD1
WHERE OPD1.OPRID=$id

end-SELECT
if #oprtype=0
let $id=$oprclass
end-if
end-procedure

begin-procedure Open-File
Open $filename as 1 for-writing record=120
let $filler=' '
end-procedure


begin-procedure Close-File
Close 1
end-procedure

begin-procedure Create-Action-Array
create-array name=action_array size=10
field=action:char:20
end-procedure

begin-procedure Clear-Action-Array
clear-array name=action_array
end-procedure

begin-procedure Get-Action-Array
get $action from action_array(#priority)
end-procedure

begin-procedure Put-Action-Array
put $action into action_array(#priority)
end-procedure

begin-procedure Select-PSAUTHITEM-Rows
next-listing
begin-SELECT
AU1.OPRID
AU1.MENUNAME
AU1.BARNAME
AU1.BARITEMNAME
AU1.PNLITEMNAME
AU1.DISPLAYONLY
AU1.AUTHORIZEDACTIONS
MI1.ITEMNUM
PG1.SUBITEMNUM

let $operid=&AU1.OPRID
let $menuname=&AU1.MENUNAME
let $barname=&AU1.BARNAME
let $baritemname=&AU1.BARITEMNAME
let $pnlitemname=&AU1.PNLITEMNAME
let #displayonly=&AU1.DISPLAYONLY
let #authorizedactions=&AU1.AUTHORIZEDACTIONS

do Print-Detail-1
next-listing
FROM PSAUTHITEM AU1, PSMENUITEM MI1, PSPNLGROUP PG1
WHERE AU1.OPRID=$id
AND AU1.MENUNAME=MI1.MENUNAME
AND AU1.BARNAME=MI1.BARNAME
AND AU1.BARITEMNAME=MI1.ITEMNAME
AND PG1.PNLNAME=MI1.PNLGRPNAME
AND PG1.MARKET=MI1.MARKET
AND PG1.ITEMNAME=AU1.PNLITEMNAME

ORDER BY AU1.MENUNAME, MI1.ITEMNUM, PG1.SUBITEMNUM
end-SELECT
end-procedure

begin-procedure Report
!
end-procedure


#Include 'curdttim.sqc' !Get-Current-DateTime procedure
#Include 'datetime.sqc' !Routines for date and time formatting
#Include 'number.sqc' !Routines to format numbers
#Include 'payinit.sqc' !Report Initialization and Timing
#Include 'payrctl3.sqc' !Select-Paramenters procedure
#Include 'reset.sqc' !Reset printer procedure
#Include 'stdapi.sqc' !Update Process API


Go to egroups: