COMPILE SUBROUTINE Print_Attendance(void) /* Print Attendance Report 02/22/2010 - John C. Henry, J.C. Henry & Co., Inc. - Initial coding */ DECLARE SUBROUTINE Utility, ErrMsg, Set_Status, Set_Printer, RList, Utility, ErrMsg DECLARE FUNCTION Set_Printer, Get_Printer, Msg, Get_Status, Printer_Select, obj_Install, Dialog_Box DECLARE FUNCTION Utility $INSERT OIPRINT_EQUATES $INSERT APPCOLORS $INSERT MSG_EQUATES $INSERT ATTENDANCE_EQUATES EQU TAB$ TO \09\ EQU TARGET_ACTIVELIST$ TO 5 ErrorTitle = 'Error in stored procedure Print_Attendance' Parms = Dialog_Box( 'ATTENDANCE_SRPT1', @WINDOW, '*CENTER' ) IF Parms = 'CANCEL' OR Parms = '' THEN RETURN END OPEN 'ATTENDANCE' TO AttendanceTable ELSE ErrorMsg = 'Unable to open "ATTENDANCE" table.' ErrMsg(ErrorTitle:@SVM:ErrorMsg) RETURN END BegDt = Parms[1,'*'] EndDt = Parms[COL2()+1,'*'] Employees = Parms[COL2()+1,'*'] Supervisors = Parms[COL2()+1,'*'] Shifts = Parms[COL2()+1,'*'] IF Employees[1,1] = @VM THEN Employees[1,1] = '' IF Employees[-1,1] = @VM THEN Employees[-1,1] = '' IF Supervisors[1,1] = @VM THEN Supervisors[1,1] = '' IF Supervisors[-1,1] = @VM THEN Supervisors[-1,1] = '' SelectSent = 'SELECT ATTENDANCE ' DateOpt = 0 TitleLines = '' IF Len(BegDt) THEN DateOpt = 1 IF Len(EndDt) THEN TitleLines<-1> = 'Dates Absent: ':BegDt:' Through ':EndDt SelectSent := " WITH DATE_ABSENT FROM '":BegDt:"' TO '": EndDt: "' " END ELSE TitleLines<-1> = 'Date Range: ':BegDt:' Through ':CurDt SelectSent := " WITH DATE_ABSENT FROM '":BegDt:"' TO '": CurDt: "' " END END ELSE IF Len(EndDt) THEN TitleLines<-1> = 'Date Range: Earliest Through ':CurDt SelectSent := " WITH DATE_ABSENT <= '": CurDt: "' " END ELSE TitleLines<-1> = 'Date Range: ALL' END END CONVERT @VM TO ' ' IN Shifts IF Shifts THEN ShiftOpt = 1 TitleLines<-1> = 'Shifts: ':Shifts IF SelectSent THEN SelectSent := ' AND' SelectSent := " WITH SHIFT = ": Shifts: " " END ELSE TitleLines<-1> = 'Shifts: ALL' END EmpOpt = 0 IF Employees THEN EmpOpt = 1 Swap @VM With "' '" In Employees IF SelectSent THEN SelectSent := ' AND' SelectSent := " WITH EMPLOYEE = '": Employees: "' " END SupOpt = 0 IF Supervisors THEN SupOpt = 1 Swap @VM WITH "' '" In Supervisors IF SelectSent THEN SelectSent := ' AND' SelectSent := " WITH SUPERVISOR = '": Supervisors: "' " END *Void = utility( 'CURSOR', 'H' ) SelectSent := ' BY EMPLOYEE_NAME BY-DSND DATE_ABSENT' Set_Status(0) RList(SelectSent,TARGET_ACTIVELIST$,'','','') IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END * Start of printing process FileName = 'Print Attendance Report' Title = 'Printing Attendance Report':@VM:'Print_Attendance' TopMargin = 1.30 BottomMargin = 0.75 LeftMargin = 0.5 RightMargin = 0.5 Margins = LeftMargin:@FM:TopMargin:@FM:RightMargin:@FM:BottomMargin PageSetup = '0' ;* Landscape = 1 PrintSetup = '2' ;* Preview Normal PrintPath = Printer_Select() IF PrintPath = '' THEN RETURN stat = Set_Printer('INIT',FileName,Title,Margins,PageSetup,PrintSetup,PrintPath) IF stat < 0 THEN GOTO OIPrintErr font = 'Arial' ;* Font basics font<2> = 10 font<4> = 0 stat = Set_Printer('FONTHEADFOOT', font) stat = Set_Printer('LINESTYLE', PS_SOLID:@FM:2) stat = Set_Printer('LINE', -0.1:@FM:-1.2:@FM:7.5:@FM:-1.2, 1) stat = Set_Printer('LINE', -0.1:@FM:-0.1:@FM:7.5:@FM:-0.1, 1) location = -.15:@fm:-1.150:@fm:1.57:@fm:1 stat = Set_Printer('BMP',obj_Install('Get_Prop','ColorBMP'),location, 0,1) * * * * Added 10/8/2015 JCH - Updated 'CONFIG','COMPANY' * * * * InstDat = obj_Install('Get_Prop','Company':@FM:'Division') Company = InstDat<1> Division = InstDat<2> font = 'Arial' font<2> = '12' ;* Big type font<4> = 1 ;* Bold on font<5> = 0 ;* Italics stat = Set_Printer('TEXTXY',Company,5.7:@FM:-1.15,font,1) stat = Set_Printer('TEXTXY',Division,5.7:@FM:-0.970,font,1) font<2> = 10 ;* 10 point font font<4> = 0 ;* Bold off font<5> = 0 ;* Italics Off stat = Set_Printer('TEXTXY',obj_Install('Get_Prop','Address'), 5.7:@fm:-0.775, font,1) stat = Set_Printer('TEXTXY',obj_Install('Get_Prop','CSZC'), 5.7:@fm:-0.625, font,1) stat = Set_Printer('TEXTXY','Tel: ':obj_Install('Get_Prop','Phone'), 5.7:@fm:-0.475, font, 1) stat = Set_Printer('TEXTXY','FAX: ':obj_Install('Get_Prop','FAX'), 5.7:@fm:-0.325, font, 1) * * * * End of changes 10/8/2015 JCH * * * * Header = @VM:"Attendance Report":@FM LineCnt = COUNT(TitleLines,@FM) + (TitleLines NE '') FOR I = 1 TO LineCnt Header<-1> = @VM:TitleLines NEXT I Header<-1> = '' ;* Blank line following heading font = 'Arial' font<2> = '10' font<4> = '1' ;* Bold stat = Set_Printer('FONTHEADFOOT',font) ; IF stat < 0 THEN GOTO OIPrintErr stat = Set_Printer('HEADER',Header) ; IF stat < 0 THEN GOTO OIPrintErr Footer = " 'D' 'T'":@VM:@VM:"Page: 'P'" stat = Set_Printer('FOOTER',Footer) ; IF stat < 0 THEN GOTO OIPrintErr * Make Column Heading colHead = 'Seq' ; colFmt = '^720' colHead<1,2> = 'Employee' ; colFmt<1,2> = '<2160' colHead<1,3> = 'Date':CRLF$:'Absent' ; colFmt<1,3> = '^1440' colHead<1,4> = 'Excused' ; colFmt<1,4> = '^1080' colHead<1,5> = 'Shift' ; colFmt<1,5> = '^720' colHead<1,6> = 'Supervisor' ; colFmt<1,6> = '^2160' colHead<1,7> = 'Type' ; colFmt<1,7> = '<2160' FirstLine = 1 Done = 0 LOOP READNEXT AttendNo ELSE Done = 1 UNTIL Done READ AttendRec FROM AttendanceTable,AttendNo THEN Employee = XLATE('LSL_USERS',AttendRec,'FIRST_LAST','X') DateAbsent = OCONV(AttendRec, 'D4/') Excused = OCONV(AttendRec,'B') Shift = AttendRec Supervisor = XLATE('LSL_USERS',AttendRec,'FIRST_LAST','X') Type = AttendRec colData = '' colData<1,1> = AttendNo colData<1,2> = Employee colData<1,3> = DateAbsent colData<1,4> = Excused colData<1,5> = Shift colData<1,6> = Supervisor colData<1,7> = Type GOSUB PrintTable END ; * End of AttendRec Read REPEAT ;* End of first phase * * * * * * * Bail: * * * * * * * stat = Set_Printer('TERM',1) RETURN * * * * * * * OIPrintErr: * * * * * * * ErrMsg(ErrorTitle:@SVM:ErrorMsg) ErrMsg(ErrorTitle:@SVM:'Set_Printer returned errorcode ':stat) stat = Set_Printer('TERM',1) RETURN * * * * * * PrintTable: * * * * * * stat = Set_Printer('CALCTABLE',colFmt:@FM:colData) TableSize = Get_Printer('CALCTABLE') TableHeight = TableSize<2> Test = Get_Printer('POS')<2> IF Get_Printer('POS')<2> + TableHeight > 6.50 OR FirstLine THEN IF NOT(FirstLine) THEN stat = Set_Printer('PAGEBREAK') END FirstLine = 0 font<2> = 10 font<4> = 1 ;* Bold stat = Set_Printer('FONT',font,'125') stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL) font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7) END ELSE font<2> = 10 font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL) END RETURN