在AS/400上根据日期生成星期几

用CONTROL LANGUAGE实现：根据给定的日期生成星期几。
解答 源代码如下：
程序名：WEEK2
类型：CLP

PGM (&Date)

DCL --&Date ------*Char -10
DCL --&LDateB ----*Char --4 --/* Binary */
DCL --&LDateN ----*Dec --15 0 /* Decimal*/
DCL --&DAYARRAY --*CHAR -63 +
------- --('Sunday Monday Tuesday +
------- --WednesdayThursday Friday Saturday ')
DCL --&IndexB ----*Char --4 --/* Binary */
DCL --&IndexN ----*Dec --15 0 /* Decimal*/
DCL --&Start -- --*Dec --15 0 /* Decimal*/
DCL --&DayOfWeek -*Char --9
DCL --&Msg -------*Char 100

DCL --&msgid -----*CHAR 7
DCL --&msgf ------*CHAR 10
DCL --&msgflib -- *CHAR 10
DCL --&msgdta ----*CHAR 100

MONMSG -CEE0000 -EXEC(GOTO ERROR)
MONMSG -CPF0000 -EXEC(GOTO ERROR)

CALLPRC 'CEEDAYS' (&Date ------+
------------------'MM/DD/YYYY' +
------------------&LDateB -----+
------------------*OMIT)

CALLPRC 'CEEDYWK' (&LDateB +
------------------&IndexB -+
------------------*OMIT)

CHGVAR &IndexN ---%BIN(&IndexB)
CHGVAR &Start ----(&IndexN * 9 - 8)
CHGVAR &DayOfWeek %SST(&DayArray &Start 9)

SNDPGMMSG MSG(&DATE > 'Falls on' > &DAYOFWEEK < +
------------'.') TOPGMQ(*PRV *PGMBDY)

Return

/* Error processing routine ------------*/

ERROR: RCVMSG MSGTYPE(*LAST) -------- +
--------------MSGDTA(&msgdta) ------- +
--------------MSGID(&msgid) ---- ---- +
--------------MSGF(&msgf) ----------- +
--------------SNDMSGFLIB(&msgflib)
----/* Prevent loop, just in case */
-------MONMSG ----CPF0000
------ SNDPGMMSG -MSGID(&msgid) -- -- +
------------------MSGF(&msgflib/&msgf)+
------------------MSGDTA(&msgdta) ----+
------------------MSGTYPE(*ESCAPE)
----/* Prevent loop, just in case */
-------MONMSG CPF0000

------ ENDPGM

执行结果：
CALL WEEK2 '09/05/2003'

09/05/2003 Falls on FRIDAY.