SUBROUTINE MSD.ACCRUAL.REPORT.2 * * AUTHOR: SCOTT REDMOND * DATE: 04/04/95 * PURPOSE: VACATION/SICK TIME ACCRUAL REPORT (TIME BREAKDOWN) * * UPDATED: MODIFIED TO PRINT HISTORY RECORDS - STR 04/06/95 * FILE = 'INFO.HIST' * *--- includes ---------------------------------------------------* * $INCLUDE GEN.COMMON $INCLUDE USER * *---- open files ------------------------------------------------* * OPEN 'USER' TO USER.FILE ELSE ABORT 201, 'USER' OPEN 'HP.CONTROL' TO HPC ELSE ABORT 201, 'HP.CONTROL' OPEN 'CLOCK.GEN.KEYS' TO CLOCK.GEN.KEYS ELSE ABORT 201, 'CLOCK.GEN.KEYS' OPEN 'INFO.HIST' TO INFO.HIST ELSE ABORT 201, 'INFO.HIST' * *---- initialize variables --------------------------------------* * EOF=0 ; T=0 ; WT=0 ; CHANNEL.1=CHAR(12) ; PAGECNT=0 ; LNCT=99 TODAY=DATE() ; LAST.DEPT='' ; FIRST.SW=1 ; MICAHTEK.FLAG='' SDATE=ICONV('03/26/94','D') TOTALS='' ; GRAND.TOTALS='' * FOR X = 1 TO 14 ;* init column totals TOTALS=0 NEXT X * *--- load time table for pay period reference ------------------* TIME.TABLE='' START=0 FOR X = SDATE TO TODAY STEP 14 START=START+1 TIME.TABLE=INSERT(TIME.TABLE,1,START;X+1) TIME.TABLE=INSERT(TIME.TABLE,2,START;X+14) TIME.TABLE=INSERT(TIME.TABLE,3,START;START) NEXT X * TODAY=OCONV(DATE(),'D2/') *----------------------------------------------------------------* * 10 *--- screen heading ---* CRT CS HDG='CLOCK/PROJECT/MANAGER TIME DETAIL REPORT' HDL=(80 - LEN(HDG)) /2 CRT @(0,0):CL:RV:STR(' ',80):ERV CRT @(HDL,0):RV:HDG:ERV: * READ JEN.REC FROM CLOCK.GEN.KEYS,"NEXT.PAY.PERIOD" ELSE CRT @(0,22):CL:RV:" ERROR - MISSING CLOCK.GEN.KEYS ITEM! ":ERV: INPUT ANY,3 STOP END *--- report headings ------------------------------------------------* H1=TODAY'L#8':SPACE(58):'MICAHTEK, MSD & IDM USER TIME DETAIL REPORT' H3A=SPACE(46):'Last pay Vac Personal Reg OT Vac Holiday' H3A=H3A:' Funeral Personal Bonus W. Comp Jury Non-Reg Total' H3='User Name':SPACE(11):' Code Dept Sta Type Clk' H3=H3:SPACE(1):' Period Avail Avail Work Work Used Used' H3=H3:SPACE(1):' Used Used Used Used Used Hours Hours' * 200 *--- enter beginning pay period date ---------------------------* CRT @(0,22):CL:RV:" ENTER THE PAY PERIOD BEGINNING DATE FOR REPORT ":ERV: CRT @(8,6):CL:RV:" PAY PERIOD BEGINNING DATE :":ERV:" ":OCONV(JEN.REC<1>-14,'D2/') CRT @(38,6): INPUT FIRST.DATE,10 IF FIRST.DATE=PF3 THEN STOP IF FIRST.DATE='' THEN FIRST.DATE=OCONV(JEN.REC<1>-14,'D2/') FIRST.DATE=ICONV(FIRST.DATE,'D') IF FIRST.DATE <= SDATE THEN FIRST.DATE=SDATE+1 IF FIRST.DATE > JEN.REC<1>-14 THEN CRT @(39,6):CL:OCONV(FIRST.DATE,'D2/') CRT @(0,22):CL:BEEP:RV:" The last pay period processed was ":OCONV(JEN.REC<1>-14,'D2/'):" :":ERV: INPUT ANY,3 FIRST.DATE=JEN.REC<1>-14 END IF FIRST.DATE < 1 THEN GO 200 CRT @(39,6):CL:OCONV(FIRST.DATE,'D2/') * *--- figure beginning and ending pay period date --------------------* LOCATE(FIRST.DATE,TIME.TABLE,1;WHR;"AR") THEN NULL IF TIME.TABLE<2,START> >= TODAY THEN POSITION=START-1 END ELSE POSITION=START END IF FIRST.DATE = TIME.TABLE<1,WHR> THEN POSITION=WHR END ELSE IF FIRST.DATE <= TIME.TABLE<2,WHR> THEN POSITION=WHR-1 END END FIRST.PERIOD=TIME.TABLE<3,POSITION> FIRST.DATE=TIME.TABLE<1,POSITION> SECOND.HOLD=TIME.TABLE<2,POSITION> 300 * CRT @(8,6):CL:RV:" PAY PERIOD BEGINNING DATE :":ERV:" ":OCONV(FIRST.DATE,'D2/') CRT @(8,8):CR:RV:" PAY PERIOD ENDING DATE :":ERV:" ":OCONV(SECOND.HOLD,'D2/') 350 * CRT @(0,22):CL:RV:" ENTER THE LAST PAY PERIOD DATE FOR REPORT ":ERV: CRT @(8,8):CL:RV:" PAY PERIOD ENDING DATE :":ERV:" ":OCONV(SECOND.HOLD,'D2/') CRT @(38,8): INPUT SECOND.DATE,10 IF SECOND.DATE=PF3 THEN STOP IF SECOND.DATE='' THEN SECOND.DATE=OCONV(SECOND.HOLD,'D2/') SECOND.DATE=ICONV(SECOND.DATE,'D') IF SECOND.DATE > JEN.REC<1>-1 THEN CRT @(39,8):CL:OCONV(SECOND.DATE,'D2/') CRT @(0,22):CL:BEEP:RV:" The last pay period processed was ":OCONV(JEN.REC<1>-14,'D2/'):" :":ERV: INPUT ANY,3 SECOND.DATE=JEN.REC<1>-1 END IF SECOND.DATE < 1 THEN GO 200 CRT @(39,8):CL:OCONV(SECOND.DATE,'D2/') *--- figure beginning and ending pay period date --------------------* LOCATE(SECOND.DATE,TIME.TABLE,1;WHR;"AR") THEN NULL IF TIME.TABLE<2,START> >= TODAY THEN POSITION=START-1 END ELSE POSITION=START END IF SECOND.DATE = TIME.TABLE<1,WHR> THEN POSITION=WHR END ELSE IF SECOND.DATE <= TIME.TABLE<2,WHR> THEN POSITION=WHR-1 END END SECOND.PERIOD=TIME.TABLE<3,POSITION> NUM.PERIODS=(SECOND.PERIOD-FIRST.PERIOD)+1 CRT @(8,10):CL:RV:" NUMBER OF PAY PERIODS :":ERV:" ":NUM.PERIODS * 375 *----- select users by department ----------------------------* * * * Note: Do not change the selection numbers to the following * menu options. The numbers are hard-coded other places. * * CRT @(27,12):CL:RV:" 1 - SPECIAL ACCOUNTS ":ERV: CRT @(27,13):CL:RV:" 2 - PERSONNEL ":ERV: CRT @(27,14):CL:RV:" 3 - PROGRAMMING ":ERV: CRT @(27,15):CL:RV:" 4 - PHONE CENTER ":ERV: CRT @(27,16):CL:RV:" 5 - WOF PROCESSING ":ERV: CRT @(27,17):CL:RV:" 6 - WAREHOUSE ":ERV: CRT @(27,18):CL:RV:" 7 - ALL DEPARTMENTS ":ERV: CRT @(27,19):CL:RV:" 8 - INDIVIDUAL ":ERV: CRT @(27,20):CL:RV:" 9 - MANAGEMENT ":ERV: CRT @(0,22):CL:RV:" ENTER DEPARTMENT : ":ERV: INPUT DEPT,9 IF DEPT='' OR DEPT=PF3 THEN RETURN IF NUM(DEPT) ELSE GO 375 IF DEPT < 1 OR DEPT > 9 THEN GO 375 D.TABLE='' ; INDI.FLAG='' BEGIN CASE CASE DEPT='1' D.TABLE='511' CASE DEPT='2' D.TABLE='517' CASE DEPT='3' D.TABLE='504':VM:'512' CASE DEPT='4' D.TABLE='800' CASE DEPT='5' D.TABLE='500':VM:'501':VM:'502':VM:'503':VM:'505':VM:'509':VM:'514':VM:'525' CASE DEPT='6' D.TABLE='506':VM:'507' CASE DEPT='7' CASE DEPT='8' 377 * INDI.FLAG=1 CRT @(0,22):CL:RV:" ENTER THE INDIVIDUAL'S USER CODE :":ERV: INPUT USER.INDI,9 IF USER.INDI=PF3 THEN STOP READ INDI.REC FROM USER.FILE,USER.INDI ELSE CRT @(0,22):CL:BEEP:RV:" INVALID USER CODE! :":ERV: INPUT ANY,4 GO 377 END GO 405 ;* skip active prompt CASE DEPT='9' D.TABLE='518' END CASE * 405 * CRT @(0,11):CR: CRT @(0,22):CL:RV:" ENTER 'B' TO BEGIN REPORT :":ERV: INPUT BEGIN.ANS,4 IF BEGIN.ANS[1,1] # 'B' THEN STOP * *--- report will automatically landscape + 16.pitch ------------------* CRT @(8,16):CR:BEEP:RV:" This report must be sent to a laser printer! ":ERV: CRT @(0,18): EXECUTE "EX PRINTER" CRT @(0,16):CR: * PRINTER ON READ SMALL FROM HPC,'16.PITCH' ELSE SMALL='' READ LAND FROM HPC,'LANDSCAPE' ELSE LAND='' READ RESET FROM HPC,'RESET' ELSE RESET='' * IF NUM.PERIODS < 2 THEN H2=SPACE(75):'FOR PAY PERIOD ':OCONV(FIRST.DATE,'D') END ELSE H2=SPACE(69):'FOR DATE RANGE ':OCONV(FIRST.DATE,'D2/'):" TO ":OCONV(SECOND.DATE,'D2/') END PRINT SMALL ; PRINT LAND * *------ select file -------------------------------------------* CRT @(0,22):CL:RV:" SELECTING FILE...PLEASE WAIT! ":ERV: HUSH ON EXECUTE "SSELECT INFO.HIST BY DEPT BY LNAME BY FNAME BY LAST.PAY.DATE" HUSH OFF * LOOP READNEXT ID ELSE EOF=1 UNTIL EOF DO T=T+1 IF REM(T,250)=0 THEN CRT @(8,16):CR:"REPORT RECORDS READ :":T CRT @(8,17):CL:"RECORDS IN DATE RANGE :":WT END USER.KEY=OCONV(ID,'G0*1') READ UREC FROM INFO.HIST,ID THEN DEPART=UREC IF INDI.FLAG THEN ;* if individual (one person) IF USER.KEY # USER.INDI THEN GO 2000 ACTIVE.ANS='B' END ELSE IF DEPT # '7' THEN ;* (7 i.e., all depts) LOCATE(DEPART,D.TABLE,1;FND) ELSE GO 2000 END END LAST.PAY.DATE=UREC IF LAST.PAY.DATE >= FIRST.DATE AND LAST.PAY.DATE <= SECOND.DATE ELSE GO 2000 IF NOT(FIRST.SW) THEN IF DEPART # LAST.DEPT THEN LINE=STR('-',171) GOSUB 8000 IF DEPART='800' THEN ;* subtotal idm then begin micahtek IF DEPT # '4' THEN ;* more than phone center selected MICAHTEK.FLAG=1 ;* micahtek totals will be printed LINE='****** IDM TOTALS':SPACE(56) GOSUB 10000 ;* print subtotals GOSUB 8000 TOTALS='' END END END END FIRST.SW='' LAST.DEPT=DEPART NAME=UREC:", ":UREC LINE=NAME'L#20':SPACE(1) LINE=LINE:USER.KEY'L#4':SPACE(2) LINE=LINE:DEPART'R#4':SPACE(2) USTATUS=UREC LINE=LINE:UREC'L#2':SPACE(2) TYPE=UREC IF TYPE='F' THEN TYPE='FULL' IF TYPE='P' THEN TYPE='PART' IF TYPE='M' THEN TYPE='MGR ' IF TYPE='O' THEN TYPE='OTHR' LINE=LINE:TYPE'L#4':SPACE(2) LINE=LINE:UREC'L#1':SPACE(2) LINE=LINE:OCONV(UREC,'D2/')'R#8':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) LINE=LINE:OCONV(UREC,'MR2')'R#7':SPACE(2) WT=WT+1 GOSUB 6000 ;* increment totals GOSUB 6500 ;* increment grand totals GOSUB 8000 ;* print line END REPEAT * CRT @(8,16):CL:"REPORT RECORDS READ :":T CRT @(8,17):CL:"RECORDS IN DATE RANGE :":WT * LINE=STR('=',172) GOSUB 8000 ;* print totals line * IF MICAHTEK.FLAG THEN LINE='**** MICAHTEK TOTALS':SPACE(52) GOSUB 10000 ;* print micahtek totals GOSUB 8000 END TOTALS=GRAND.TOTALS LINE='**** GRAND TOTALS':SPACE(55) GOSUB 10000 ;* print totals GOSUB 8000 GOSUB 8000 LINE='END OF REPORT' GOSUB 8000 * 9999 * CRT @(0,20):CR: PRINT RESET PRINTER CLOSE PRINTER OFF CRT @(0,22):CL:RV:" PROCESS COMPLETE :":ERV: INPUT ANY,3 RETURN * 6000 *--- total figures ----------------------------------------* TOTALS<1>='' TOTALS<2>='' TOTALS<3>=TOTALS<3>+UREC TOTALS<4>=TOTALS<4>+UREC TOTALS<5>=TOTALS<5>+UREC TOTALS<6>=TOTALS<6>+UREC TOTALS<7>=TOTALS<7>+UREC TOTALS<8>=TOTALS<8>+UREC TOTALS<9>=TOTALS<9>+UREC TOTALS<10>=TOTALS<10>+UREC TOTALS<11>=TOTALS<11>+UREC TOTALS<12>=TOTALS<12>+UREC TOTALS<13>=TOTALS<13>+UREC RETURN * 6500 *--- grand total figures ----------------------------------* GRAND.TOTALS<1>='' GRAND.TOTALS<2>='' GRAND.TOTALS<3>=GRAND.TOTALS<3>+UREC GRAND.TOTALS<4>=GRAND.TOTALS<4>+UREC GRAND.TOTALS<5>=GRAND.TOTALS<5>+UREC GRAND.TOTALS<6>=GRAND.TOTALS<6>+UREC GRAND.TOTALS<7>=GRAND.TOTALS<7>+UREC GRAND.TOTALS<8>=GRAND.TOTALS<8>+UREC GRAND.TOTALS<9>=GRAND.TOTALS<9>+UREC GRAND.TOTALS<10>=GRAND.TOTALS<10>+UREC GRAND.TOTALS<11>=GRAND.TOTALS<11>+UREC GRAND.TOTALS<12>=GRAND.TOTALS<12>+UREC GRAND.TOTALS<13>=GRAND.TOTALS<13>+UREC RETURN * 8000 *--- print line -------------------------------------------* IF LNCT > 43 THEN PRINT CHANNEL.1 PAGECNT=PAGECNT+1 H1B=H1:SPACE(50):"PAGE ":PAGECNT PRINT H1B PRINT H2 PRINT PRINT H3A PRINT H3 PRINT LNCT=6 END PRINT LINE LINE='' LNCT=LNCT+1 RETURN * * 10000 *---- print subtotals -----------------------------------* * FOR X = 1 TO 13 IF X > 2 THEN LINE=LINE:OCONV(TOTALS,'MR2')'R#8':SPACE(1) END NEXT X GOSUB 8000 GOSUB 8000 * RETURN