*********************************************************************
**** Calcula el dia de la semana 
**** Juan Francisco Matoses
**** Ultima modificaci¢n 940510
**** Parametros :
****                 Fecha de 8 digitos formato DDMMAAA numerico
****                 Dia de la semana de 10 caracteres alfanum.
**** Sistemas impl. SP1AS401
****                S44002472 
*********************************************************************
     E                    DIAS    1   7 10                                      
     IFECHA       DS                                                            
     I                                        1   20DD                          
     I                                        3   40MM                          
     I                                        5   80AA                          
     I                                        1   80DMAA                        
     C                     EXSR VERDIA                                          
     C                     SETON                     LR                         
     C           *INZSR    BEGSR                                                
     C           *ENTRY    PLIST                                                
     C                     PARM           FECHAW  80       DDMMAAAA             
     C                     PARM           DIASEM 10                             
     C           VERDIA    BEGSR                                                
     C                     MOVE FECHAW    DMAA                                  
     C                     Z-ADD0         A1      50                            
     C                     Z-ADD0         A2      50                            
     C                     Z-ADD0         A3      50                            
     C                     Z-ADD0         A4      50                            
     C                     Z-ADD0         A5      50                            
     C           MM        IFGT 2                                               
     C                     Z-ADDAA        J       40                            
     C                     Z-ADDMM        K       20                            
     C                     ELSE                                                 
     C           AA        SUB  1         J                                     
     C           MM        ADD  12        K                                     
     C                     END                                                  
     C           DD        SUB  1         A1                                    
     C           5         MULT J         A2                                    
     C           A2        DIV  4         A2                                    
     C           A1        ADD  A2        A2                                    
     C           J         DIV  100       A3                                    
     C           A2        SUB  A3        A3                                    
     C           J         DIV  400       A4                                    
     C           A3        ADD  A4        A4                                    
     C           K         ADD  1         A5                                    
     C           13        MULT A5        A5                                    
     C           A5        DIV  5         A5                                    
     C           A4        ADD  A5        A5                                    
     C           A5        DIV  7         A5                                    
     C                     MVR            RESTO   10                            
     C           RESTO     IFEQ 0                                               
     C                     Z-ADD7         RESTO                                 
     C                     END                                                  
     C                     Z-ADDRESTO     R       10                            
     C                     MOVE DIAS,R    DIASEM                                
     C                     ENDSR                                                
**                                                                              
Lunes                                                                           
Martes                                                                          
Miercoles                                                                       
Jueves                                                                          
Viernes                                                                         
Sabado                                                                          
Domingo