
                               					 1-Dec-1987 17:58:37	VAX FORTRAN V4.5-219                Page   1
								 1-Dec-1987 17:58:28	DRB0:[PHIL.SXES_DTC]NAME_CHANGE.FOR;2       

0001    	Subroutine Name_change
0002    c
0003    c Subroutine lets you assign other file names by description
0004    c
0005    c format:
0006    c  /name/appt_file_name/weekly_file_name/Description
0007    c
0008    	Implicit None
0009    	Character string*100
0010    	Character blank*1/' '/,slash*1/'/'/
0011    	Character Weekly_file_name*40
0012    	Character Appt_file_name*40
0013    	Integer*4 Str$position, rel_pos,beg_pos,end_pos
0014    	Integer Nunit,Num_char,jj
0015    	Include 'Dtc_source(Comdtc_common)/list'
0016  1 c Common file COMDTC.INC for Desk Top Calendar programs
0017  1 c
0018  1 	parameter iterm = 6	! Terminal unit number
0019  1 c
0020  1 	parameter icmln = 84,	! Length of character buffers
0021  1 	1         iaptlim = 68	! maximum displayed length
0022  1 c
0023  1 	integer comlen, comidx	! Current info
0024  1 	byte line(icmln)	! command line
0025  1 	common /cmdlin/ comlen, comidx, line
0026  1 c
0027  1 c  info on notes for the day
0028  1 c
0029  1 	Logical*1 Note_write,on,off
0030  1 	common/Dtc_note/note_write,on,off
0031  1  
0032  1 c
0033  1 	integer tokstart, toklen, tokfidx ! Command-line scanning info
0034  1 	byte tokfound		! for multi-token scans
0035  1 	common /cmdscan/ tokstart, toklen, tokfidx, tokfound
0036  1 c
0037  1 	integer rdspfg          !  flag to reverse sense of display of time
0038  1 	integer ctlfg           !  misc control flags here
0039  1 	common /ctls/ rdspfg, ctlfg
0040  1 c
0041  1 	integer idyr, idmo, iddy, incmod, ibigyr
0042  1 	common /defdat/ idyr, idmo, iddy, incmod, ibigyr
0043  1 c
0044  1 	integer fnsz		! Size of filename
0045  1 	byte fname(60)
0046  1 	Integer Weekly_File_siz
0047  1 	Byte Weekly_file(60)
0048  1 c
0049  1 	Integer Name_file_siz !siz of file_name for other time locations
0050  1 	Character Name_file*60	!file name of other addresses
0051  1 c
0052  1 	Character*50 Name_description
0053  1 	Character Name*20
0054  1 c
0055  1 	common /fn/ fnsz, fname,Weekly_file_siz,Weekly_file,
0056  1      +    Name_file_siz, name_file, Name_description, Name
0057  1 c

NAME_CHANGE                    					 1-Dec-1987 17:58:37	VAX FORTRAN V4.5-219                Page   2
								 1-Dec-1987 17:58:28	DRB0:[PHIL.SXES_DTC]NAME_CHANGE.FOR;2       

0058  1 	byte ucmask/'5f'x/	! Useful constant
0059  1 c
0060  1 c End of COMDTC.INC
0061    	Equivalence (fname,Appt_file_name),
0062         +     (Weekly_file,Weekly_file_name)
0063    c
0064    	Nunit=4
0065    	Close(Nunit)
0066    	Open(unit=nunit,file=name_file,status='OLD',
0067         +   err=90 )
0068    c
0069    10	Continue !come here to read again
0070    c
0071    	Read(nunit,100,end=90) Num_char,string
0072    100	format(q,a)
0073    c
0074    c Look for name match
0075    c
0076    	Beg_pos=2
0077    	End_pos=Num_char
0078    	rel_pos=str$position(string(beg_pos:end_pos),slash)
0079    	if(rel_pos.ne.0) Then !found something
0080    	  End_pos=Beg_pos+rel_pos-2
0081    	  call str$upcase(name,name)
0082    	  call str$upcase(string(beg_pos:end_pos),
0083         +       string(beg_pos:end_pos))
0084    	  If(name.ne.string(beg_pos:End_pos)) Then !no match..read another line
0085    	    Goto 10 !go to the read
0086    	  Endif
0087    	Else !no end of file...must be a blank or comment...read again
0088    	  Goto 10
0089    	Endif
0090    c
0091    c Ok, we have a match...get rest of info
0092    c
0093    c
0094    c Find appt file name
0095    c		
0096    	Beg_pos=end_pos+2 !skip the slash
0097    	End_pos=Num_char-Beg_pos
0098    	rel_pos=str$position(string(beg_pos:Num_char),slash)
0099    	If(rel_pos.eq.0)Then
0100    	  Appt_file_name=blank
0101    	Else
0102    	  End_pos=Beg_pos+rel_pos-2
0103    	  Appt_file_name=string(Beg_pos:end_pos)
0104    	Endif
0105    c
0106    c find weekly file name
0107    c
0108    	Beg_pos=end_pos+2
0109    	Rel_pos=str$position(string(beg_pos:Num_char),slash)
0110    	If(rel_pos.eq.0) Then
0111    	  Weekly_file_name=blank
0112    	Else
0113    	  End_pos=Beg_pos+rel_pos-2
0114    	  Weekly_file_name=string(beg_pos:end_pos)

