C C UPDATE.FTN C THIS PROGRAM SHOULD BE RUN EVERYDAY AFTER EVERY EMPLOYEE HAS C CHECKED IN AND OUT. C INTEGER PDAY, INTIME, OUTIME, VITIME, VOTIME, VTIM1, REC INTEGER TVAC, TSIC, VAC, SIC,PERSON INTEGER INFO(80) BYTE BINFO(160) INTEGER STATUS ! PERSON'S CURRENT STATUS INTEGER PPER1 ! BEGIN OF PAY PERIOD INTEGER PERNO ! PERSON NUMBER INTEGER VDAY ! BEGINNING DAY TO GO ON VACATION INTEGER VTIM ! BEGINNING TYPE INTEGER VTYPE ! TYPE OF VACATION GOING ON BYTE NAME(30) ! PERSON'S NAME INTEGER DAY ! DAY OF THE PAY PERIOD (1 - 10) INTEGER TODAY ! TODAYS DATE INTEGER HOL ! WILL = 1 IF THIS IS HOLIDAY INTEGER DAYS ! SUBROUTINE TO CALCULATE DAYS EQUIVALENCE (BINFO(1),INFO(1)) C OPEN (UNIT=1, NAME='[200,2]CHECK.DAT', ACCESS='DIRECT' 1, RECORDSIZE=40, TYPE='OLD', SHARED) C CALL HOLCK(HOL,INFO) ! IS THIS A HOLIDAY? WRITE(5,33)HOL 33 FORMAT(' HOLIDAY WAS FOUND TO BE',I7) DO 300 PERSON=1, 56 READ(1'1) BINFO ! READ ALL PERSON NUMBERS PERNO= BINFO(PERSON) ! GOT PERSON NO. FOR THIS PERSON IF (PERNO.LE.0) GO TO 300 ! THIS PERSON BEEN DELETED PPER1=INFO(48) ! BEGINNING DAY OF PAY PERIOD TODAY=DAYS(IMO,IDA,IYR,1) ! TODAYS DATE PDAY = TODAY - PPER1 ! CURRENT DAY OF PAY PERIOD IF (PDAY .EQ. 6 .OR. PDAY .EQ. 7) GO TO 900 ! SAT. OR SUNDAY. IF (PDAY .GT. 5) PDAY=PDAY-2 IF(PDAY .LT. 1) GO TO 900 IF (PDAY .GT. 10) GO TO 900 REC =PERSON+2 READ(1'REC)INFO CALL SCOPY(BINFO,NAME,30,15) ! COPY NAME TO VARIABLE NAME REC=4*PERSON+55 ! POSITION OF TIME INFORMATION REC READ(1'REC)INFO ! READ TIME INFORMATION STATUS=BINFO(145) ! PICK UP STATUS INTIME=INFO(6*PDAY-3) ! INTIME IS NORMAL TIME IN OUTIME=INFO(6*PDAY-2) ! OUTIME IS NORMAL TIME OUT VITIME=INFO(6*PDAY-1) ! VITIME IS NON-NORMAL TIME IN VOTIME=INFO(6*PDAY) ! VOTIME IS NON-NORMAL TIME OUT VDAY=INFO(76) ! BEGINNING DAY OF VACATION VTIM1=INFO(77) ! BEGINNING TIME OF VACATION VTYPE=INFO(78) ! TYPE OF LEAVE IF(HOL.EQ.1) GO TO 117 ! THIS IS A HOLIDAY C WRITE(5,37)NAME, MTIME(INTIME), MTIME(OUTIME) C 1, MTIME(VITIME), MTIME(VOTIME) C37 FORMAT(/,1X,30A1,' IN:',I5,' OUT:',I5, C 1' VAC IN:',I5,' VAC OUT',I5) IF(VDAY.NE.TODAY)GO TO 100 C C ASKED IN ADVANCE FOR LEAVE TODAY C VITIME = VTIM1 ! SET LEAVE TIME IN TO REQUESTED BINFO(123+PDAY*2)=VTYPE ! SET TYPE OF LEAVE IF (OUTIME .GT. VITIME)GO TO 100 ! ASSUME LV ALREADY ENDED] STATUS=VTYPE OUTIME = VITIME ! NOR TIME OUT = VAC TIME BEGIN C C DO WE TELL THEM THEY "FAILED TO CHECK IN"? 100 IF(STATUS.GT.1)GO TO 115 ! ON SOME KIND OF LEAVE SO O.K. IF(VITIME.GT.360)GO TO 115 ! THIS IS HOLIDAY & PUT ON IN ADV. IF (INTIME .GT. 360) GO TO 108 ! THEY AT LEAST CHECKED IN. STATUS=-2 ! -2 WILL INDICATE FAILED TO CHECK IN GO TO 115 108 IF (OUTIME .GT. INTIME) GO TO 115 ! THEIR STATUS IS O.K. WRITE(5,110)NAME 110 FORMAT(1X,30A1,' CHECKED IN BUT DID NOT CHECK OUT') STATUS=-1 ! REMEMBER, THIS PERSON DIDN'T CHECK OUT 115 IF (VITIME .GT. VOTIME) VOTIME=1020 ! DIDN'T CHECK OUT GO TO 119 C C THIS IS A HOLIDAY 117 VOTIME=1020 ! LEAVING HOLIDAY AT 5:00 VITIME=480 ! GOING ON VACATION AT 8:00 BINFO(123 + PDAY*2)=5 ! TYPE OF VACATION IS HOLIDAY C DON'T REMEMBER WHETHER THIS WILL CARRY ALONG ANN LEAVE IF BEEN ON C ANNUAL LEAVE 119 IF(INFO(6*PDAY+2).LT.INFO(6*PDAY+1))INFO(6*PDAY+2)=1020 INFO(6*PDAY-2)=OUTIME ! IN CASE OUTIME CHANGED INFO(6*PDAY-1)=VITIME ! IN CASE VITIME CHANGED INFO(6*PDAY)=VOTIME ! IN CASE VOTIME CHANGED BINFO(145)=STATUS ! IN CASE STATUS CHANGED WRITE(1'REC)INFO C NOT SURE THE ABOVE LINE IS NECESSARY BUT PUTTING IT IN ANYWAY C C C TESTING FOR NEW PAY PERIOD C IF (PDAY .NE. 10) GO TO 200 C COME HERE IF ON DAY 10 OF PAY PERIOD C FIRST SAVE LAST PAY PERIOD AND THE ONE BEFORE DO 120 I=2,1,-1 READ(1'REC+I)INFO WRITE(1'REC+I+1)INFO 120 CONTINUE READ(1'REC)INFO C NOW COMPUTE TOTAL VAC TIME, ETC FOR THIS PAY PERIOD TVAC=0 ! TOTAL VACATION TIME TSIC=0 ! TOTAL SICK TIME DO 135 DAY=1,10 C THIS ROUTINE COMPUTES THE TOTAL VACATION TIME AND SICK TIME C FOR THE PAY PERIOD. VITIME=INFO(6*DAY-1) ! VACATION TIME IN VOTIME=INFO(6*DAY) ! VACATION TIME OUT J=VOTIME-VITIME ! TENTATIVE ESTIMATE OF VACATION TIME IF((VITIME.LT.750).AND.(VOTIME.GT.750))J=J-60 ! SUBT NOON TIME IF(J.LT.0)J=0 IF(BINFO(123+DAY*2).EQ.3)TVAC=TVAC+J IF(BINFO(123+DAY*2).EQ.4)TSIC=TSIC+J 135 CONTINUE INFO(74)=INFO(74)+6-IVAC ! UPDATE TOTAL VAC TIME INFO(75)=INFO(75)+4-ISIC ! UPDATE TOTAL SICK TIME WRITE(1'REC)INFO ! STORE TOTAL VAC AND SICK WRITE(1'REC+1)INFO ! SAVE ALL THIS FOR ONE PAY PERIOD TODAY=TODAY+3 ! ADD 3 TO THE CURRENT DAY C C INITIALIZE THE NEW RECORD FOR NEXT PAY PERIOD C CALL LOAINT(INFO, 73, 0)! INITIALIZE ALL VALUES TO 0 BINFO(145)=STATUS ! KEEP SAME STATUS C PDAY=0 ! WILL GET CHANGED TO 1 AT 200 C PLACE INFORMATION FOR THE NEXT DAY INTO THE RECORD C PERSON IS ON LEAVE, START THE BEGINNING TIME FOR THE NEXT C DAY AS 8:00 AND ENTER THE STATUS THAT HE FINISHED UP ON YESTERDAY C C 200 IF(STATUS .LE. 1)GO TO 290 ! NO UPDATE NEEDED PDAY=PDAY+1 ! THIS IS FOR NEXT DAY OF PAY PERIOD IF(PDAY.GT.10)PDAY=1 ! SHOULD HAVE NEW DATA IF THIS TRUE INFO(6*PDAY-1)=480 ! SET NON-NORMAL TIME IN TO 8:00 BINFO(123+PDAY*2)=STATUS ! KEEP OLD STATUS 290 WRITE(1'REC) BINFO ! REWRITE TIME RECORD C 300 CONTINUE C C DO WE NEED TO ADVANCE PAY PERIOD NO. C READ(1'1)INFO PPER1 = INFO(48) TODAY=DAYS(IMO, IDA, IYR, 1) ! TODAY'S DATE PPER1=INFO(48) ! BEGINNING OF PAY PERIOD IF((TODAY-PPER1).LT. 12) GO TO 900! NOT LAST DAY OF PAY PERIOD INFO(48)=PPER1+14 INFO(47)=INFO(47)+1 IF(INFO(47).GT.26)INFO(47)=1 WRITE(1'1)INFO 900 CLOSE(UNIT=1) CALL EXIT END