H DFTNAME(CRTEXDSPF) DATEDIT(*YMD/) BNDDIR('QC2LE')                                            
     F********** 曜日を算出する ********************************************                        
     F*                                                                                             
     F**********************************************************************                        
                                                                                                    
     D WKR             S              4A   DIM(7) CTDATA PERRCD(7)                                  
     D WEK             S              5I 0                                                          
     D DATEIN          S               D                                                            
     D NBRDAYS         S             10I 0                                                          
     D MONDAY          C                   CONST(D'2001-01-07')                                     
     D DAY             S              4A                                                            
                                                                                                    
      /FREE                                                                                         
        DATEIN  = %DATE('2017-04-01');                                                              
        NBRDAYS = %DIFF(DATEIN:MONDAY:*DAYS);                                                       
        WEK     = %REM(NBRDAYS:7) + 1;                                                              
        DAY     = WKR(WEK);                                                                         
      /END-FREE                                                                                     
     C     'DAY='        CAT(P)    DAY:0         DSP40            40                                
     C     DSP40         DSPLY                   ANS               1                                
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
**      WKR -- 以下は配列  --                                                                       
 日  月  火  水  木  金  土