/* rexx */                                                                      
/*-------------------------------------------------------------------*/         
/*                                                                   */         
/*                       REXX Exec : JUL2GREG                        */         
/*                                                                   */         
/*  Description : This exec can be called as a command or as a stand-*/         
/*                alone procedure.                                   */         
/*                                                                   */         
/*  Created on : 16 Jun 1991                                         */         
/*  Created by : Kevin Ferguson                                      */         
/*             : Userid MIT001                                       */         
/*             : Using ABBYDALE.DEVL.REXX(JUL2GREG)                  */         
/*                                                                   */         
/*  Called by : Many EXECs                                           */         
/*                                                                   */         
/*  Calls : COUNTSTR                                                 */         
/*                                                                   */         
/*  Panels Used : None                                               */         
/*                                                                   */         
/*  Change Activity :                                                */         
/*                                                                   */         
/*                ©Copyright of Abbydale Systems LLC.                */         
/*                                                                   */         
/*-------------------------------------------------------------------*/         
Parse Arg Help chat    /* Check for Help */                                     
Jul2Greg:                                                                       
If Help = "?" Then do                                                           
   Call Disp_Help                                                               
   exit(4)                                                                      
end                                                                             
signal on halt         /* attention key      */                                 
codate = ARG(1)                                                                 
chat = ARG(2)                                                                   
done = "n"                                                                      
mm. = 0               /* Build month array              */                      
push 31 x 31 30 31 30 31 31 30 31 30 31                                         
pull mm.1 mm.2 mm.3 mm.4 mm.5 mm.6 mm.7 mm.8 mm.9 mm.10 mm.11 mm.12             
if codate = "" then do                                                          
   do until done = "y"                                                          
   say 'Enter date to be converted in the format yyyy.jjj or <QUIT>'            
   parse upper pull xdate                                                       
   if xdate = "<QUIT>" then exit                                                
   if pos('.',xdate) <> 5 then do                                               
      say 'Invalid date. The date must be in the format yyyy.jjj'               
   end                                                                          
   else do                                                                      
      if countstr('.',xdate) > 1 then do                                        
         say 'Too many periods found in date. Re-enter'                         
      end                                                                       
      else do                                                                   
         if length(xdate) <> 8 then do                                          
            say 'Length error. Date must be 8 characters in the format',        
                'yyyy.jjj. Please re-enter'                                     
         end                                                                    
         else do                                                                
            year = substr(xdate,1,4)                                            
            Julian = Substr(xdate,6,3)                                          
            mm.2 = 28 + (year//4=0) + (year//100=0) - (year//400=0)             
            if datatype(year,'N') = 1 then do                                   
               if datatype(Julian,'N') = 1 then do                              
                  done = "y"                                                    
                  If mm.2 = 29 then do                                          
                     if Julian > 366  then do                                   
                     say 'Invalid number of days for Julian specified'          
                     done = "n"                                                 
                     end                                                        
                     else do                                                    
                         if Julian > 365 then do                                
                     say 'Invalid number of days for Julian specified'          
                     done = "n"                                                 
                        end                                                     
                     end                                                        
                  end                                                           
                  if julian = 0 then do                                         
                     say 'Julian day can not be zero. Re-enter'                 
                     done = "n"                                                 
                  end                                                           
                  if year = 0 then do                                           
                     say 'Year can not be zero. Re-enter'                       
                     done = "n"                                                 
                  end                                                           
               end                                                              
               else do                                                          
                  say 'Date must be numeric. Please re-enter'                   
               end                                                              
            end                                                                 
            else do                                                             
               say 'Year value not numeric. Please re-enter'                    
            end                                                                 
         end                                                                    
      end                                                                       
   end                                                                          
codate = xdate                                                                  
end                                                                             
end                                                                             
year = substr(codate,1,4)              /* 4-digit year               */         
Julian = Substr(codate,6,3)                                                     
mm.2 = 28 + (year//4=0) + (year//100=0) - (year//400=0)                         
mm = 1                                                                          
if mm.2 = "29" then do                                                          
   if Julian > 366 then do                                                      
      exit(8)                                                                   
   end                                                                          
end                                                                             
else do                                                                         
   if Julian > 365 then do                                                      
      exit(8)                                                                   
   end                                                                          
end                                                                             
if chat <> " " then do                                                          
   if pos('.',codate) <> 5 then do                                              
      exit(1)                                                                   
   end                                                                          
   else do                                                                      
      if countstr('.',codate) > 1 then do                                       
         exit(2)                                                                
      end                                                                       
      else do                                                                   
         if length(codate) <> 8 then do                                         
            exit(3)                                                             
         end                                                                    
         else do                                                                
            if datatype(year,'N') = 1 then do                                   
               if datatype(Julian,'N') = 1 then do                              
                  If mm.2 = 29 then do                                          
                     if Julian > 366 then do                                    
                        exit(5)                                                 
                     end                                                        
                     else do                                                    
                        if Julian > 365 then do                                 
                           exit(5)                                              
                     end                                                        
                  end                                                           
                  if julian = 0 then do                                         
                     exit(7)                                                    
                     done = "n"                                                 
                  end                                                           
                  if year = 0 then do                                           
                     exit(9)                                                    
                  end                                                           
               end                                                              
               end                                                              
               else do                                                          
                  exit(6)                                                       
               end                                                              
            end                                                                 
            else do                                                             
               exit(6)                                                          
            end                                                                 
         end                                                                    
      end                                                                       
   end                                                                          
end                                                                             
if julian <= 31 then do                                                         
   codate = year'/'right(mm,2,'0')'/'right(julian,2,'0')                        
   signal leave                                                                 
end                                                                             
julian = julian - mm.1                                                          
Do k = 2 to 12                                                                  
   z = julian - mm.k                                                            
   if z <= 0 then do                                                            
      codate = year'/'right(k,2,'0')'/'right(Julian,2,'0')                      
      signal leave                                                              
   end                                                                          
   julian = z                                                                   
end                                                                             
leave:                                                                          
if chat <> "" then do                                                           
   return codate                                                                
end                                                                             
else do                                                                         
   say 'YYYY MM DD'                                                             
   say '----------'                                                             
   say codate                                                                   
   return                                                                       
end                                                                             
/*-------------------------------------------------------------------*/         
/*                        Disp_Help Procedure                        */         
/*-------------------------------------------------------------------*/         
Disp_Help: Procedure                                                            
say "JUL2GREG - Converts a Julian format date to a Gregorian."                  
say""                                                                           
say "           The input date should be in the format yyyy.jjj"                
say "           The output date is in the format yyy/mm/dd"                     
say""                                                                           
say "Usage: JUL2GREG yyyy.jjj chat | ?"                                         
say""                                                                           
say"    yyyy.jjj - Specifies the Julian date to be converted."                  
say"    chat     - Any non-blank character will cause the message"              
say"               displaying the converted date to be suppressed."             
say"    ?        - Generates this information."                                 
say""                                                                           
say"       If no date is passed to the exec then the user will be"              
say"       prompted for a date. A reply of <QUIT> will end the exec"            
say""                                                                           
say"   Return Codes :"                                                          
say"                 1 - Incorrect date format. No period in position 5"        
say"                 2 - Too many periods in date"                              
say"                 3 - Date too long"                                         
say"                 4 - Help displayed"                                        
say"                 5 - Invalid number of days in year"                        
say"                 6 - Date not numeric"                                      
say"                 7 - Julian day value was 0"                                
say"                 8 - Too many days in year"                                 
say"                 9 - Year value was zero"                                   
say""                                                                           
Return                                                                          
/*-------------------------------------------------------------------*/         
/*                    End of Disp_Help Procedure                     */         
/*-------------------------------------------------------------------*/         
/*                        Trap HALT Condition                        */         
/*-------------------------------------------------------------------*/         
halt:                                                                           
say "HALT acknowledged in line" sigl                                            
say "Cleanup processing in progress"                                            
address "TSO"                                                                   
"delstack"                                                                      
exit(16)                                                                        
/*-------------------------------------------------------------------*/         
/*                          End of JUL2GREG                          */         
/*-------------------------------------------------------------------*/