C MAI.FTN C (MAINTANANCE PROGRAM) C C THIS PROGRAM ALLOWS SOMEONE TO MODIFY THE ATTENDANCE RECORDS FOR ANY C PERSON. C INTEGER INFO(80) BYTE BINFO(160), LIN1(80) BYTE BUF(80,8) BYTE CHAR,STATUS INTEGER SEQUEN,CODE,DAY1,TIME,REC,OPTION,DAY,PREV INTEGER X,Y,OLDX,OLDY BYTE NAME(30) INTEGER POSI,DAYS,XCHAR LOGICAL*4 LNAME(10) BYTE LVNAM(11) EQUIVALENCE (BINFO(1),INFO(1)), (BINFO(1),LIN1(1)) DATA LNAME/'ERR2','ERR ','NONE','WORK','TRAV', 'A LV', 1 'S LV', 'HOL ', 'LWOP','SNOW'/ DATA LVNAM/'F','E',' ','W','T','A','S','H','L','B',' '/ OPEN (UNIT=1, NAME='CHECK.DAT', ACCESS='DIRECT' 1, RECORDSIZE=40, TYPE='OLD', SHARED) C C 10 FORMAT(I7) C CALL ASNLUN(4,'TT',14) ! LUN 4 = PORT 16(OCTAL) CALL GETMCR(LIN1, I) ! GET THE COMMAND LINE IF(I.LT.5) GO TO 120 ! HAVE TO GET THE NAME CALL SCOPY(LIN1, NAME, I-4, 5) ! MOVE NAME SUBMITED TO VAR NAME GO TO 135 120 CALL LOA(NAME,30,0) ! CLEAR THE ARRAY: NAME WRITE(5,130) 130 FORMAT(/,'$NAME: ') CALL GETF(NAME,30) IF (LEN(NAME) .LE. 1)CALL EXIT WRITE(5,132) 132 FORMAT('$HIT ENTER FOR THIS PAY PERIOD, 1 FOR LAST PAY PER, ETC ') READ(5,10)PREV IF (PREV .GT. 4) PREV=0 IF (PREV .LT. 0) PREV=0 C C SEARCH FOR NAME C 135 CALL ERASA ! ERASE VT100 CALL CUR(5,1) CALL ATTACH(5) DO 140 SEQUEN=1,30 READ(1'SEQUEN+2)BINFO J=POSI(BINFO,NAME,15,30) IF((J. LE. 0). OR. (J .GE. 26)) GO TO 140 ! THIS IS NOT IT CALL SCOPY(BINFO,NAME,30,15) ! SAVE COPY OF NAME READ(1'1)BINFO ! NEED TO CHECK IF THIS NAME DELETED IF(BINFO(SEQUEN).GT.0)GO TO 160 ! NOT DELETED, WE FOUND IT. 140 CONTINUE WRITE(5,150) 150 FORMAT(' FAILED TO FIND PERSON''S NAME') GO TO 120 C C FOUND PERSON'S NAME, GET SEQUENCE, CODE, AND DAY1 C 160 REC=4*SEQUEN+55+PREV ! PERSON'S ATTENDANCE DATA READ(1'1)BINFO CODE=BINFO(SEQUEN) DAY1=INFO(48) ! 1ST DAY OF PAY PERIOD DAY=DAYS(I,J,K,1) ! GET TODAY'S DATE DAY=DAY-DAY1 ! DAY INTO PAY PERIOD IF(DAY. GT. 5) DAY=DAY-2! PASSED THE WEEKEND IF(DAY .LT. 1) DAY=1 IF(DAY .GT. 10)DAY=10 READ(1'REC)INFO ! PICK UP INFORMATION J=BINFO(145) ! GET PERSON'S STATUS WRITE(5,170)NAME, CODE, LNAME(J+3) 170 FORMAT(1X,30A1,' ID NO.',I3, ' STATUS ',A4,//, 1' M T W TH F M T 1 W TH F',/) CALL LOA(BUF,640,"40) C C CONVERT THE WHOLE WORKS FROM BINARY TO ASCII CHARACTERS C DO 210 X=1,10 DO 200 Y=1,6 LINE=Y ! CALCULATE LINE DOWN IN THE DISPLAY IF(Y.GE.5)LINE=LINE+1 ! IF Y IS 5 OR 6, LINE IS 6 OR 7 CALL TIMAS(INFO(X*6+Y-4),BUF(1,LINE),7*X-6) 200 CONTINUE C GET STATUS CHARACTER FOR 2 VACATION TYPES DO 205 Y=1,2 LINE=5 IF(Y.EQ.2)LINE=8 I=BINFO(X*2+Y+122) IF(I.LE.1)I=0 IF(I.GT.8)I=8 BUF(7*X-4,LINE)=LVNAM(I+3) ! GET THE STATUS FOR THIS DAY 205 CONTINUE 210 CONTINUE C C CONVERSION IS DONE. DISPLAY IT ON SCREEN C DO 220 Y=1,8 WRITE(5,215)(BUF(X,Y),X=1,80) 215 FORMAT(1X,80A1) 220 CONTINUE CALL CUR(17,14) J=BINFO(145) ! GET CURRENT STATUS STATUS=LVNAM(J+3) ! CHANGE IT TO AN ASCII CHAR WRITE(5,222)STATUS 222 FORMAT(' CURRENT STATUS: ',A1) CALL CUR(19,1) WRITE(5,225) 225 FORMAT( 2' T Travel A Ann Lv B Bad weather L 3 Lv without pay ',/, 4' H Holiday S sick Lv BLK 4 No non-normal work',/,' E Not checked out prev night 5 F Didn''t check in prev AM') CALL CUR(1,1) ! ONE DOWN, 1 TO RIGHT WRITE(5,226) 226 FORMAT( 1' PF1 = VERY LEFT PF2 = 1ST CHAR OF COL TO LEFT',/, 1' PF2 = VERY RIGHT PF3 = 1ST CHAR OF COL TO RIGHT',/, 2' - = BOTTOM CR = DOWN AND TO LEFT,',/, 3' ARROWS AS SHOWN X TO EXIT') X=DAY*7-6 CALL CUR(10,X) Y=1 C C GET A CHARACTER FROM THE SCREEN C 300 CALL UPDN(CHAR) IF(CHAR.GT."140)CHAR=CHAR-"40 ! CHANGE SMALL TO CAPITAL IF(CHAR.EQ."130)GO TO 400 ! X WAS HIT, THEY WANT TO QUIT IF(CHAR.EQ."55)GO TO 305 ! MINUS KEY WAS HIT IF(CHAR.GT."37)GO TO 320 ! IT WAS NOT AN ARROW 305 OLDX=X OLDY=Y I=(X+2)/7 ! GET THE COLUMN NO WE ARE IN IF(CHAR.NE."15)GO TO 307 ! WAS NOT A CR Y=Y+1 X=7*I-6 IF(Y.EQ.5)X=X+4 ! KEEPS LEAVE CODE FROM GOING TOO FAR IF(Y.EQ.8)X=X+4 ! TO THE LEFT 307 IF(CHAR.EQ."31)X=7*I-6 ! WAS A PF2 KEY IF(CHAR.EQ."32)X=7*(I+2)-6 ! WAS A PF3 KEY IF(CHAR.EQ."36)X=X+1 ! IT WAS THE RIGHT ARROW IF(CHAR.EQ."37)X=X-1 ! IT WAS LEFT ARROW IF(CHAR.EQ."34)Y=Y-1 ! IT WAS THE UP ARROW IF(CHAR.EQ."35)Y=Y+1 ! IT WAS DOWN ARROW IF(CHAR.EQ."30)X=1 ! PF1 KEY IF(CHAR.EQ."33)X=64 ! PF4 KEY IF(CHAR.EQ."55)Y=9 ! MINUS KEY HIT, GO TO BOTTOM CALL POSCK(OLDX,OLDY,X,Y) ! SEE IF THIS POSITION O.K. GO TO 300 ! GET THE NEXT CHARACTER C C SOME CHARACTER OTHER THAN AN ARROW WAS HIT C 320 IF(Y.NE.9)GO TO 322 ! 1 CHARA POSSIBLE ON LINE 9 STATUS=CHAR GO TO 324 322 BUF(X,Y)=CHAR ! ASSUME THIS IS VALID CHAR 324 CALL WRITE(CHAR) ! WRITE IT BACK TO SCREEN X=X+1 ! AT THE NEXT POS IN BUF C CURSOR HAS ALREADY MOVED. OTHERWISE WOULD SAY OLDX=X ABOVE THIS OLDX=X OLDY=Y CALL POSCK(OLDX,OLDY,X,Y) ! NEED TO CHECK IT AGAIN GO TO 300 400 CALL CUR(17,1) C C NOW CONVERT THE WHOLE WORKS BACK FROM ASCII TO BINARY DO 450 X=1,10 DO 410 Y=1,6 LINE=Y IF(Y.GE.5)LINE=LINE+1 CALL ASTIM(INFO(X*6+Y-4),BUF(1,LINE),7*X-6) 410 CONTINUE DO 420 Y=1,2 LINE=5 IF(Y.EQ.2)LINE=8 BINFO(X*2+Y+122)=XCHAR(BUF(7*X-4,LINE)) ! GET TYPE OF LEAVE 420 CONTINUE 450 CONTINUE BINFO(145)=XCHAR(STATUS) ! STORE CURRENT STATUS WRITE(1'REC)INFO ! PLACE IT BACK ON DISK CALL CUR( 17,1) WRITE(5,460) 460 FORMAT(/,' BE SURE AND CHECK THE CURRENT STATUS.') CALL CUR(21,1) CALL ERASR C C THE CONVERSION IS DONE C CALL DETACH(5) CLOSE(UNIT=1) CALL EXIT END