c Date munger function c part of DTC c Subroutine datmun(line) Byte line(84),work(84) byte l1,l2,l3 c c function: c edit a line starting with a date of form c mm/dd/yy c into one starting with a date of form c mmddyy c c also if the line starts with a date of form c dd-mmm-yy c edit back into mmddyy from c that form. Leaves whatever follows the date alone. c Added for DTC to not have to use such a crock date c format as the original; too hard to use otherwise. c if mmddyy form already exists, leave line alone. do 1 n=1,6 if(line(n).eq.'/')goto 100 c 100 is for mm/dd/yy form if(line(n).eq.'-')goto 200 c 200 is for dd-mmm-yy form 1 continue c if format looks OK already, just return and leave line alone. Return 100 continue c handle mm/dd/yy and turn into mmddyy if(line(2).eq.'/') then work(1)='0' work(2)=line(1) k=3 else work(1)=line(1) work(2)=line(2) k=4 end if if(line(k+1).eq.'/')then work(3)='0' work(4)=line(k) kk=k+2 else work(3)=line(k) work(4)=line(k+1) kk=k+3 end if work(5)=line(kk) work(6)=line(kk+1) c set up pointers to next element of line (i.e., kkk) c for copy of rest of stuff. kkk=kk+2 goto 300 200 continue c handle dd-mmm-yy and turn into mmddyy if(line(2).eq.'-')then work(3)='0' work(4)=line(1) k=3 else work(3)=line(1) work(4)=line(2) k=4 end if work(5)=line(k+4) work(6)=line(k+5) kkk=k+6 c now have pointers, but month needs to be filled in. c note we assume year always is entered as 2 digits c and month is 3 chars... if(line(k+3).ne.'-')then work(1)=0 c zero stuff to pass if not 3 char month work(2)=0 goto 300 end if kk=k+3 do 220 n=k,kk nn=line(n) c mask off 32 (dec) bit to c make letters uppercase nn=nn.and.223 line(n)=nn 220 continue l1=line(k) l2=line(k+1) l3=line(k+2) c decode months the hard way work(1)='0' work(2)='0' IF(L1.EQ.'J'.AND.L2.EQ.'A')THEN WORK(2)='1' GOTO 300 ELSE IF(L1.EQ.'F')THEN WORK(2)='2' GOTO 300 ELSE IF(L1.EQ.'M'.AND.L2.EQ.'A'.AND.L3.EQ.'R')THEN WORK(2)='3' GOTO 300 ELSE IF(L1.EQ.'A'.AND.L2.EQ.'P')THEN WORK(2)='4' GOTO 300 ELSE IF(L1.EQ.'M'.AND.L2.EQ.'A'.AND.L3.EQ.'Y')THEN WORK(2)='5' GOTO 300 ELSE IF(L1.EQ.'J'.AND.L2.EQ.'U'.AND.L3.EQ.'N')THEN WORK(2)='6' GOTO 300 ELSE IF(L1.EQ.'J'.AND.L2.EQ.'U'.AND.L3.EQ.'L')THEN WORK(2)='7' GOTO 300 ELSE IF(L1.EQ.'A'.AND.L2.EQ.'U')THEN WORK(2)='8' GOTO 300 ELSE IF(L1.EQ.'S')THEN WORK(2)='9' GOTO 300 ELSE IF(L1.EQ.'O')THEN WORK(1)='1' GOTO 300 ELSE IF(L1.EQ.'N')THEN WORK(1)='1' WORK(2)='1' GOTO 300 ELSE IF(L1.EQ.'D')THEN WORK(1)='1' WORK(2)='2' GOTO 300 ELSE WORK(1)=0 WORK(2)=0 C UNRECOGNIZED MONTH -- SCREW IT... END IF goto 300 300 continue c common clean-up & return do 310 n=7,84 work(n)=line(kkk) if(kkk.lt.84)kkk=kkk+1 310 continue do 320 n=1,84 320 line(n)=work(n) c copies edited string back for further work return end