PROGRAM TMSPROG C C *TMSPROG* CONTAINS THE *FTN5* PROGRAMS REQUIRED BY PROCEDURES C ON *TMSPROC*. TO BUILD ABSOLUTE BINARIES OF THESE PROGRAMS C OFF OF THE SYSTEM *OPL*, USE THE FOLLOWING COMMANDS - C C MODIFY,Z./*EDIT TMSPROG C FTN5,I=COMPILE,B=LGO. C LOAD,LGO. C NOGO,TMSPROG,RECTMS,TMSBILL. C C THE ABSOLUTE BINARIES WILL BE ON THE FILE *TMSPROG*. C END PROGRAM RECTMS(ACCFILE,FAMNAME,DIRFILE,TAPE1=ACCFILE, 1 TAPE2=FAMNAME,TAPE3=DIRFILE) C C *RECTMS* IS USED BY THE *TMSDBLD* PROCEDURE TO CONVERT *TMS* C ACCOUNT FILE MESSAGES INTO *TFSP* INPUT DIRECTIVES FOR TAPE C CATALOG FILE RECOVERY. THE FORMAT OF THE CALL IS - C C RECTMS,ACCFILE,FAMNAME,DIRFILE. C C WHERE - C ACCFILE = LOCAL FILE NAME OF ACCOUNT FILE WITH *TMS* MESSAGES. C FAMNAME = LOCAL FILE NAME OF FILE WITH ONE LINE OF INFORMATION C WITH THE STARTING TIME IN COLUMNS 1 THROUGH 6, A 1 IN C COLUMN 7 IF STARTING TIME IS AFTER MIDNIGHT, THE C ENDING TIME IN COLUMNS 8 THROUGH 13, AND A 1 IN C COLUMN 14 IF THE ENDING TIME IS AFTER MIDNIGHT. C DIRFILE = LOCAL FILE NAME OF *TFSP* INPUT FILE. C IMPLICIT INTEGER (A-Z) CHARACTER LINE*40 CHARACTER FAM*7, START*8, END*8, TIME*8, LAST*8 CHARACTER FAMILY*7, MSGTYP*2, SUBTYP*2 CHARACTER STMAIN(0:1)*5, STOWNR(0:1)*6, STSITE(0:1)*3 CHARACTER STERRF(0:1)*5, STSYST(0:1)*3, STVTYP(0:3)*4 CHARACTER LABTYPE(0:3)*2, DENSIT7(1:3)*2, FINDS*1, FS*1, SEP*1 CHARACTER DENSIT9(3:5)*2, CONMODE(0:3)*2, FORMAT(0:5)*2 CHARACTER DENSITC(1:3)*2 LOGICAL AFTMID, B4MID, ENDB4M, ENDMID, STRMID DATA BITMAIN, BITOWNR, BITSITE, BITERRF /16, 12, 3, 1/ DATA STMAIN /'AVAIL', 'HOLD'/ DATA STOWNR /'CENTER', 'USER'/ DATA STSITE /'ON', 'OFF' / DATA STERRF /'CLEAR', 'SET' / DATA STSYST /'NO', 'YES' / DATA STVTYP /'MTNT', 'CT', ' ', 'AT'/ DATA START, END, LAST / 3*'00.00.00'/ DATA AFTMID, B4MID /.FALSE., .TRUE. / DATA BT3LABT, BT2TTYP, BT3DENS, BT3CONV /15, 13, 9, 6/ DATA BT3FORM, BT2VTYP, BITSYST /0, 5, 7/ DATA LABTYPE /'KU', 'UN', 'KL', 'NS'/ DATA DENSIT7 /'HI', 'LO', 'HY'/ DATA DENSIT9 /'HD', 'PE', 'GE'/ DATA DENSITC /'CE', ' ', 'AE'/ DATA CONMODE /'AS', 'NU', 'AS', 'EB'/ DATA FORMAT /'I ', 'SI', 'F ', 'S ', 'L ', 'LI'/ C FUNCTION TO EXTRACT BIT N FROM INTEGER I BIT (I, N) = AND (1, SHIFT (I, -N)) C FUNCTION TO EXTRACT 2 BIT FIELD FROM INTEGER I WITH LSB AT N BIT2 (I, N) = AND (3, SHIFT (I, -N)) C FUNCTION TO EXTRACT 3 BIT FIELD FROM INTEGER I WITH LSB AT N BIT3 (I, N) = AND (7, SHIFT (I, -N)) C INITIALIZE VARIABLES READ (2, 10) FAM, (START (I:I+1), I=1,7,3), STRF, 1 (END (J:J+1), J=1,7,3), ENDF 10 FORMAT (A7/2(3A2,I1)) STRMID = STRF .EQ. 1 ENDMID = ENDF .EQ. 1 ENDB4M = .NOT. ENDMID C READ ACCOUNT FILE 1000 READ (1, 20, END=2000) TIME, MSGTYP, SUBTYP, FAMILY, FS, LINE 20 FORMAT (1X, A8, 11X, A2, A2, 2X, A7, A1, A40) IF (TIME .LT. LAST) THEN AFTMID = .TRUE. B4MID = .FALSE. END IF LAST = TIME IF (STRMID) THEN C START AFTER MIDNIGHT IF (B4MID) GO TO 1000 IF (START .GT. TIME) GO TO 1000 IF (END .LE. TIME) GO TO 2000 ELSE IF (AFTMID) THEN C START BEFORE MIDNIGHT, CURRENT TIME AFTER MIDNIGHT IF (ENDB4M) GO TO 2000 IF (END .LE. TIME) GO TO 2000 ELSE C START BEFORE MIDNIGHT, CURRENT TIME BEFORE MIDNIGHT IF (START .GT. TIME) GO TO 1000 IF (ENDB4M .AND. END.LE. TIME) GO TO 2000 END IF IF (MSGTYP .NE. 'SD') GO TO 1000 IF (FAMILY .NE. FAM) GO TO 1000 IF (SUBTYP .EQ. 'AU') THEN C RESERVE MESSAGE C 1234567890123456789012345678901234567890 C FORMAT SDAU, FAMILYN/USERNAM/QNXXX/VSNFFF, VSNCCC. WRITE (3, 120) LINE (1:7), LINE (15:20), LINE (9:13) 120 FORMAT ('USER=',A7,',FILEV=',A6,'/',A5, 1 'B,RECOVER=YES') IF (LINE (15:20) .NE. LINE (23:28) .OR. 1 LINE (9:13) .NE. '00001') 2 WRITE (3, 130) LINE (23:28) 130 FORMAT ('AVSN=',A6) WRITE (3, 140) 140 FORMAT ('GO,DROP') ELSE IF (SUBTYP .EQ. 'CR') THEN C RELEASE MESSAGE C 1234567890123456789012345678901234567890 C FORMAT SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF. C OR SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF, YY/MM/DD. C (IF CONDITIONAL RELEASE) C OR SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF, YYMMDD. C (IF CONDITIONAL RELEASE FROM TFSP) C OR SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF, . C (IF CLEARING CONDITIONAL RELEASE DATE) IF (LINE (21:21) .EQ. '.') THEN C UNCONDITIONAL RELEASE WRITE (3, 150) LINE (1:7), LINE (15:20), LINE (9:13) 150 FORMAT ('USER=',A7,',RELEASV=',A6,'/',A5,'B',/,'DROP') ELSE C CONDITIONAL RELEASE IF (LINE (26:26) .EQ. '/') THEN C RELEASE BY USER WRITE (3,160) LINE (1:7), LINE (15:20), 1 (LINE (I:I+1), I = 24, 30, 3) 160 FORMAT ('USER=',A7,',FILEV=',A6,',RDATE=',3A2,/,'GO,GO') ELSE C RELEASE BY TFSP WRITE (3,161) LINE (1:7), LINE (15:20), 1 (LINE (I:I+1), I = 24, 28, 2) 161 FORMAT ('USER=',A7,',FILEV=',A6,',URDATE=',3A2,/,'GO,GO') ENDIF ENDIF ELSE IF (SUBTYP .EQ. 'AD' .OR. SUBTYP .EQ. 'RV') THEN C VSN ADD OR REVISE C 1234567890123456789012345678901234567890 C FORMAT SDAD, FAMILYN, VSNESN, VSNPRN, SSSSSS. C FORMAT SDRV, FAMILYN, VSNESN, VSNPRN, SSSSSS. READ (LINE (18:23), '(O6)') STATUS WRITE (3, 190) LINE (2:8), LINE (10:15), 1 STMAIN (BIT (STATUS, BITMAIN)), 2 STOWNR (BIT (STATUS, BITOWNR)), 3 STSITE (BIT (STATUS, BITSITE)), 4 STERRF (BIT (STATUS, BITERRF)), 5 STSYST (BIT (STATUS, BITSYST)), 6 STVTYP (BIT2 (STATUS, BT2VTYP)) 190 FORMAT ('VSN=',A6,',PRN=',A6,',MAINT=',A,',OWNER=',A,',SITE=', 1 A/'ERRFLAG=',A,',SYSTEM=',A3,',VT=',A4,/,'GO') ELSE IF (SUBTYP .EQ. 'RM') THEN C VSN REMOVE C 1234567890123456789012345678901234567890 C FORMAT SDRM, FAMILYN, VSNESN. WRITE (3, 200) LINE (2:7) 200 FORMAT ('REMOVE=',A6) ELSE IF (SUBTYP .EQ. 'AM') THEN C TSITE/TOWNER CHANGE C 1234567890123456789012345678901234567890 C FORMAT SDAM, FAMILYN, USERNAM, VSNFFF, SSSSSS. READ (LINE (19:24), '(O6)') STATUS WRITE (3, 210) LINE (2:8), LINE (11:16), 1 STOWNR ( BIT (STATUS, BITOWNR)), 2 STSITE ( BIT (STATUS, BITSITE)) 210 FORMAT ('USER=',A7,',FILEV=',A6,',TOWNER=',A,',TSITE=',A, 1 /,'GO,DROP') ENDIF IF (SUBTYP .EQ. 'RA') THEN C *TMS* RECOVERY INFORMATION C 1234567890123456789012345678901234567890 C FORMAT SDRA, FAMILYN/USERNAM/QNXXX/VSNFFF, TFD/PASSWRD. C IF *PASSWRD* IS NULL, THE FORMAT IS THE FOLLOWING - C SDRA, FAMILYN/USERNAM/QNXXX/VSNFFF, TFD. C OPTIONAL SDRB, FAMILYNYLOGICAL*FILE*IDNTXPHYSICAL*FILE*IDT. C END MSG SDRC, FAMILYN/CONTROLWRDX/CHRGNUMBER, MULSIDY. READ (LINE (23:25), '(R3)') STATUS STATUS = STATUS - O"10101" WRITE (3, 1400) LINE (1:7), LINE (15:20), LINE (9:13), 1 LABTYPE (BIT3 (STATUS, BT3LABT)), 2 CONMODE (BIT3 (STATUS, BT3CONV)), 3 FORMAT (BIT3 (STATUS, BT3FORM)), 4 LINE (27:33) 1400 FORMAT ('USER=',A7,',FILEV=',A6,'/',A5, 1 'B,RECOVER=YES,LB=',A2,',CV=',A2,',F=',A2,',PW=',A7) 1410 FORMAT ('D=',A2) IF (BIT2 (STATUS, BT2TTYP) .EQ. 0) THEN WRITE (3, 1410) DENSIT7 (BIT3 (STATUS, BT3DENS)) ELSE IF (BIT2 (STATUS, BT2TTYP) .EQ. 2) THEN WRITE (3, 1410) DENSIT9 (BIT3 (STATUS, BT3DENS)) ELSE WRITE (3, 1410) DENSITC (BIT2 (STATUS, BT2TTYP)) END IF ELSE GOTO 1000 END IF 1500 READ (1, 20, END=1600) TIME, MSGTYP, SUBTYP, FAMILY, FS, LINE IF (TIME .LT. LAST) THEN AFTMID = .TRUE. B4MID = .FALSE. END IF LAST = TIME IF (STRMID) THEN C START AFTER MIDNIGHT IF (B4MID) GO TO 1500 IF (START .GT. TIME) GO TO 1500 IF (END .LE. TIME) GO TO 1600 ELSE IF (AFTMID) THEN C START BEFORE MIDNIGHT, CURRENT TIME AFTER MIDNIGHT IF (ENDB4M) GO TO 1600 IF (END .LE. TIME) GO TO 1600 ELSE C START BEFORE MIDNIGHT, CURRENT TIME BEFORE MIDNIGHT IF (START .GT. TIME) GO TO 1500 IF (ENDB4M .AND. END .LE. TIME) GO TO 1600 END IF IF (MSGTYP .NE. 'SD') GO TO 1500 IF (FAMILY .NE. FAM) GO TO 1500 IF (SUBTYP .EQ. 'RB') THEN SEP = FINDS ( LINE, 1, 17, LINE (18:18)) WRITE (3, 1510) LINE (18:18), SEP, LINE (1:17), SEP, SEP 1510 FORMAT ('COLON=',A1,',SEPARAT=',A1,',FI=',A17,A1,'SEPARAT=',A1, 1 'COLON=,SV=SET') SEP = FINDS ( LINE, 19, 35, FS) WRITE (3, 1515) FS, SEP, LINE (19:35), SEP, SEP 1515 FORMAT ('COLON=',A1,',SEPARAT=',A1,',PI=',A17,A1,'SEPARAT=',A1, 1 'COLON=') GOTO 1500 END IF IF (SUBTYP .EQ. 'RC') THEN SEP = FINDS ( LINE, 9, 18, LINE (11:11)) WRITE (3, 1530) LINE (13:22), LINE (11:11), SEP, LINE (1:10), 1 SEP, SEP 1530 FORMAT ('CN=',A10,',COLON=',A1,',SEPARAT=',A1,',UC=',A10,A1, 1 'SEPARAT=',A1,'COLON=') SEP = FINDS ( LINE, 25, 30, LINE (31:31)) WRITE (3, 1535) LINE (31:31), SEP, LINE (25:30), SEP, SEP 1535 FORMAT ('COLON=',A1,',SEPARAT=',A1,',SI=',A6,A1, 1 'SEPARAT=',A1,'COLON=') END IF 1600 WRITE (3,1610) 1610 FORMAT ('GO,DROP') GO TO 1000 C END OF DAYFILE 2000 WRITE (3, 220) 220 FORMAT ('GO') END CHARACTER*1 FUNCTION FINDS ( ARR, FC, LC, FS) IMPLICIT INTEGER (A-Z) CHARACTER ARR*40, FS*1 CALL COLSEQ('DISPLAY') SC = ICHAR(FS) 1 SC = SC - 1 FINDS = CHAR(SC) IF (FINDS .EQ. ' ') GOTO 1 DO 2 I = FC, LC IF (ARR(I:I) .EQ. FINDS) GOTO 1 2 CONTINUE RETURN END PROGRAM TMSBILL(MREAD=/300,TAPE2,TAPE1=MREAD) C C *TMSBILL* IS USED BY *GENTMS* TO CONVERT A *TFSP* MACHINE C READABLE OUTPUT FILE INTO A *TFDUMP* FORMATTED FILE. THE FORMAT C OF THE CALL IS - C C TMSBILL,MREAD,TAPE2. C C WHERE - C MREAD = LOCAL FILE NAME OF THE MACHINE READABLE FILE GENERATED C BY THE *TFSP* *MREADUN=* DIRECTIVE. C TAPE2 = LOCAL FILE NAME OF THE *TFDUMP* FILE. C 100 FORMAT(1X,3A7,2A10,24X,6A2,77X,A6,12X,A6,8X,A6,24X,A6) 200 FORMAT(2A7,"000000",A6,1X,A3,"0000000001", C 1X,A2,"/",A2,"/",A2,".",1X,A2,".",A2,".",A2,".", C A7,2X,"E",2A10) INTEGER FAM,UN,VSN,CN,PN(2),YR,MO,DY,HR,MI,SC,OWNER INTEGER OLDVSN,MT,UT INTEGER LVSN,NVSN,RDATE,RD MT="MT " UT="UT " OLDVSN=0 LVSN=0 RDATE=" " 300 CONTINUE READ(1,100,END=400)FAM,UN,CN,PN,YR,MO,DY,HR,MI,SC C ,VSN,NVSN,OWNER,RD IF(VSN.NE.LVSN)THEN RDATE=RD ENDIF IF(RDATE.EQ." ")THEN IF(VSN.NE.OLDVSN)THEN IF(OWNER.EQ.6HCENTER)THEN WRITE(2,200)FAM,UN,VSN,MT,YR,MO,DY,HR,MI,SC,CN,PN ELSE WRITE(2,200)FAM,UN,VSN,UT,YR,MO,DY,HR,MI,SC,CN,PN ENDIF ENDIF ENDIF LVSN=NVSN OLDVSN=VSN GOTO 300 400 CONTINUE STOP END