tldm-universe/CMS/BP.CLOCK/CLOCK.EXP

*---------------------------*
* CLOCK.EXP
* BY D.BELL
*---------------------------*
CS=@(-1) ; CR=@(-3) ; CL=@(-4) ; RV=@(-13) ; ERV=@(-14)
VM=CHAR(253) ; SVM=CHAR(252) ; AM=CHAR(254) ; BEEP=CHAR(7)
PF1='<' ; PF2='P' ; PF3='/'
PROMPT ""
HR.TOT=0
TOT.HOURS=0
ARAY=''
WCT=0
*EXECUTE 'SETPTR ,,,,,,AT mtk4si,FORM 6,NHEAD,INFORM,BRIEF'
*
$INCLUDE CLOCK.PAY.DATES
*
OPEN 'CLOCK.PAY.DATES' TO CLOCK.PAY.DATES ELSE ABORT
OPEN 'CLOCKFILE' TO CLOCKFILE ELSE ABORT
OPEN 'DEPT' TO DEPT.FILE ELSE ABORT
OPEN 'USER' TO USER.FILE ELSE ABORT
OPEN 'PL' TO PL ELSE ABORT
OPEN 'CLOCKFILE.WORK' TO WFILE THEN
 CLEARFILE WFILE
END ELSE
 EXECUTE \CREATE-FILE CLOCKFILE.WORK 1 11\
 OPEN 'CLOCKFILE.WORK' TO WFILE ELSE ABORT
END
OPEN 'CLOCKFILE.WORK.PROJECT' TO OUTFILE THEN
 CLEARFILE OUTFILE
END ELSE
 EXECUTE \CREATE-FILE CLOCKFILE.WORK.PROJECT 1 11\
 OPEN 'CLOCKFILE.WORK.PROJECT' TO OUTFILE ELSE ABORT
END
GOSUB 2000
*
SELECT CLOCKFILE
LOOP
 READNEXT ID ELSE ID='EOF'
UNTIL ID='EOF' DO
 DATE=OCONV(ID,"G1|1")
 USER=OCONV(ID,"G0|1")
 LOCATE(DATE,QRAY,1;NDX;'AR') THEN
  IF QRAY<2,NDX> THEN
   GOSUB 500
  END
 END ELSE
  IF NDX > 1 THEN NDX=NDX-1
  IF QRAY<2,NDX> THEN
   IF DATE >= QRAY<1,NDX> AND DATE <= QRAY<1,NDX>+13 THEN
    GOSUB 500
   END
  END
 END
REPEAT 
STOP
500 * DATE IS WITHIN SELECTED RANGES
 READ ARAY FROM CLOCKFILE,ID THEN
  GOSUB 1000
 END
RETURN
1000 *
WREC=ARAY<1>
WREC<2>=ARAY<2>
ACT=DCOUNT(ARAY<1>,VM)
FOR A=1 TO ACT
 TIME=ARAY<1,A>
 PRJCT=ARAY<2,A>
 IF REM(A,2) THEN
  IF PRJCT='OFF' THEN
   CRT @(0,22):BEEP:"The TIMECARD is in an ambiguous state - Unable to process!":
   RQM
   TOT.HOURS=0
   ONTIME='UNKNOWN'
  END ELSE
   OPRJCT=PRJCT
   ONTIME=TIME
  END
 END ELSE
  IF PRJCT # 'OFF' THEN
   CRT @(0,22):BEEP:"The TIMECARD is in an ambiguous state - Unable to process!":
   RQM
   TOT.HOURS=0
   OFFTIME='UNKNOWN'
  END ELSE
   OFFTIME=TIME
  END
  IF OFFTIME='UNKNOWN' OR ONTIME='UNKNOWN' THEN
   HOURS='?'
  END ELSE
   IF ONTIME > OFFTIME THEN
    OFFTIME=OFFTIME+86400
   END
   HOURS=OFFTIME-ONTIME
  END
  LOCATE(OPRJCT,WREC,3;IDX) THEN
   WREC<4,IDX>=WREC<4,IDX>+HOURS
  END ELSE
   WREC=INSERT(WREC,3,IDX;OPRJCT)
   WREC=INSERT(WREC,4,IDX;HOURS)
  END
 END
