H NOMAIN                                                       

 **************************************************************

 * Procedure: SUBPDOW                                          

 * Input: Date                                                 

 * Output: 1 - 7 Monday-Sunday                                 

 * Return: Packed Length 1                                     

 * Purpose: Receive date; Determine client's numerical day of week       

 **************************************************************

 *Prototype for SUBPDOW procedure                              

D SUBPDOW         PR             1P 0                          

D DateIn                          D                            

 *                                                             

 * P spec begin(B) required                                    

P SUBPDOW         B                   EXPORT                   

 * Procedure Input Definition                                  

D                 PI             1P 0                          

D DateIn                          D                            

 * Local variables                                             

D Weeks           S              7  0                          

D DayNbr          S              1P 0                         

 * Calculate the day of the week                              

C     DateIn        SUBDUR    D'1899-12-30' Weeks:*D          

C                   DIV       7             Weeks             

C                   MVR                     DayNbr            

 *                                                            

 * Results in Sunday -> Saturday, Values 1 -> 7               

 *                                                            

C                   IF        DayNbr < 1                      

C                   ADD       7             DayNbr            

C                   ENDIF                                     

 *                                                            

 * Convert to Monday -> Sunday, Values 1 -> 7                 

 *                                                            

C                   IF        DayNbr = 1                      

C                   ADD       6             DayNbr            

C                   ELSE                                      

C                   SUB       1             DayNbr            

C                   ENDIF                                     

 *                                                            

 * Return Day of Week Value                                   

 *                                                            

C                   RETURN    DayNbr                          

P SUBPDOW         E