TMSPROG 
      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 
