C C ATE.FTN (ATTENDANCE PROGRAM) C C THIS PROGRAM IS A TIME CARD FUNCTION. IT ALLOWS EMLPOYEES C TO CHECK IN OR OUT, IT KEEPS TRACK OF VACATION TIME, TRAVEL C TIME, AND SICK TIME. C INTEGER CODE, HOURS, MINS, OPTION INTEGER CSTAT ! CURRENT STATUS OF A PERSON INTEGER REC ! PERSON'S TIME RECORD INTEGER TIME, TIMEOU, DAY INTEGER SEQUEN ! SEQUECNE NO. OF THE PERSON BYTE BNAME(30) ! PERSON'S NAME BYTE BINFO(160) ! EACH PERSONS INFORMATION RECORD INTEGER INFO(80) ! SAME AS BINGO, ONLY AS INTEGERS BYTE BL ! NULL CHARACTER INTEGER DAYS ! SUBROUTINE TO CALCULATE DAYS C C THE FOLLOWING IS ADDED TO ALLOW A DISPLAY AT END OF DAYS SUMMARY C REAL LNAME(5) REAL WORK,NONE,CNAM C EQUIVALENCE (BINFO(1),INFO(1)) DATA WORK,NONE/'WORK','NONE'/ DATA LNAME/'VAC ','TRAV','A LV','S LV','HOLI'/ C OPEN (UNIT=1, NAME='[200,2]CHECK.DAT;1', ACCESS='DIRECT' 1, RECORDSIZE=40,TYPE='OLD', SHARED) 100 CALL VTERA ! ERASE VT100 CALL VTCUR(1,8) ! POSITION CURSOR 1 OVER, 8 DOWN 105 WRITE(5, 110) 110 FORMAT('$WHAT IS YOUR NUMBER? ') READ(5, 115,ERR=100) CODE CALL VTERA ! TEMPORARILY INCLUDE THIS CALL VTCUR(1,6) ! ALSO TEMPORARILY INCLUDE THIS 115 FORMAT(I5) IF (CODE .LT. 0) GO TO 385 !END ROUTINE IF (CODE .EQ. 0) GO TO 125 ! TRIED TO ENTER 0 C C CHECK TO SEE IF THE PERSONS CODE IS ON FILE C READ(1'1) BINFO !READ IN ALL THE CODES DO 120 SEQUEN=1, 56 120 IF (BINFO(SEQUEN) .EQ. CODE) GO TO 135 !TRY TO FIND A MATCHING CODE 125 WRITE(5,130) 130 FORMAT(' ** ERROR - YOUR NUMBER IS NOT ON FILE') GO TO 105 C C NUMBER HAS BEEN FOUND. NOW GET THAT PERSONS LAST C STATUS. C 135 CALL GETTIM(HOURS, MINS) !GET THE TIME OF DAY I=DAYS(IMO,IDA,IYR,1) ! BEG TODAY'S DATE DAY=I-INFO(48) ! DAY INTO PAY PERIOD (INFO(48) IS BEG) IF (DAY .GT. 5) DAY = DAY - 2 IF ((DAY.GT.0) .AND. (DAY.LE.10)) GO TO 145 ! THIS DAY IS O.K. WRITE(5,140)DAY 140 FORMAT(' WARNING: I calculate this day to be day',I4,' of the pay 1 period.',/,' Probably, the computer thinks this is the wrong 2 day.',/,' Please correct this and rerun ATE.') CALL EXIT C C GET PERSONS NAME C 145 READ(1'SEQUEN + 2) BINFO !WHERE PERSON'S NAME STORED REC=4*SEQUEN+55 ! LOCATION OF PERSON'S ATTEN DATA CALL SCOPY(BINFO,BNAME,30,15) ! MOVE NAME TO ARRAY: NAME READ(1'REC)BINFO ! READ CURRENT TIME RECORD CSTAT=BINFO(145) IF(CSTAT.LE.0)GO TO 150 C C DOUBLE CHECK TO SEE IF REALLY ON SONE KIND OF STATUS IF(INFO(DAY*6-3).GT.420)GO TO 150 ! ARE AT WORK IF(INFO(DAY*6-1).GT.420)GO TO 150 ! ARE AT SOME KIND OF LEAVE CSTAT=0 ! SECRETARY MUST HAVE MADE MISTAKE IN MAI PROGRAM 150 CALL TRIM(BNAME,30) WRITE(5,180)BNAME IF (CSTAT .EQ. 0) WRITE(5,155)BL IF (CSTAT .EQ. 2) WRITE(5,160)BL IF (CSTAT .EQ. 3) WRITE(5,165)BL IF (CSTAT .EQ. 4) WRITE(5,170)BL IF (CSTAT .EQ. 1) WRITE(5,175)BL IF (CSTAT .EQ. -1) WRITE(5,185)BL IF (CSTAT .EQ. -2) WRITE(5,190) 155 FORMAT(A1,'YOU HAVE NOT CHECKED IN',/) 160 FORMAT(A1,'YOU ARE CURRENTLY ON TRAVEL',/) 165 FORMAT(A1,'YOU ARE CURRENTLY ON ANNUAL LEAVE',/) 170 FORMAT(A1,'YOU ARE CURRENTLY ON SICK LEAVE',/) 175 FORMAT(A1,'YOU HAVE CHECKED IN, BUT NOT OUT',/) 180 FORMAT(//,'$',30A1,', ') 185 FORMAT(A1,//,' You did not check out last night. 1 Go ahead and check in ',/, 1' Then see the time keeper and have it corrected.') 190 FORMAT('+You failed to check in yesterday.',/, 1' Go ahead and check in 2 now.',/, ' Then see the time keeper to remedy the situation.') C GET USERS OPTION 195 WRITE(5,200) HOURS, MINS 200 FORMAT(/,20X,' OPTIONS',T50'TIME: ',I2,':',I2,//, 1' 1 - NORMAL CHECK IN 2 - NORMAL CHECK OUT',/, 4' 3 - GOING ON TRAVEL 4 - GOING ON COMP TIME',/, 2' 5 - GOING ON ANNUAL LEAVE ',/, 3' 7 - GOING ON SICK LEAVE ',/, 5' 9 - MADE A MISTAKE',/ 6'$PLEASE ENTER YOUR OPTION: ') READ(5,205) OPTION 205 FORMAT(I2) IF (OPTION .LT. 1) GO TO 100 IF (OPTION .GT. 9) GO TO 210 READ(1'REC) INFO !CURRENT PERSONS RECORD TIME = HOURS*60+MINS C NOW GO TO THE PROPER OPTION GO TO(220, 255, 320, 100, 320, 100, 320, 100, 100)OPTION 210 WRITE(5,215) 215 FORMAT(' ** INVALID OPTION **') GO TO 195 C C HANDLE NORMAL TIME IN PROCEDURE C 220 IF(TIME.GT.1020)GO TO 255 ! AFTER 5:00, PROB GOING OFF TRAVEL IF(CSTAT.NE.1) GO TO 230 ! NOT NOW ON WORKING STATUS, SO O.K. WRITE(5,225) ! TELL THEM: ALREADY ON WORKING STAT 225 FORMAT(' You cannot check in when you are already on working 1 status. Please try again.') GO TO 195 230 IF(CSTAT . NE. 0) GO TO 235 ! ON SOME KIND OF LEAVE STATUS C IF GET HERE, ARE ON NON WORK STATUS IF(INFO(DAY*6-3) .GT. 5) GO TO 245 ! WORKED BEFORE, TRYING TO WORK AGAIN 235 BINFO(145)=1 ! ASSIGN NEW STATUS (WORKING) IF(INFO(DAY*6-3) .LT. 400) INFO(DAY*6-3)=TIME ! NO TIME IN FOR TODAY C ! LET THIS BE THE TIME IN LVNO=0 ! ASSUME NO LEAVE FOR NOW IF(TIME .LT. 490) GO TO 240 !TIM< 8:10 AM, WAS NEVER REALLY ON LV TODAY IF(BINFO(DAY*2+123).LE.0)GO TO 370 ! WERE NOT ON LEAVE AFTER ALL. C THEY ARE GETTING TO WORK AFTER 8:10 AM. MAYBE SHOULD DO SOMETHING LVNO=1 ! HE HAS AT LEAST ONE LEAVE IF(BINFO(DAY*2+124) .GT. 0) LVNO=2 ! HAD 2 LEAVES INFO(DAY*6-2+LVNO*2)=TIME ! PUT IN LEAVING TIME FOR THIS LV GO TO 370 C C COME HERE IF HE WAS REALLY NEVER ON LEAVE (HAS A TIME LEAVING FOR C VACATION BUT IT IS BEFORE 8:00 C 240 INFO(DAY*6-1) = 0 ! WERE NEVER REALLY ON LV TODAY BINFO(123+DAY*2)=0 ! DELETE AN LV SYMBOL GO TO 370 C C ATTEMPTING TO CHECK FOR A SECOND TIME TODAY WITH NO ANN LV FOR C THE GAP IN BETWEEN C 245 CALL VTERA CALL VTCUR(1,6) WRITE(5,250) 250 FORMAT(' YOU ARE ATTEMPTING TO CHECK IN FOR A SECOND TIME 1 WITH NO KIND OF LEAVE',/,' TO SHOW FOR THE GAP. PLEASE 1 TRY AGAIN OR SEE THE TIME KEEPER.') CALL VTCUR(1,15) GO TO 195 C C NORMAL OUT ROUTINE C 255 IF(CSTAT .GT. 0) GO TO 265 IF(OPTION.EQ.2) GO TO 267 C C IF YOU GET HERE, ATTEMPTED TO CHECK IN AFTER 5:00 BUT WERE NOT C ON ANY KIND OF LEAVE. TELL THEM THIS IS ILLEGAL CALL VTERA CALL VTCUR(1,7) WRITE(5,260) 260 FORMAT(' YOU ARE ATTEMPTING TO CHECK IN AFTER 5:00 AND HAVE 1 NOT BEEN',/,' ON ANY KIND OF LEAVE. IF THIS IS NOT CORRECT 2 PLEASE SEE JOYCE') CALL VTCUR(1,14) GO TO 195 C C 265 IF (CSTAT .EQ. 1) GO TO 275 ! STATUS IS O.K. IF (CSTAT .GT. 1) GO TO 280 ! LEAVING TRAVEL PROB 267 WRITE(5,270) 270 FORMAT(/,' You did not check in this morning. I am allowing 1 you to check out',/,' now but please have Joyce enter 2 your check in time for this morning.',//, 3'$Hit the carriage return to continue.') READ(5,115)I 275 INFO(DAY*6-2)=TIME BINFO(145)=0 ! NEW STATUS IS NOT WORKING GO TO 370 !UPDATE RECORDS 280 IF (INFO(DAY*6-1).LT.10)GO TO 150! DON'T KNOW WHAT DOING IF(BINFO(DAY*2+123) .GT. 0) LVNO=1 ! FIGURE OUT WHAT LEAVE NO ARE ON IF(BINFO(DAY*2+124) .GT. 0) LVNO=2 ! IF THIS IS TRUE, ON 2ND LV BINFO(145)=0 INFO(6*DAY+2*LVNO-2)=TIME ! RECORD TIME LEAVING THIS LV GO TO 370 C C GOING ON SOME TYPE OF LEAVE C 285 IF(CSTAT .NE. 1)GO TO 290 C ARE WORKING NOW INFO(DAY*6-2)=TIME ! TAKE OFF WORK 290 IF(LVTYP .NE. CSTAT)GO TO 300 ! LV ASKED FOR IS NOT SAME AS CUR STAT WRITE(5,295) 295 FORMAT(' YOU ARE ASKING TO GO ON A TYPE OF LEAVE 1 YOU ALREADY ARE ON') GO TO 370 300 LVNO=1 ! ASSUME THIS IS 1ST LEAVE OF DAY IF(BINFO(123+DAY*2) .LE. 0)GO TO 315 ! WAS FIRST LEAVE OF DAY LVNO=2 ! ASSUME THIS IS 2ND LEAVE OF DAY IF(BINFO(124+DAY*2) .LE. 0)GO TO 310 ! IT IS 2ND LEAVE WRITE(5,305) ! TELL HIM, TOO MANY LEAVES 305 FORMAT(' You have already go on leave twice today. This is all 1 the computer can handle.',/,' Please see the time keeper.') GO TO 370 310 IF(INFO(DAY*6) .LE. 500) INFO(DAY*6)=TIME ! DIDN'T CHECK IN FROM 1ST 315 BINFO(122+DAY*2+LVNO)=LVTYP ! RECORD TYPE OF LEAVE BINFO(145)=LVTYP ! CURRENT STATUS INFO(DAY*6-3+2*LVNO)=TIME ! TIME GOING ON LEAVE GO TO 370 C C C GOING ON ANNUAL LEAVE AT SOME FUTURE TIME C 320 LVTYP=(OPTION+1)/2 WRITE(5,325) 325 FORMAT('$HIT ENTER, TO BEGIN NOW, 1 TO BEGIN LATER ') READ(5,115)I IF(I.LE.0)GO TO 285 330 WRITE(5,335) 335 FORMAT('$ENTER THE DATE YOU WISH TO BEGIN (MM-DD-YY) 1OR HIT ENTER FOR TODAY ') CALL INDAY(ITOT2) IF((ITOT2-ITOT) .LT.0) GO TO 350 ! BEGINNING DAY IS PREV TO TODAY 340 WRITE(5,345) 345 FORMAT('$ENTER TIME TO START (AS MILITARY TIME 1 SUCH AS 1 1300 FOR 1:00 P.M.: ') READ(5,115,ERR=340)I TIME=NTIME(I) IF((TIME.LT.470).OR.(TIME.GT.1030)) GO TO 360 IF(ITOT2.EQ.0)GO TO 285 ! WANT IT TO BEGIN TODAY IF((ITOT2-ITOT) .EQ. 0)GO TO 285 ! THEY ACTUALLY SPELLED OUT TODAY INFO(76)=ITOT2 ! BEG DAY WENT ON LEAVE INFO(77)=TIME ! SAVE TIME GOING ON LEAVE INFO(78)=LVTYP ! TYPE OF LEAVE GOING ON GO TO 370 350 WRITE(5,355) 355 FORMAT(1X,'**** BAD DATE ****') GO TO 315 360 WRITE(5,365) 365 FORMAT(1X,'***** BAD TIME ****') GO TO 315 C UPDATE RECORDS ROUTINE C 370 WRITE(1'REC) INFO C C THE FOLLOWING IS ADDED TO TRY AND FIND ERRORS C CALL VTERA CALL VTCUR(1,16) J=BINFO(123+DAY*2) IF(J.LT.1)J=1 K=BINFO(124+DAY*2) IF(K.LT.1)K=1 WRITE(5,375)MTIME(INFO(DAY*6-3)),LNAME(J),MTIME(INFO(DAY*6-1)), 2LNAME(K),MTIME(INFO(DAY*6+1)), 1MTIME(INFO(DAY*6-2)),LNAME(J),MTIME(INFO(DAY*6)), 3LNAME(K),MTIME(INFO(DAY*6+2)) 375 FORMAT(/,' PLEASE VERIFY THAT THE FOLLOWING TIMES FOR TODAY',/, 1 ' AND ESPECIALLY THE CURRENT STATUS ARE CORRECT',//, 2' WORK IN ',I6,3X,A4,' IN ',I5,3X,A4,' IN ',A4/, 3' WORK OUT',I6,3X,A4,' OUT',I5,3X,A4,' OUT',A4) J=BINFO(145) CNAM=LNAME(J) IF(J.EQ.1)CNAM=WORK IF(J.EQ.0)CNAM=NONE WRITE(5,380)CNAM 380 FORMAT(10X,' CURRENT STATUS ',A4) CALL VTCUR(1,8) READ(1'20)BINFO C THE ABOVE LINE WAS ADDED BECAUSE EVEN THOUGH YOU MAY HAVE SAID TO WRITE C A RECORD TO FILE. IT ISN'T ACTUALLY WRITTEN UNTIL, YOU ACCESS A RECORD C SOMEWHAT REMOVED FROM THIS RECORD. THE REASON I KNOW THIS IS BECAUSE C WE WOULD LEAVE THE PROGRAM AT THIS POINT GO TO ANOTHER TERMINAL AND READ C THE RECORD AND THE CHANGES WOULD NOT BE THERE. GO TO 105 C C NORMAL CLOSING ROUTINE C 385 CLOSE (UNIT=1) CALL EXIT END