.title	'Callable Mail Example'
;
;
;		C A L L M A I L . D B L
;
;

;	Ver/Edit	 Edit Date	By	Reason
;
;

EXTERNAL	FUNCTION
	MAIL$MAILFILE_OPEN	,%VAL
	MAIL$MAILFILE_BEGIN	,%VAL
	MAIL$MAILFILE_CLOSE	,%VAL
	MAIL$MAILFILE_END	,%VAL
	MAIL$MAILFILE_COMPRESS	,%VAL
	MAIL$MESSAGE_BEGIN	,%VAL
	MAIL$MESSAGE_COPY	,%VAL
	MAIL$MESSAGE_DELETE	,%VAL
	MAIL$MESSAGE_END	,%VAL
	MAIL$MESSAGE_GET	,%VAL
	MAIL$MESSAGE_INFO	,%VAL
	MAIL$MESSAGE_MODIFY	,%VAL
	MAIL$MESSAGE_SELECT	,%VAL
	MAIL$USER_BEGIN		,%VAL
	MAIL$USER_END		,%VAL
	MAIL$USER_GET_INFO	,%VAL
	MAIL$USER_SET_INFO	,%VAL

EXTERNAL FUNCTION
	SYS$TRNLNM	,%VAL
	.page
.include '$LNMDEF' library 'sys$library:dblstarlet'
	.page
.include	'maildef.dib'
	.page
.include	'mailmsgdef.dib'
	.page
RECORD
	GROUP	IN_ITEM_LIST	,[5]A
		Buff_Length	,I2
		Item_Code	,I2
		Buffer_Addr	,I4
		Return_Length	,I4
	ENDGROUP
	In_End_Of_List		,I4

RECORD
	GROUP	OUT_ITEM_LIST	,[5]A
		Buff_Length	,I2
		Item_Code	,I2
		Buffer_Addr	,I4
		Return_Length	,I4
	ENDGROUP
	Out_End_Of_List		,I4


RECORD
LIDL			,I1,4	;Length of Longword Item Descriptor
WIDL			,I1,2	;Length of Word Item Descriptor
MAIL_CONTEXT		,I4	;Context Returned from Call to MAILFILE routines
MESS_CONTEXT		,I4	;Context Returned from Call to MESSAGE routines
USER_CONTEXT		,I4	;Context Returned from Call to USER routines
STATUS			,I4	;Status Returned from Call
MAIL_FILE_NAME		,A8,'MAIL.MAI'
NEW_MAIL_FOLDER		,A7,'NEWMAIL'		;Folder for NEWMAIL
ERROR_FOLDER		,A6,'ERRORS'		;Folder for messages that
						;could not be extracted
WASTEBASKET_FOLDER	,A11,'WASTEBASKET'	;Folder for messages that
						;will be deleted
DAILY_FOLDER		,A9	;Folder that messages from NEWMAIL folder
				;will stored in for one week (Rolling)
DAILY_FOLDER_LEN	,I1	;Length of "DAILY_FOLDER"
CURRENT_DAY		,D1	;Value of current day from function WKDAY
DAYS			,[7]A*,'SUNDAY','MONDAY','TUESDAY','WEDNESDAY'
&			,'THURSDAY','FRIDAY','SATURDAY'
DAYS_LEN		,[7]D1,6,6,7,9,8,6,8
BLANK_LINE		,A80	;Blank Line for text compares
MONTHS			,[12]A3,'JAN','FEB','MAR','APR','MAY','JUN'
&				,'JUL','AUG','SEP','OCT','NOV','DEC'
CURRENT_DATE		,D6	;Current Date (reformatted YYMMDD)
CUR_DATE		,A11	;Current Date
TEXT_CHANNEL		,I1,1	;Channel number for TEXT File I/O
SUBJECT			,A80	;Subject Text of this Mail Message Header Record
SUBJECT_LENGTH		,I2	;Length of "SUBJECT"
TEXT			,A80	;Message Text of this Mail Message Record
TEXT_LENGTH		,I4	;Length of "TEXT"
COUNTER			,I2	;Counter for loop control
MESSAGE_ID		,I4	;Message ID
NUM_MESSAGES		,I4	;Number of messages selected
NUM_PROCESSED		,I2	;Number of messages processed
USER_ACTION		,I4,%XTRNL(FOCRE)
FOLDER_CREATED		,A80	;Name of the folder that was created.
FOLDER_CREATED_LENGTH	,I4	;Length of "FOLDER_CREATED"
ZERO			,I2,0	;Zero
CURRENT_USERNAME	,A12	;Current Username
CU_LENGTH		,I4	;Length of "CURRENT_USERNAME"
NEW_MESSAGES		,I2	;New messages count
NEWMAIL_COUNTER		,I4	;NEWMAIL Counter
ERROR			,D3	;Error Number
OUTPUT_FILE_SPEC	,A80	;File Specification of Report File created
FIRST_SPACE		,I1	;Position of first space encountered in string
NEW_MAIL_FILE		,A80	;File Specification of Mail File created
				;after the mail file compression operation.
