tldm-universe/CMS/BP.CLOCK/JOHN.L
2024-09-10 15:25:06 -04:00

150 lines
3.4 KiB
Common Lisp
Executable File

*---------------------------*
* JOHN'S FIRST PROGRAM
* MAY 14, 1991
*---------------------------*
CS=@(-1) ; CR=@(-3) ; CL=@(-4) ; RV=@(-13) ; ERV=@(-14)
VM=CHAR(253) ; SVM=CHAR(252) ; AM=CHAR(254) ; BEEP=CHAR(7)
PROMPT " "
LNCNT=59
SCREEN=0
LN=''
*
OPEN 'DEPT' TO DEPT.FILE ELSE ABORT
OPEN 'CLOCKFILE' TO CLOCKFILE ELSE ABORT
OPEN 'USER' TO USER.FILE ELSE ABORT
5 *
SELECT DEPT.FILE
DEPT.ARRAY=''
LOOP
READNEXT KEY ELSE KEY='EOF'
UNTIL KEY='EOF' DO
LOCATE(KEY,DEPT.ARRAY,1;NDX;'AL') ELSE
DEPT.ARRAY=INSERT(DEPT.ARRAY,1,NDX;KEY)
DEPT.ARRAY=INSERT(DEPT.ARRAY,2,NDX;"0")
READ DEPT.REC FROM DEPT.FILE,KEY ELSE DEPT.REC=''
DEPT.ARRAY=INSERT(DEPT.ARRAY,3,NDX;DEPT.REC<1>)
END
REPEAT
10 *
TODAY=DATE()
NAME= ''
CRT CS
PROGRAM='JOHN'
PRINT @(-1):
PRINT @(2,1): PROGRAM: @(20,1): RV: 'Employee Clock Errors Report ' : ERV : @(55,1): TIMEDATE()
PRINT @(54,2):RV: ' List of Departments ' :ERV:
ICT=DCOUNT(DEPT.ARRAY<1>,VM)
FOR I=1 TO ICT UNTIL I > 20
DISP=I:'. '
CRT @(48,2+I):DEPT.ARRAY<1,I>'L#7':DEPT.ARRAY<3,I>[1,20]
NEXT I
20 *
Z=0
LOOP
CRT@(2,4): "Enter the DEPARTMENT CODE or 'ALL': ":
CRT @(10,10+Z):"DEPARTMENT ":
INPUT DEPT
IF DEPT = "/" THEN STOP
IF DEPT='ALL' THEN DEPT.ARRAY='ALL'
IF DEPT='ALL' THEN GO 30
LOCATE(DEPT,DEPT.ARRAY,1;NDX) THEN
DEPT.ARRAY<2,NDX>=1
END
Z=Z+1
UNTIL DEPT='' DO
IF DEPT='' THEN GO 10
REPEAT
30 *
CRT @(10,12+Z):"START DATE (MM/DD/YY) ":
INPUT SDATE
CRT @(10,14+Z):"LAST DATE (MM/DD/YY) ":
INPUT LDATE
*
40 *
PRT=''
CRT @(0,20):CR:"Output to the printer (Y/N): ":
INPUT PRT
IF PRT = 'Y' THEN
CRT ''
EXECUTE "EX PRINTER"
CRT @(0,18):CR
MAXCT=55
END ELSE
MAXCT=20
IF PRT # 'N' THEN GOSUB 100
END
50 *
TCL=\SSELECT CLOCKFILE WITH DEPT \
FOR X=1 TO ICT
IF DEPT.ARRAY<2,X>=1 THEN
TCL=TCL:\"\:DEPT.ARRAY<1,X>:\"\
END
NEXT X
TCL=TCL:\ AND WITH DATE GE "\:SDATE:\" AND WITH DATE LE "\:LDATE:\" BY DEPT BY USER (R,5 \
EXECUTE TCL
IF PRT='Y' THEN
PRINTER ON
END
CRT @(0,3):CR
LOOP
READNEXT ID ELSE ID = 'EOF'
UNTIL ID = 'EOF' DO
READ REC FROM CLOCKFILE,ID THEN
ERROR=''
VCT=DCOUNT(REC<1>,VM)
IF REM(VCT,2) # 0 THEN
ERROR='MISSING ENTRY'
END ELSE
FOR V=VCT TO 2 STEP -1
IF REC<1,V> >= REC<1,V-1> ELSE
ERROR='INVALID TIME'
END
NEXT V
END
IF ERROR # '' THEN
USER=OCONV(ID,"G0|1")
READ UREC FROM USER.FILE,USER THEN
NAME=UREC<2>:", ":UREC<1>[1,1]:"."
DEPT=UREC<5>
END
DATE=OCONV(ID,"G1|1")
DATE=OCONV(DATE,'D2/')
LN = USER'L#6':NAME'L#15':DEPT'L#9':DATE'L#10':ERROR'L#20'
FOR V=1 TO VCT
IF V # 1 THEN LN=SPACE(60)
LN=LN:OCONV(REC<1,V>,'MT')'L#10':REC<2,V>'L#9'
GOSUB 100
NEXT V
END
END
REPEAT
IF PRT='Y' THEN
PRINTER OFF
END
CRT @(0,22):"PROCESS COMPLETE - HIT RETURN":
INPUT ANY
STOP
100 *
IF LNCNT > MAXCT THEN
IF PRT='N' THEN
CRT @(0,22):"HIT RETURN":
INPUT ANY
END
PRINT CHAR(12)
PRINT PROGRAM : SPACE(10): 'Employee clock Errors Report ' : SPACE(8): TIMEDATE()
PRINT " I N T E R N A L D A T A M A N A G E M E N T C L O C K E R R O R S ":
PRINT
PRINT " Clock Error Report for ":OCONV(SDATE,"D2/") : " thur " :OCONV(LDATE,"D2/"): " for DEPARTMENTS " : DEPT
PRINT
PRINT "EMPLOYEE NAME DEPT DATE ERROR MESSAGE TIME PROJECT "
PRINT "CODE "
PRINT "============================================================================= ":
PRINT
LNCNT=9
END
PRINT LN
LNCNT=LNCNT+1
RETURN
1000 *
STOP