NEXT A
LOCATE(DATE,QRAY,1;FND.DT;"AR") ELSE FND.DT=FND.DT-1
WREC<5>=1 ; TEST.DT=QRAY<3,FND.DT>
IF DATE GT TEST.DT THEN WREC<5>=2
WRITE WREC ON WFILE,ID
WCT=WCT+1
CRT @(0,22):CL:"RECORDS PROCESSED :":WCT
RETURN
*
2000 *
CRT CS
CRT @(0,0):"CLOCK.EXP"
*CRT @(0,22):CL:"Enter the DEPARTMENT to build analysis for or 'ALL' :":
*INPUT DEPT
DEPT='ALL'
DEPT.DESC='ALL'
CRT @(0,2):"This process will build an analysis workfile for '":DEPT.DESC:"'"
CRT @(0,3):"departments and for the specified payroll period."
CRT @(0,5):"Select the period to rebuild from those found below."
COL=0
POS=5
MAXCOL=70
MAXPOS=20
 QRAY=''
 GOSUB 2200
 QCT=DCOUNT(QRAY<1>,VM)
 FOR Q=1 TO QCT
  IF POS>=MAXPOS THEN COL=COL+20;POS=5
  POS=POS+1
  CRT @(COL,POS):" ":OCONV(QRAY<1,Q>,'D2/'):"-":OCONV(QRAY<1,Q>+13,'D2/'):" "
 NEXT Q
 CRT @(0,22):"Enter SPACE(toggle selection)":
 COL=0; POS=5
 FOR Q=1 TO QCT
  IF POS>=MAXPOS THEN COL=COL+20;POS=5
  POS=POS+1
  CRT @(COL,POS):RV:" ":OCONV(QRAY<1,Q>,'D2/'):"-":OCONV(QRAY<1,Q>+13,'D2/'):" "
  CRT @(COL,POS):
  INPUT ANS,1:
  CRT ERV
  BEGIN CASE
  CASE ANS=' '
   IF QRAY<2,Q> THEN
    CRT @(COL,POS):" ":OCONV(QRAY<1,Q>,'D2/'):"-":OCONV(QRAY<1,Q>+13,'D2/'):" "
    QRAY<2,Q>=0
   END ELSE
    CRT @(COL,POS):RV:" ":OCONV(QRAY<1,Q>,'D2/'):"-":OCONV(QRAY<1,Q>+13,'D2/'):" ":ERV
    QRAY<2,Q>=1
   END
  CASE ANS='/'
   STOP
  CASE 1
   IF QRAY<2,Q>=0 THEN
    CRT @(COL,POS):" ":OCONV(QRAY<1,Q>,'D2/'):"-":OCONV(QRAY<1,Q>+13,'D2/'):" "
   END ELSE
    CRT @(COL,POS):RV:" ":OCONV(QRAY<1,Q>,'D2/'):"-":OCONV(QRAY<1,Q>+13,'D2/'):" ":ERV
   END
  END CASE
 NEXT Q
 CRT @(0,22):CL:BEEP:"IS THIS CORRECT (Y/N)":
 INPUT ANS
 IF ANS='/' THEN STOP
 IF ANS='Y' ELSE GO 2000
 FOR Q=1 TO QCT
  IF QRAY<2,Q> THEN
   CRT @(0,1):CR
   CRT @(23,12):RV:"PLEASE WAIT FOR REPORT!!!":ERV
  END
 NEXT Q
 GOSUB 2300 ;* CLEAR EXISTING WORKFILE RECORDS FOR THIS DEPT/PERIOD(S)
RETURN
2200 * CALC DATES
 EDATE=0; SDATE=0
 PRDAYS=14; PRDATE=ICONV('12/23/90','D')
 CRT @(0,22):CL:BEEP:"Enter Payroll Year (yy format) else RETURN":
 INPUT CYR
 IF NUM(CYR) AND CYR > 89 AND CYR < 100 THEN
  TODAY="1/1/":CYR
 END ELSE
  TODAY="1/1/":OCONV(DATE(),'D2Y')
 END
 TODAY=ICONV(TODAY,'D')
 TODAY=TODAY-14
 LOOP
  TODAY=TODAY+14
  SDATE=TODAY-PRDATE
  IF SDATE <= PRDAYS THEN
   EDATE=PRDATE
  END ELSE
   EDATE=PRDATE+(INT(SDATE/PRDAYS)*PRDAYS)
  END
  SDATE=EDATE+PRDAYS
  ODATE=EDATE
  WK.DT=ODATE+6
  QRAY=INSERT(QRAY,1,-1;ODATE)
  QRAY=INSERT(QRAY,2,-1;'0')
  QRAY=INSERT(QRAY,3,-1;WK.DT)
 UNTIL SDATE > DATE() DO REPEAT
RETURN
2300 *
SELECT WFILE
LOOP
 READNEXT ID ELSE ID='EOF'
UNTIL ID='EOF' DO
 READ WREC FROM WFILE,ID ELSE WREC=''
 DATE=WREC<1>
 DEPARTMENT=OCONV(ID,'G0|1')
 IF DEPARTMENT=DEPT OR DEPT='ALL' ELSE
  CRT @(10,20):"SKIPPED RECORD ":ID:CL
  GO 2399
 END
 LOCATE(DATE,QRAY,1;NDX;'AR') THEN
  IF QRAY<2,NDX> THEN
   GOSUB 2500
  END
 END ELSE
  IF NDX > 1 THEN NDX=NDX-1
  IF QRAY<2,NDX> THEN
   IF DATE >= QRAY<1,NDX> AND DATE <= QRAY<1,NDX>+13 THEN
    GOSUB 2500
   END
  END
 END
 2399 *
REPEAT 
RETURN
2500 *
CRT @(0,22):CL:"DELETING WORKFILE RECORD ":ID
*DELETE WFILE,ID
RETURN