NEW_MAIL_FILE_LENGTH	,I1	;Length of "NEW_MAIL_FILE"
MAIL_DIRECTORY		,A127	;Full directory path that defines the
				;location of MAIL.MAI for current user.
MAIL_DIRECTORY_LENGTH	,I1	;Length of "MAIL_DIRECTORY"

RECORD	MAIL
LOG_NAM_TAB_TO_SEARCH	,A17,'LNM$PROCESS_TABLE'
MAILADD			,A80		;Address of mail message for SMAIL
MAILSUB			,A80		;Subject of mail message for SMAIL
MAILMSG			,A255		;Message to be sent by SMAIL
ADDRESS			,A6,'MAILTO'		;MAILADD address logical
TEXT_ERROR		,A10,'TEXT_ERROR'	;MAILSUB subject logical
NO_ADDRESS		,I1		;Switch indicating no ADDRESS logical
NO_SUBJECT		,I1		;Switch indicating no SUBJECT logical
NO_NODE_NAME		,I1		;Switch indicating no NODE_NAME logical
THIS_NODE		,A15		;Translation of "NODE_NAME" logical
NODE_NAME		,A8,'SYS$NODE'	;Current Nodename


	PROC

	XCALL FLAGS (0001000100)	;Do not supersede existing files.

	CALL TRANSLATE_CURRENT_DATE

	CALL TRANSLATE_LOGICAL_NAMES

	CALL TRANSLATE_DAILY_FOLDER_NAME

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$MAILFILE_BEGIN (%REF(Mail_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	.subtitle	'Obtain Current User Inforamtion'
	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$USER_BEGIN (%REF(User_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	Out_Item_List[1].Buff_Length = WIDL
	Out_Item_List[1].Item_Code = MAIL$_USER_NEW_MESSAGES
	Out_Item_List[1].Buffer_Addr = %ADDR(NEW_MESSAGES)
	Out_Item_List[1].Return_Length = Zero

	Out_Item_List[2].Buff_Length = %SIZE(CURRENT_USERNAME)
	Out_Item_List[2].Item_Code = MAIL$_USER_RETURN_USERNAME
	Out_Item_List[2].Buffer_Addr = %ADDR(CURRENT_USERNAME)
	Out_Item_List[2].Return_Length = %ADDR(CU_LENGTH)

	Out_Item_List[3].Buff_Length = %SIZE(MAIL_DIRECTORY)
	Out_Item_List[3].Item_Code = MAIL$_USER_FULL_DIRECTORY
	Out_Item_List[3].Buffer_Addr = %ADDR(MAIL_DIRECTORY)
	Out_Item_List[3].Return_Length = %ADDR(MAIL_DIRECTORY_LENGTH)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$USER_GET_INFO (%REF(User_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	IF (.NOT. NEW_MESSAGES) GOTO NO_MESSAGES
	.subtitle	'Open User Mail File'
	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = MAIL_DIRECTORY_LENGTH
	In_Item_List[2].Item_Code = MAIL$_MAILFILE_DEFAULT_NAME
	In_Item_List[2].Buffer_Addr = %ADDR(MAIL_DIRECTORY)
	In_Item_List[2].Return_Length = Zero

	In_Item_List[3].Buff_Length = %SIZE(MAIL_FILE_NAME)
	In_Item_List[3].Item_Code = MAIL$_MAILFILE_NAME
	In_Item_List[3].Buffer_Addr = %ADDR(MAIL_FILE_NAME)
	In_Item_List[3].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$MAILFILE_OPEN (%REF(Mail_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = LIDL
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_FILE_CTX
	In_Item_List[2].Buffer_Addr = %ADDR(MAIL_CONTEXT)
	In_Item_List[2].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$MESSAGE_BEGIN (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	.subtitle	'Select New Mail Folder'
	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = %SIZE(NEW_MAIL_FOLDER)
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_FOLDER
	In_Item_List[2].Buffer_Addr = %ADDR(NEW_MAIL_FOLDER)
	In_Item_List[2].Return_Length = Zero

	Out_Item_List[1].Buff_Length = LIDL
	Out_Item_List[1].Item_Code = MAIL$_MESSAGE_SELECTED
	Out_Item_List[1].Buffer_Addr = %ADDR(NUM_MESSAGES)
	Out_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MESSAGE_SELECT (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	NEWMAIL_COUNTER = NUM_MESSAGES
	.subtitle	'Select Next Message'
NEXT_MESSAGE,

	INCR NUM_PROCESSED
	IF (MESSAGE_ID)
	BEGIN
		CLOSE TEXT_CHANNEL
		DECR NEWMAIL_COUNTER
		CALL SET_NEWMAIL_COUNTER
	END

	CALL CLEAR_ITEM_LISTS

	CLEAR ERROR

	IF (NUM_PROCESSED .GT. NUM_MESSAGES) GOTO NO_MORE_MESSAGES

	CALL CLEAR_ITEM_LISTS

	CLEAR MESSAGE_ID
	CLEAR SUBJECT

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = LIDL
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_NEXT
	In_Item_List[2].Buffer_Addr = Zero
	In_Item_List[2].Return_Length = Zero

	Out_Item_List[1].Buff_Length = %SIZE(SUBJECT)
	Out_Item_List[1].Item_Code = MAIL$_MESSAGE_SUBJECT
	Out_Item_List[1].Buffer_Addr = %ADDR(SUBJECT)
	Out_Item_List[1].Return_Length = %ADDR(SUBJECT_LENGTH)

	Out_Item_List[2].Buff_Length = LIDL
	Out_Item_List[2].Item_Code = MAIL$_MESSAGE_CURRENT_ID
	Out_Item_List[2].Buffer_Addr = %ADDR(MESSAGE_ID)
	Out_Item_List[2].Return_Length = Zero

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MESSAGE_GET (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (Status .EQ. MAIL$_NOMOREMSG) GOTO NO_MORE_MESSAGES
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	IF (.NOT. SUBJECT_LENGTH) GOTO BAD_SUBJECT_TEXT
	OUTPUT_FILE_SPEC = SUBJECT(1:SUBJECT_LENGTH)
	OUTPUT_FILE_SPEC(SUBJECT_LENGTH+1:6) = '.TXT;1'
	ONERROR OPEN_ERROR
	OPEN (TEXT_CHANNEL,O:S,OUTPUT_FILE_SPEC)
	OFFERROR

	.subtitle	'Get Next Line of Message and Extract to TEXT File'
NEXT_LINE_OF_MESSAGE,

	CALL CLEAR_ITEM_LISTS

	CLEAR TEXT

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = LIDL
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_CONTINUE
	In_Item_List[2].Buffer_Addr = Zero
	In_Item_List[2].Return_Length = Zero

	Out_Item_List[1].Buff_Length = %SIZE(TEXT)
	Out_Item_List[1].Item_Code = MAIL$_MESSAGE_RECORD
	Out_Item_List[1].Buffer_Addr = %ADDR(TEXT)
	Out_Item_List[1].Return_Length = %ADDR(TEXT_LENGTH)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MESSAGE_GET (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (Status .EQ. MAIL$_NOMOREREC) GOTO END_OF_TEXT_EXTRACT
	IF ((.NOT.TEXT_LENGTH) .OR. TEXT .EQ. BLANK_LINE) GOTO NEXT_MESSAGE

	IF (TEXT_LENGTH) THEN WRITES (TEXT_CHANNEL,TEXT(1:TEXT_LENGTH))
	ELSE WRITES (TEXT_CHANNEL,'')
	IF (Status .EQ. MAIL$_MSGTEXT) GOTO NEXT_LINE_OF_MESSAGE
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))
	.subtitle	'End of Text Extract'
END_OF_TEXT_EXTRACT,
	CALL MOVE_TO_DAILY_FOLDER
	CLOSE TEXT_CHANNEL
	GOTO NEXT_MESSAGE
	.subtitle	'Reset New Mail Count'
NO_MORE_MESSAGES,

	CLEAR NEWMAIL_COUNTER
	CALL SET_NEWMAIL_COUNTER

	CALL COMPRESS

NO_MESSAGES,

	CALL CLEANUP
	CLOSE TEXT_CHANNEL		;Just in case....

END_OF_JOB,

	STOP
	.subtitle	'Clear Item List Arrays'
CLEAR_ITEM_LISTS,

	CLEAR Counter

	FOR Counter FROM 1 THRU 5

	BEGIN
		CLEAR In_Item_list[Counter].Buff_Length
		CLEAR In_Item_List[Counter].Item_Code
		CLEAR In_Item_List[Counter].Buffer_Addr
		CLEAR In_Item_List[Counter].Return_Length

		CLEAR Out_Item_list[Counter].Buff_Length
		CLEAR Out_Item_List[Counter].Item_Code
		CLEAR Out_Item_List[Counter].Buffer_Addr
		CLEAR Out_Item_List[Counter].Return_Length
	END

	RETURN
	.subtitle	'Move Message from NEWMAIL to DAILY Folder'
MOVE_TO_DAILY_FOLDER,

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = LIDL
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_ID
	In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE_ID)
	In_Item_List[2].Return_Length = Zero

	In_Item_List[3].Buff_Length = LIDL
	In_Item_List[3].Item_Code = MAIL$_MESSAGE_FOLDER_ACTION
	In_Item_List[3].Buffer_Addr = USER_ACTION
	In_Item_List[3].Return_Length = Zero

	In_Item_List[4].Buff_Length = DAILY_FOLDER_LEN
	In_Item_List[4].Item_Code = MAIL$_MESSAGE_FOLDER
	In_Item_List[4].Buffer_Addr = %ADDR(DAILY_FOLDER(1:DAILY_FOLDER_LEN))
	In_Item_List[4].Return_Length = Zero

	In_Item_List[5].Buff_Length = LIDL
	In_Item_List[5].Item_Code = MAIL$_MESSAGE_DELETE
	In_Item_List[5].Buffer_Addr = Zero
	In_Item_List[5].Return_Length = Zero

	Out_Item_List[1].Buff_Length = LIDL
	Out_Item_List[1].Item_Code = MAIL$_MESSAGE_FOLDER_CREATED
	Out_Item_List[1].Buffer_Addr = %ADDR(FOLDER_CREATED)
	Out_Item_List[1].Return_Length = %ADDR(FOLDER_CREATED_LENGTH)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MESSAGE_COPY (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	RETURN
	.subtitle	'Set NEWMAIL message counter'
SET_NEWMAIL_COUNTER,

	IF (NEWMAIL_COUNTER .LT. 0) CLEAR NEWMAIL_COUNTER

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = CU_LENGTH
	In_Item_List[2].Item_Code = MAIL$_USER_USERNAME
	In_Item_List[2].Buffer_Addr = %ADDR(CURRENT_USERNAME(1:CU_LENGTH))
	In_Item_List[2].Return_Length = Zero

	In_Item_List[3].Buff_Length = WIDL
	In_Item_List[3].Item_Code = MAIL$_USER_SET_NEW_MESSAGES
	In_Item_List[3].Buffer_Addr = %ADDR(NEWMAIL_COUNTER)
	In_Item_List[3].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$USER_SET_INFO (%REF(User_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	RETURN
	.subtitle	'Compress Mail File'
COMPRESS,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = %SIZE(MAIL_DIRECTORY)
	In_Item_List[1].Item_Code = MAIL$_MAILFILE_DEFAULT_NAME
	In_Item_List[1].Buffer_Addr = %ADDR(MAIL_DIRECTORY)
	In_Item_List[1].Return_Length = Zero

	Out_Item_List[1].Buff_Length = %SIZE(NEW_MAIL_FILE)
	Out_Item_List[1].Item_Code = MAIL$_MAILFILE_RESULTSPEC
	Out_Item_List[1].Buffer_Addr = %ADDR(NEW_MAIL_FILE)
	Out_Item_List[1].Return_Length = %ADDR(NEW_MAIL_FILE_LENGTH)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MAILFILE_COMPRESS (%REF(Mail_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	RETURN
	.subtitle	'Clean Up and Exit'
CLEANUP,

	Status = %MAIL$USER_END (%REF(User_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$MESSAGE_END (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$MAILFILE_END (%REF(Mail_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_End_Of_List = Zero

	Status = %MAIL$MAILFILE_CLOSE (%REF(Mail_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	RETURN
	.subtitle	'Translate Daily Folder Name'
TRANSLATE_DAILY_FOLDER_NAME,

	Current_Day = %WKDAY
	DAILY_FOLDER = DAYS[Current_Day]
	DAILY_FOLDER_LEN = DAYS_LEN[Current_Day]
	RETURN
	.subtitle	'Translate Current Date'
TRANSLATE_CURRENT_DATE,

	Cur_Date = %DATE
	Current_Date(1,2) = Cur_Date(10,11)
	Current_Date(5,6) = Cur_Date(1,2)

TRANSLATE_MONTH,

	FOR Counter FROM 1 THRU 12
	BEGIN
	IF (Cur_Date(4,6) .EQ. Months[Counter]) EXITLOOP
	END
	Current_Date(3,4) = Counter

	RETURN
	.subtitle	'Translate Logical Names'
TRANSLATE_LOGICAL_NAMES,

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = %SIZE(MAILADD)
	In_Item_List[1].Item_Code = LNM$_STRING
	In_Item_List[1].Buffer_Addr = %ADDR(MAILADD)
	In_Item_List[1].Return_Length = 0

	In_End_Of_List = 0

	Status = %SYS$TRNLNM(,LOG_NAM_TAB_TO_SEARCH,ADDRESS,,%REF(In_Item_List))
	IF (.NOT.%SUCCESS(STATUS)) NO_ADDRESS = 1

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = %SIZE(THIS_NODE)
	In_Item_List[1].Item_Code = LNM$_STRING
	In_Item_List[1].Buffer_Addr = %ADDR(THIS_NODE)
	In_Item_List[1].Return_Length = 0

	In_End_Of_List = 0

	Status = %SYS$TRNLNM(,LOG_NAM_TAB_TO_SEARCH,NODE_NAME,,%REF(In_Item_List))
	IF (.NOT.%SUCCESS(STATUS)) NO_NODE_NAME = 1

	CALL CLEAR_ITEM_LISTS

	In_Item_List[1].Buff_Length = %SIZE(MAILSUB)
	In_Item_List[1].Item_Code = LNM$_STRING
	In_Item_List[1].Buffer_Addr = %ADDR(MAILSUB)
	In_Item_List[1].Return_Length = 0

	In_End_Of_List = 0

	Status = %SYS$TRNLNM(,LOG_NAM_TAB_TO_SEARCH,TEXT_ERROR,,%REF(In_Item_List))
	IF (.NOT.%SUCCESS(STATUS)) NO_SUBJECT = 1

	RETURN
	.subtitle	'Move Message from NEWMAIL to ERRORS Folder'
MOVE_TO_ERROR_FOLDER,

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = LIDL
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_ID
	In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE_ID)
	In_Item_List[2].Return_Length = Zero

	In_Item_List[3].Buff_Length = LIDL
	In_Item_List[3].Item_Code = MAIL$_MESSAGE_FOLDER_ACTION
	In_Item_List[3].Buffer_Addr = USER_ACTION
	In_Item_List[3].Return_Length = Zero

	In_Item_List[4].Buff_Length = %SIZE(ERROR_FOLDER)
	In_Item_List[4].Item_Code = MAIL$_MESSAGE_FOLDER
	In_Item_List[4].Buffer_Addr = %ADDR(ERROR_FOLDER)
	In_Item_List[4].Return_Length = Zero

	In_Item_List[5].Buff_Length = LIDL
	In_Item_List[5].Item_Code = MAIL$_MESSAGE_DELETE
	In_Item_List[5].Buffer_Addr = Zero
	In_Item_List[5].Return_Length = Zero

	Out_Item_List[1].Buff_Length = LIDL
	Out_Item_List[1].Item_Code = MAIL$_MESSAGE_FOLDER_CREATED
	Out_Item_List[1].Buffer_Addr = %ADDR(FOLDER_CREATED)
	Out_Item_List[1].Return_Length = %ADDR(FOLDER_CREATED_LENGTH)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MESSAGE_COPY (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	RETURN
	.subtitle	'Move Message from current folder to WATSEBASKET Folder'
MOVE_TO_WASTEBASKET_FOLDER,

	In_Item_List[1].Buff_Length = Zero
	In_Item_List[1].Item_Code = MAIL$_NOSIGNAL
	In_Item_List[1].Buffer_Addr = Zero
	In_Item_List[1].Return_Length = Zero

	In_Item_List[2].Buff_Length = LIDL
	In_Item_List[2].Item_Code = MAIL$_MESSAGE_ID
	In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE_ID)
	In_Item_List[2].Return_Length = Zero

	In_Item_List[3].Buff_Length = LIDL
	In_Item_List[3].Item_Code = MAIL$_MESSAGE_FOLDER_ACTION
	In_Item_List[3].Buffer_Addr = USER_ACTION
	In_Item_List[3].Return_Length = Zero

	In_Item_List[4].Buff_Length = %SIZE(WASTEBASKET_FOLDER)
	In_Item_List[4].Item_Code = MAIL$_MESSAGE_FOLDER
	In_Item_List[4].Buffer_Addr = %ADDR(WASTEBASKET_FOLDER)
	In_Item_List[4].Return_Length = Zero

	In_Item_List[5].Buff_Length = LIDL
	In_Item_List[5].Item_Code = MAIL$_MESSAGE_DELETE
	In_Item_List[5].Buffer_Addr = Zero
	In_Item_List[5].Return_Length = Zero

	Out_Item_List[1].Buff_Length = LIDL
	Out_Item_List[1].Item_Code = MAIL$_MESSAGE_FOLDER_CREATED
	Out_Item_List[1].Buffer_Addr = %ADDR(FOLDER_CREATED)
	Out_Item_List[1].Return_Length = %ADDR(FOLDER_CREATED_LENGTH)

	In_End_Of_List = Zero
	Out_End_Of_List = Zero

	Status = %MAIL$MESSAGE_COPY (%REF(Mess_Context)
&				,%REF(In_Item_list)
&				,%REF(Out_Item_List))
	IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status))

	RETURN
	.subtitle	'File Open Error'
OPEN_ERROR,

	OFFERROR
	Error = %ERROR
	; Possibilities
	;
	;	17 $ERR_FILSPC - Illegal Characters in File Specification
	;
	;	22 $ERR_IOFAIL - Hardware problem.
	;
	;	24 $ERR_NOSPAC - No space for file
	;
	;	32 $ERR_REPLAC - Already Exists
	;
	CALL CLEAR_ITEM_LISTS

	CALL MOVE_TO_ERROR_FOLDER
	;Decide on content of message to be sent to system manager.
	;and send it.

	IF (NO_ADDRESS) GOTO NEXT_MESSAGE
	MAILADD = ADDRESS
	IF (NO_SUBJECT)
	BEGIN
		TEXT_ERROR = "No TEXT_ERROR logical at node "
		TEXT_ERROR(31:15) = NODE_NAME
	END
	MAILSUB = TEXT_ERROR
	CLEAR MAILMSG
	MAILMSG = 'Error # ??? creating output file for this message -> '
	MAILMSG(54:80) = SUBJECT
	MAILMSG(9:3) = ERROR, 'XXX'
	XCALL SMAIL (MAILADD,MAILSUB,MAILMSG)

	GOTO NEXT_MESSAGE
	.subtitle	'Bad Subject Text'
BAD_SUBJECT_TEXT,

	Error = 99	;This is actually reserved by VAX Dibol,
			;however, we will use to flag error field.

	CALL CLEAR_ITEM_LISTS

	CALL MOVE_TO_ERROR_FOLDER
	;Decide on content of message to be sent to system manager.
	;and send it.

	IF (NO_ADDRESS) GOTO NEXT_MESSAGE
	MAILADD = ADDRESS
	IF (NO_SUBJECT)
	BEGIN
		TEXT_ERROR = "No TEXT_ERROR logical at node "
		TEXT_ERROR(31:15) = NODE_NAME
	END
	MAILSUB = TEXT_ERROR
	CLEAR MAILMSG
	MAILMSG = 'Error in structure of subject field for this message -> '
	MAILMSG(57:80) = SUBJECT
	XCALL SMAIL (MAILADD,MAILSUB,MAILMSG)

	GOTO NEXT_MESSAGE