tldm-universe/CMS/BP.CLOCK/MSD.ACCRUAL.RPT2
2024-09-10 15:25:06 -04:00

350 lines
11 KiB
Plaintext
Executable File

SUBROUTINE MSD.ACCRUAL.REPORT
*
* 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
$INCLUDE CLOCK.PAY.DATES
*
*---- 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'
OPEN 'CLOCK.PAY.DATES' TO CLOCK.PAY.DATES ELSE ABORT 201, 'CLOCK.PAY.DATES'
*
*---- 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=''
TOTALS='' ; GRAND.TOTALS=''
FOR X = 1 TO 13 ;* init column totals
TOTALS<X>=0
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):' Period 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):' date 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 DATE FOR REPORT ":ERV:
CRT @(8,6):CL:RV:" PAY PERIOD DATE :":ERV:" ":
INPUT PAY.DATE,10
IF PAY.DATE=PF3 THEN STOP
PAY.DATE=ICONV(PAY.DATE,'D')
IF PAY.DATE < 1 THEN GO 200
CRT @(39,6):CL:OCONV(PAY.DATE,'D2/')
*
FIRST.PERIOD=''
300 *
CRT @(8,6):CL:RV:" PAY PERIOD DATE :":ERV:" ":OCONV(PAY.DATE,'D2/')
350 *
*--- figure beginning and ending pay period date --------------------*
*
PERIOD=OCONV(PAY.DATE,'D2/') ;* default current period
PERIOD=PERIOD[7,2]:"/":PERIOD[1,2]
PERIOD.KEY=PERIOD[1,2]:PERIOD[4,2]
READ PAY.REC FROM CLOCK.PAY.DATES,PERIOD.KEY THEN
LOCATE(PAY.DATE,PAY.REC,CPD$PAY.DATE;ZND) THEN
FIRST.DATE=PAY.REC<CPD$PERIOD.BEGIN,ZND>
SECOND.DATE=PAY.REC<CPD$PERIOD.END,ZND>
QUIT=''
END ELSE
QUIT=1
END
END ELSE
QUIT=1
END
IF QUIT THEN
CRT @(0,22):CL:BEEP:RV:" Verify pay date in MSD.PAY.DATES! <return> :":ERV:
INPUT ANY,9
STOP
END
*
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='799':VM:'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! <return> :":ERV:
INPUT ANY,4
GO 377
END
GO 405 ;* skip active prompt
CASE DEPT='9'
D.TABLE='518'
END CASE
*
400 *---- select users by status --------------------------------*
CRT @(0,11):CR:
CRT @(0,22):CL:RV:" REPORT 'A'ctive users, 'I'nactive users or 'B'oth :":ERV:
INPUT ACTIVE.ANS,3
IF ACTIVE.ANS='' OR ACTIVE.ANS=PF3 THEN STOP
IF ACTIVE.ANS='A' OR ACTIVE.ANS='I' OR ACTIVE.ANS='B' OR ACTIVE.ANS='' OR ACTIVE.ANS=PF3 ELSE GO 200
*
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=''
*
H2=SPACE(69):'FOR DATE RANGE ':OCONV(FIRST.DATE,'D2/'):" TO ":OCONV(SECOND.DATE,'D2/')
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<UR$DEPT>
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<UR$LAST.PAY.DATE>
IF LAST.PAY.DATE = PAY.DATE ELSE GO 2000
IF NOT(FIRST.SW) THEN
IF DEPART # LAST.DEPT THEN
LINE=STR('-',171)
GOSUB 8000
IF DEPART='799' 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<UR$LNAME>:", ":UREC<UR$FNAME>
LINE=NAME'L#20':SPACE(1)
LINE=LINE:USER.KEY'L#4':SPACE(2)
LINE=LINE:DEPART'R#4':SPACE(2)
USTATUS=UREC<UR$STATUS>
*------ user status' for report --------*
IF ACTIVE.ANS='A' THEN
IF UREC<UR$TOTAL.HOURS> > 0 ELSE GO 2000
END
IF ACTIVE.ANS='I' THEN
IF USTATUS # 'I' THEN GO 2000
END
LINE=LINE:UREC<UR$STATUS>'L#2':SPACE(2)
TYPE=UREC<UR$TYPE.CODE>
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<UR$CLOCK.SYSTEM>'L#1':SPACE(2)
LINE=LINE:OCONV(UREC<UR$LAST.PAY.DATE>,'D2/')'R#8':SPACE(2)
LINE=LINE:OCONV(UREC<UR$VACATION.AVAIL>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$PERSONAL.AVAIL>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$REGULAR.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$OT.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$VACATION.HOURS>,'MR2')'R#7':SPACE(2)
*--- modify: no sick time -----------------------------------*
*LINE=LINE:OCONV(UREC<UR$SICK.HOURS>,'MR2')'R#7':SPACE(2)
*
LINE=LINE:OCONV(UREC<UR$HOLIDAY.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$FUNERAL.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$PERSONAL.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$BONUS.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$WORKMANS.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$JURY.DUTY.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$OTHER.HOURS>,'MR2')'R#7':SPACE(2)
LINE=LINE:OCONV(UREC<UR$TOTAL.HOURS>,'MR2')'R#7':SPACE(2)
WT=WT+1
GOSUB 6000 ;* increment totals
GOSUB 6500 ;* increment grand totals
GOSUB 8000 ;* print line
END
2000 *
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 <return> :":ERV:
INPUT ANY,3
RETURN
*
6000 *--- total figures ----------------------------------------*
TOTALS<1>=''
TOTALS<2>=''
TOTALS<3>=TOTALS<3>+UREC<UR$REGULAR.HOURS>
TOTALS<4>=TOTALS<4>+UREC<UR$OT.HOURS>
TOTALS<5>=TOTALS<5>+UREC<UR$VACATION.HOURS>
TOTALS<6>=TOTALS<6>+UREC<UR$HOLIDAY.HOURS>
TOTALS<7>=TOTALS<7>+UREC<UR$FUNERAL.HOURS>
TOTALS<8>=TOTALS<8>+UREC<UR$PERSONAL.HOURS>
TOTALS<9>=TOTALS<9>+UREC<UR$BONUS.HOURS>
TOTALS<10>=TOTALS<10>+UREC<UR$WORKMANS.HOURS>
TOTALS<11>=TOTALS<11>+UREC<UR$JURY.DUTY.HOURS>
TOTALS<12>=TOTALS<12>+UREC<UR$OTHER.HOURS>
TOTALS<13>=TOTALS<13>+UREC<UR$TOTAL.HOURS>
RETURN
*
6500 *--- grand total figures ----------------------------------*
GRAND.TOTALS<1>=''
GRAND.TOTALS<2>=''
GRAND.TOTALS<3>=GRAND.TOTALS<3>+UREC<UR$REGULAR.HOURS>
GRAND.TOTALS<4>=GRAND.TOTALS<4>+UREC<UR$OT.HOURS>
GRAND.TOTALS<5>=GRAND.TOTALS<5>+UREC<UR$VACATION.HOURS>
GRAND.TOTALS<6>=GRAND.TOTALS<6>+UREC<UR$HOLIDAY.HOURS>
GRAND.TOTALS<7>=GRAND.TOTALS<7>+UREC<UR$FUNERAL.HOURS>
GRAND.TOTALS<8>=GRAND.TOTALS<8>+UREC<UR$PERSONAL.HOURS>
GRAND.TOTALS<9>=GRAND.TOTALS<9>+UREC<UR$BONUS.HOURS>
GRAND.TOTALS<10>=GRAND.TOTALS<10>+UREC<UR$WORKMANS.HOURS>
GRAND.TOTALS<11>=GRAND.TOTALS<11>+UREC<UR$JURY.DUTY.HOURS>
GRAND.TOTALS<12>=GRAND.TOTALS<12>+UREC<UR$OTHER.HOURS>
GRAND.TOTALS<13>=GRAND.TOTALS<13>+UREC<UR$TOTAL.HOURS>
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<X>,'MR2')'R#8':SPACE(1)
END
NEXT X
GOSUB 8000
GOSUB 8000
*
RETURN