NAME_CHANGE                    					 1-Dec-1987 17:58:37	VAX FORTRAN V4.5-219                Page   3
								 1-Dec-1987 17:58:28	DRB0:[PHIL.SXES_DTC]NAME_CHANGE.FOR;2       

0115    	Endif
0116    c
0117    c Find description
0118    c
0119    	Beg_pos=end_pos+2
0120    	End_pos=Num_char-Beg_pos
0121    	Rel_pos=str$position(string(beg_pos:end_pos),slash)
0122    	If(rel_pos.eq.0) then
0123    	  Name_description=string(Beg_pos:num_char)
0124    	Else
0125    	  Name_description=string(beg_pos:end_pos)
0126    	Endif
0127    c
0128    	Close(Nunit)
0129    	Return
0130    c
0131    c Return w/no change
0132    c
0133    90	Continue
0134    	Close(Nunit)
0135    	return
0136    	end




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  432   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                   3   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 252   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 CMDLIN                                  92   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG
  4 DTC_NOTE                                 3   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG
  5 CMDSCAN                                 13   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG
  6 CTLS                                     8   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG
  7 DEFDAT                                  20   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG
  8 FN                                     262   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                 1085


ENTRY POINTS

    Address  Type  Name          

  0-00000000       NAME_CHANGE   


VARIABLES

    Address  Type  Name                                               Address  Type  Name                            

  8-00000004  CHAR APPT_FILE_NAME                                       **      I*4  BEG_POS                         
  2-00000064  CHAR BLANK                                            3-00000004  I*4  COMIDX                          
  3-00000000  I*4  COMLEN                                           6-00000004  I*4  CTLFG                           

NAME_CHANGE                    					 1-Dec-1987 17:58:37	VAX FORTRAN V4.5-219                Page   4
								 1-Dec-1987 17:58:28	DRB0:[PHIL.SXES_DTC]NAME_CHANGE.FOR;2       

      **      I*4  END_POS                                          8-00000000  I*4  FNSZ                            
  7-00000010  I*4  IBIGYR                                           7-00000008  I*4  IDDY                            
  7-00000004  I*4  IDMO                                             7-00000000  I*4  IDYR                            
  7-0000000C  I*4  INCMOD                                               **      I*4  JJ                              
  8-000000F2  CHAR NAME                                             8-000000C0  CHAR NAME_DESCRIPTION                
  8-00000084  CHAR NAME_FILE                                        8-00000080  I*4  NAME_FILE_SIZ                   
  4-00000000  L*1  NOTE_WRITE                                       2-0000006C  I*4  NUM_CHAR                        
  2-00000068  I*4  NUNIT                                            4-00000002  L*1  OFF                             
  4-00000001  L*1  ON                                               6-00000000  I*4  RDSPFG                          
      **      I*4  REL_POS                                          2-00000065  CHAR SLASH                           
  2-00000000  CHAR STRING                                           5-00000008  I*4  TOKFIDX                         
  5-0000000C  L*1  TOKFOUND                                         5-00000004  I*4  TOKLEN                          
  5-00000000  I*4  TOKSTART                                             **      L*1  UCMASK                          
  8-00000044  CHAR WEEKLY_FILE_NAME                                 8-00000040  I*4  WEEKLY_FILE_SIZ                 


ARRAYS

    Address  Type  Name                Bytes  Dimensions

  8-00000004  L*1  FNAME                  60  (60)
  3-00000008  L*1  LINE                   84  (84)
  8-00000044  L*1  WEEKLY_FILE            60  (60)


LABELS

    Address   Label       Address   Label       Address   Label   

      **      10        0-000001A4  90        1-00000000  100'    


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name            Type  Name          

        FOR$CLOSE             FOR$OPEN         I*4  STR$POSITION          STR$UPCASE    


COMMAND QUALIFIERS

  FOR/LIS NAME_CHANGE

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /STANDARD=(NOSYNTAX,NOSOURCE_FORM)
  /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP,NODICTIONARY,SINGLE)
  /WARNINGS=(GENERAL,NODECLARATIONS,NOULTRIX)
  /CONTINUATIONS=19  /NOCROSS_REFERENCE  /NOD_LINES  /NOEXTEND_SOURCE  /F77
  /NOG_FLOATING  /I4  /NOMACHINE_CODE  /OPTIMIZE

NAME_CHANGE                    					 1-Dec-1987 17:58:37	VAX FORTRAN V4.5-219                Page   5
								 1-Dec-1987 17:58:28	DRB0:[PHIL.SXES_DTC]NAME_CHANGE.FOR;2       

COMPILATION STATISTICS

  Run Time:           2.98 seconds
  Elapsed Time:       7.21 seconds
  Page Faults:        526
  Dynamic Memory:     812 pages
