OpenVMS Source Code Demos

BASIC_QIO_DEMO.BAS

1000	%title	"BASIC-qio-demo_xxx.bas"					!
	%ident                              "101.1"				! <<<---+---
	declare string constant	k_version = "101.1"			,	! <<<---+					&
				k_program = "BASIC-qio-demo"			!
	!=========================================================================================================================
	! Title  : BASIC-QIO-demo_xxx.bas
	! Author : Neil Rieck
	! Created: 2003.11.23
	! Purpose: To demo qio calls to an async port (this one dials a telephone pager service)
	!=========================================================================================================================
	! History:
	! -------
	! Ver Who When   What
	! --- --- ------ ---------------------------------------------------------------------------------------------------------
	! 100 NSR 031123 1. Original code
	! 101 NSR 110423 1. mini-cleanup prior to republishing to public domain
	!=========================================================================================================================
	option type=explicit							! no kid stuff
	set no prompt								! no "?" at prompts
	!
	%include "[.inc]VMS_STRUCTURES.INC"					! records for system calls, etc.
	%include "starlet"      %from %library "sys$library:basic$starlet"	! system services
	%include "$ssdef"       %from %library "sys$library:basic$starlet"	! ss$
	%include "$iodef"       %from %library "sys$library:basic$starlet"	! io$
	%include "$lnmdef"      %from %library "sys$library:basic$starlet"	! lnm$
	%include "lib$routines" %from %library "sys$library:basic$starlet"	! lib$
	%include "$libdef"      %from %library "sys$library:basic$starlet"	! lib$_normal
	!
	!	<<< home brewed functions >>>
	!
        external string function wcsm_dt_stamp()				! see end of this program
        external string function wcsm_trnlnm(string,string)			! see end of this program
        external long   function wcsm_submit_to_batch(string,string,string,	&
		string,string,string,string,string,string,string,string,string)
	!
	!	<<< constant declarations (non-system service) >>>
	!
	declare string constant	CRLF	= '13'C + '10'C			,	!				&
				Ctrl_T	= '20'C				,	! control-t			&
				Ctrl_V	= '22'C					! control-v
	!
	declare string constant	STX	= '02'C				,	! set up control characters	&
				ETX	= '03'C 			,	!		     		&
				EOT	= '04'C 			,	!				&
				ACK	= '06'C 			,	!				&
				XON	= '17'C				,	! ctrl-Q			&
				CAN	= '30'C 			,	!				&
				NAK	= '21'C 			,	!				&
				ESC1	= '27'C					!
	!
	!	<<< variable declarations >>>
	!
	declare string xmit_count$(400%)					! keeps track of xmit messages
	declare string packet$(400%)						! up to 400 messagee can be sent at one time.
	declare string illegal_num$(400%)					! keeps track of illegal pager numbers
	declare long	junk%						,	!&
			applic_debug%					,	!&
			sleep%						,	!&
		string	dump_string$						!
	declare string	junk$						,	! whatever				&
			default_node$   				,	! 					&
			pag_port$					,	! port to use for paging		&
			logging$ 					,	! logging level				&
			choice$						,	! menu choice				&
                        current_dt$					,	!                              		&
                        date_total$					,	!                              		&
			rename_time$					,	! renames pager file to .old		&
			tel_num$					,	! hold local phone number		&
			ssmr_comm$					,	! hold long distance number		&
                        mail_filename$					,	!					&
                        mail_address$					,	!					&
			area_code$					,	! used by the mail pcs section		&
									 	!	for building pcs mail address	&
		long	pass_count%					,	! which number to call			&
			file_open81%					,	! is pager_101.dat open 		&
			illegal%					,	! keeps track of illegal pager #	&
			xmit_ok%					,	! number xmitt messages			&
			page_num%					,	! which number to call			&
			ats10%						,	! abandoning pag line error		&
			notify_staff%					,	! alarm server notify			&
			test_page%					,	! test message sent			&
			temp%						,	! checks to see if message numeric 	&
			sleeper%					,	! heart beat				&
			watchdog%					,	! counts watchdog			&
			message_count%					,	! send another message			&
			total_message%					,	! count total number of messages	&
			error_handler%					,	! incase of erorr			&
			sleep_count%					,	! keep modem wake			&
			sleep_set%					,	! keep modem wake			&
			restart_count%					,	! restart counter			&
			char_count					,	!					&
			timeout_count					,	! time out count			&
			polling_count					,	!					&
			timeout_flag					,	! 1=true				&
			comm_error					,	!					&
			alloc_flag					,	! 1=true				&
			event_flag_recv					,	! event flags	read			&
			event_flag_xmit					,	!		write			&
		word	funct_bits_rtp					,	! funct bits - read timed purge	&
		word	funct_bits_rtnp					,	!		read timed no purge	&
		word	funct_bits_recv					,	! funct bits - read			&
		word	funct_bits_xmit					,	! funct bits - write			&
		string	async_port$					,	! (change state)			&
			my_file$					,	!					&
			xmit_data					,	!					&
			recv_data						!
	!
	declare string	line1$		,&
			line2$		,&
			packet$		,&
			checksum$	,&
		long	i%		,&
			checksum%	,&
			char1%		,&
			char2%		,&
			char3%
        declare rfa	rfa_8x               					! record file address
	!
	!	<<< program constants >>>
	!
	declare long constant	k_buf_siz	=  132%				! for qio recv + qio xmit
	declare string constant	k_num_list	= "0123456789"
	!
	!	<<< device specific stuff >>>
	!
	map(neil)												&
	    string	dev_buf_xmit	= k_buf_siz			,	! xmit data buffer	- xmit	&
	    string	dev_buf_Recv	= k_buf_siz			,	! recv data buffer	- recv	&
	    word	dev_ch_xmit,						! xmit channel number	- xmit	&
			dev_ch_recv,						! recv channel number	- recv	&
	    IosbRec	iosb_xmit,						! i/o status block	- xmit	&
			iosb_recv						! i/o status block	- recv
	!
	declare	long	rc%						,	! return code			&
			sys_line						! line number
	!
	!	set up terminator descriptor block for qio_read
	!
	declare TDB_Rec TDB_Var							! create terminator descriptor block for qio_read
	!
	!	fill in the descriptor block's fields
	!	note: see	"OpenVMS_7.2-1 I/O User's Reference Manual"
	!	 		"5.4.1.2 Read Function Terminators"
	!
	TDB_Var::mask_type	= 0%						! we only want the "short form" of this call
	TDB_Var::mask		= 2%^13%					! <CR> is the only terminator we wish to use
	!
	!=======================================================================
	! Title: PAGERDB_101.REC
	!=======================================================================
	declare string constant pagerdb_fs$     = "csmis$dat:pagerdb_101.dat"
	!=======================================================================
	! Map used in the pager program
	!
	!	key-0	,primary key    (d81_recv_date,d81_recv_time)   duplicates descending
	!	key-1	,alternate key  d81_pager                       duplicates
	!	key-2	,alternate key  d81_status                      duplicates changes
	!	key-3	,alternate key  d81_last_name                   duplicates changes
	!=======================================================================
	map (my_disk81)								&
	    string	d81_whole_record= 170,	!			170	&
			d81_align	=   0	! force alignment check
	map (my_disk81)								&
	    string	d81_whole_data	= 161,	!			161	&
			filler81$	=   9,	! room to grow ...	170	&
			d81_align	=   0	! force alignment check
	map (my_disk81)								&
		string	d81_last_name	=  20,	! last name of pagee	 20	&
			d81_pager	=   8,	! 			 28	&
			d81_pager_type	=   1,	! P=pcs 		 29	&
			d81_message_buf	=  96,	! message lines 1-5	125	&
			d81_recv_date	=   8,	! ccyymmdd 		133	&
			d81_recv_time	=   6,	! hhmmss		139	&
			d81_xmit_date	=   8,	! ccyymmdd		147	&
			d81_xmit_time	=   6,	! hhmmss		153	&
			d81_status	=   1,	! page sent Y/N		154	&
			d81_pin		=   7,	! pin number		161	&
			filler81$	=   9,	! room to grow ...		&
			d81_align	=   0	! force alignment check
	map (my_disk81)								&
		string	d81_last_name	=  20,	! last name of pagee	20	&
			d81_pager	=   8,	! 			28	&
			d81_pager_type	=   1,	! 			29	&
			d81_message1	=  16,	! message line #1	45	&
	    		d81_message2	=  20,	!		2	65	&
			d81_message3	=  20,	!		3	85	&
	    		d81_message4	=  20,	!		4	105	&
	    		d81_message5	=  20,	!		5	125	&
			d81_recv_date	=   8,	! ccyymmdd 		133	&
			d81_recv_time	=   6,	! hhmmss		139	&
			d81_xmit_date	=   8,	! ccyymmdd		147	&
			d81_xmit_time	=   6,	! hhmmss		153	&
			d81_status	=   1,	! page sent Y/N		154	&
			d81_pin		=   7,	! pin number		161	&
			filler81$	=   9,	! room to grow ...		&
			d81_align	=   0	! force alignment check
	!
	!=======================================================================
	!	Initialize
	!=======================================================================
1300	on error goto error_trap						! get rid of this (when-error blocks are better)
	!
	!	<<< set up function bits for QIO >>>
	!
	!	Read, Timed, w/Purge
	!
	funct_bits_rtp =	(IO$_READVBLK	or			&
				 IO$M_DSABLMBX	or			&
				 IO$M_Purge	or			&
				 IO$M_NoFILTR	or			&
				 IO$M_Timed	or			&
				 IO$M_NOECHO)
	!
	!	Read, Timed, No Purge
	!
	funct_bits_rtnp =	(IO$_READVBLK	or			&
				 IO$M_DSABLMBX	or			&
				 IO$M_NoFILTR	or			&
				 IO$M_Timed	or			&
				 IO$M_NOECHO)
	!
	!	Write (unformatted)
	!
	funct_bits_xmit =	(IO$_WRITEVBLK	or			&
				 IO$M_CanCtrlO	or			&
				 IO$M_NoFormat)
	!
	!=======================================================================
	!	Main
	!=======================================================================
1500	main:									!
	margin #0, 132								! limit wrapping of the log file
	print k_program +"_"+ k_version
	print string$(len(k_program +"_"+ k_version), asc("="))                 ! underline previous line
	applic_debug%	= 999							! start debugging with a high value
	!
	!	/// get desired async port ///
	!
	!	LIB$GET_LOGICAL logical-name [,resultant-string] [,resultant-length] [,table-name]
	!
        rc% = lib$get_logical("DEMO$ASYNC_PORT", async_port$,,"LNM$PROCESS")
	if ((rc% and 7%) <> 1%) then
		print "-e- error: "+ str$(rc%) +" while reading logical DEMO$ASYNC_PORT"
		goto fini							! adios
	end if
	print "-i- using async port: ";async_port$
	!
	!	/// get desired phone number ///
	!
        rc% = lib$get_logical("DEMO$TELEPHONE", tel_num$,,"LNM$PROCESS")
	if ((rc% and 7%) <> 1%) then
		print "-e- error: "+ str$(rc%) +" while reading logical DEMO$TELEPHONE"
		goto fini							! adios
	end if
	print "-i- using telephone number: ";tel_num$
	!
	!	<<< try to allocate the device >>>
	!
1510	allocate_port:
	rc% = sys$alloc( async_port$,,,,)
	!
	select rc%
	    case ss$_normal
	    alloc_flag = 1%
	    print "-i- Allocated Device: ";async_port$
	case else
	    print "-e- Can't allocate device: ";async_port$
	    sys_line = 2100%
	    goto sys_error
	end select
	!
	!	<<< open a read channel >>>
	!
1520	rc% = sys$assign( async_port$, dev_ch_recv,,)
	if rc% <> ss$_normal then
	    sys_line = 2200%
	    goto sys_error
	end if
	print "-i- using channel(r): ";dev_ch_recv
	!
	!	<<< open a write channel >>>
	!
1530	rc% = sys$assign( async_port$, dev_ch_xmit,,)
	if rc% <> ss$_normal then
	    sys_line = 2200%
	    goto sys_error
	end if
	print "-i- using channel(x): ";dev_ch_xmit
	!
	!	<<< get an event flag for recv >>>
	!
1540	rc% = lib$get_EF(event_flag_recv	by ref)
	if rc% <> ss$_normal then
	    sys_line = 2300%
	    goto sys_error
	end if
	print "-i- using EF(r): ";event_flag_recv
	!
	!	<<< get an event flag for xmit >>>
	!
1550	rc% = lib$get_EF(event_flag_xmit	by ref)
	if rc% <> ss$_normal then
	    sys_line = 2400%
	    goto sys_error
	end if
	print "-i- using EF(x): ";event_flag_xmit
	!
	sleep 1
	print "-i- doing 1st read with purge "
	gosub	qio_recvp							! recv with purge (good for 1st time)
	!
	!	<<< initialize the modem >>>
	!
	modem_init:
	!
	!	set up modem option R1 (reset?)
	!
	ATR1:
	sleep 1%
	print "-i- Sending AT&R1"						! setting CTS
	xmit_data = "AT&R1" + CR						! send AT&R1 to modem
	gosub	qio_xmit							! transmit section
	!
	polling_count = 0							!
	while 1									!
	    gosub	qio_recv						! recv
	    if edit$(recv_data,32+4+2) <> "" then				!
	       print "-i- Dat-00>";recv_data;"<"				!
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; initing modem (modem cleanup 1)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay 2 more second2
		goto modem_init							!
	    end if
	    goto ATC0 	if mid$(recv_data,1%,3%) = "OK"				!
	    polling_count = polling_count + 1%
	    if polling_count > 10% then						! > 10 clean up modem
		print "-i- waited in loop 10 times (modem cleanup 1)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay 2 more second2
		goto modem_init							! try this again
	    end if
	next
	!
	!	set up modem option C0
	!
	atc0:
	sleep 1%
	!
	!	set up modem option C1
	!
	print "-i- Sending AT&C1"						! setting DCD
	xmit_data = "AT&C0" + CR						! send AT&C0 to modem
	gosub	qio_xmit							! transmit section
	!
	polling_count = 0							!
	while 1									! will wait in this loop
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				! print rec data if >
	       print "-i- Dat-01>";recv_data;"<"				! nothing
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; initing modem (modem cleanup 2)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay 2 more second2
		goto modem_init							!
	    end if
	    goto ATD0 	if mid$(recv_data,1%,3%) = "OK"				! checking rec data
	    polling_count = polling_count + 1%
	    if polling_count > 10% then						! > 10 clean up modem
		print "-i- waited in loop 10 times (modem cleanup 2)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay another 2 seconds
		goto modem_init							! try this again
	    end if								!
	next									!
	!
	!	set up modem option D0
	!
	ATD0:
	!
	!	set up modem option W
	!
	ATW:
	print "-i- Sending AT&W"						! send to memory
	sleep 1%
	xmit_data = "AT&W" + CR 						! send AT&W to modem
	gosub	qio_xmit							! transmit section
	!
	polling_count = 0							!
	while 1									! will wait in this loop
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				! print rec data if >
	       print "-i- Dat-02>";recv_data;"<"				!
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; initing modem (modem cleanup 3)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay 2 more second2
		goto modem_init							!
	    end if
	    goto modem_set if mid$(recv_data,1%,3%) = "OK"			! checking rec data
	    polling_count = polling_count + 1%
	    if polling_count > 10% then						! > 10 clean up modem
		print "-i- waited in loop 10 times (modem cleanup 3)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay another 2 seconds
		goto modem_init							! try this again
	    end if
	next
	modem_set:
	!
	!
	print "-i- ========== modem initialized; entering main while/next block =========="
	pass_count% = 1%							! init (prep for 1st pass thru)
	!
    !====================================================================================================
    !	<<< stay in this loop forever >>>
    !
    !	note: no code should reference applic_debug% prior to this point
    !	(but modem initialization does so debugging is always enabled before this point)
    !====================================================================================================
    !
    while 1									! This program will run every xx seconds.
	!
	!	support for logging/tracing
	!
	!	LIB$GET_LOGICAL logical-name [,resultant-string] [,resultant-length] [,table-name]
	!
        rc% = lib$get_logical("CSMIS$APPL_PAG_SERVER_LOG", logging$,,"LNM$SYSTEM_TABLE")
	logging$ = ""
	if ((rc% and 7%) <> 1%) then
		logging$ = ""
	else
		logging$ = edit$(logging$,32+2)					!
		logging$ = "2" if left$(logging$,1) = "Y"			! eg. Y/es -> 2
	end if
	when error in
	    junk% = integer(logging$)
	use
	    junk% = 0
	end when
	if applic_debug% <> junk% then
	    applic_debug% = junk%
	    print "-i- switching to debug mode: ";applic_debug%
	end if
	!
	!	<<< start >>>
	!
        line1$ = ""								!
        line2$ = ""								!
	total_message% = 0%							!
	message_count% = 0%							!
	page_num% = 0% 								! clear pager_num
	gosub pager_packet							! get pager number and messages
	!
	if applic_debug% > 0 then						!
	    if total_message% > 0% then						!
		print "-i- The total number of messages = ";			!
		print total_message%						!
	    end if								!
	end if									!
	goto no_data if total_message% = 0%					! no messages to send
	!
	restart_count% = 0%							! clear counter
	!=======================================================================
	!	<<< Restart modem >>>
	!=======================================================================
1560	restart:
	restart_count% = restart_count% + 1%					!
	xmit_data = XON								! send XON to port
	gosub   qio_xmit							!
	sleep 1									! kill some time
	!
	gosub	qio_recvp							! clean up the incoming buffer
	print "-i- Sending ATH0 (going-on-hook)" if applic_debug% > 0		! making sure modem is on hook
	xmit_data = "ATH0" + CR							! send ATH0 to modem
	gosub	qio_xmit							! transmit section
	!
	polling_count = 0							! clear polling counter
	while 1									!
	    gosub	qio_recv						! recv (waits for '<cr>' or '2 second timeout')
	    if edit$(recv_data,32+4+2) <> "" then				! any data?
		 print "-i- Dat-03>";recv_data;"<"
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; restarting (modem cleanup 4)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay 2 more second2
		goto restart							!
	    end if
	    goto ATH0 	if mid$(recv_data,1%,3%) = "OK"				! jump if we got an OK
	    polling_count = polling_count + 1					!
	    if polling_count > 10 then 						! > 10 clean up modem
		print "-i- waited in loop 10 times (modem cleanup 4)"		!
		print "-i- Sending '+++' to wake up the modem port"		!
		sleep 2								! delay 2 seconds
		xmit_data = "+++"						! send escape sequence to modem
		gosub	qio_xmit						! send escape sequence to modem
		sleep 2								! delay another 2 seconds
		goto restart							! try this again
	    end if								!
	next
	!
	!	modem is now on-hook
	!
	ATH0:
	sleep 2%								! let modem settle down
	print "-i- Sending AT (attention)"	if applic_debug% > 0		! displays next command
	xmit_data = "AT" + cr							! send AT to modem
	gosub	qio_xmit							! transmit section
	!
	timeout_count = 0%							! clears counter
	while 1									! wait for response
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				! print rec data if > nothing
		print "-i- Dat-04>";recv_data;"<"	if applic_debug% > 0
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; restarting"				!
		goto restart							!
	    end if
	    goto AT_OK	if mid$(recv_data,1%,3%) = "OK"				! check for ok
	    if timeout_flag=1% then						! timeout flag set
		timeout_count = timeout_count + 1%
		if timeout_count > 20% then					! 20 tries
		   print "-i- waited 20 times; restarting"
		   goto restart
		end if
	    end if
	next
	at_ok:
	!
	!	Send the phone number of other modem
	!
	! If page_num% is set to 0% the local Bell Mobility number will be used. If it is set to a 1%,
	! then the program tries to dump the messages to the Bell Mobility data base in Toronto.
	!
	xmit_data = "ATDT" + tel_num$ + cr					! prep to dial the telephone
	sleep 2%
	gosub	qio_xmit							! transmit  number to modem
	!
	timeout_count = 0%
	while 1									! wait for rec data
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then
		print "-i- Dat-05>";recv_data;"<"	if applic_debug% > 0
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; restarting"				!
		goto restart							!
	    end if
	    goto restart	if mid$(recv_data,1%,2%) = "OK"
	    goto restart	if mid$(recv_data,1%,4%) = "BUSY"
	    goto connected	if mid$(recv_data,1%,4%) = "CONN"
!~~~	    goto restart	if mid$(recv_data,2%,1%) = "N"			x ???
!~~~	    goto restart	if mid$(recv_data,1%,1%) = "N"			x ???
	    goto restart	if mid$(recv_data,1%,10) = "NO CARRIER"		!
	    goto restart	if mid$(recv_data,1%,13) = "NO CONNECTION"	!
	    if mid$(recv_data,1%,05%) = "ATS10" then
		ats10% = 1%
	        goto reset_3plus
	    end if
	    timeout_count = timeout_count + 1%
	    goto restart	if timeout_count > 20%
	next
	!
	!	Connected to other modem
	!
	connected:
	!
	print "-i- Msg> Connected to pager company #"; pass_count%	if applic_debug% > 0
	timeout_count = 0%
	!
	!
	!------------------------------------------------------------------------------------------------------------------------
	! bf_122 Notes: (980316)
	! ======================
	! when we moved this application from the uVAX-4300 to the VAX-6420, this section of code stopped working. We had to add
	! an extra call to qio_recv which eats the echoed <cr> which we just sent. Then we call qio_recv to test for the "ID="
	! prompt from the other end.
	!
	! Note: We believe this echo stuff started to happen when Bell Mobility added a mux between their modems and their paging
	! computer. At that same time they required that a <cr> be periodically sent to hold up the line when their computer is
	! slow to respond (I guess the mux can actually drop an idle line)
	!------------------------------------------------------------------------------------------------------------------------
	while 1									! wait for rec data
	    sleep 2%								! let modem settle down
	    xmit_data =  cr							!
	    gosub	qio_xmit						! send <cr> to modem
	    timeout_count = 0							!
	    gosub	qio_recv						! recv "echoed <cr>" or "ID="
	    if edit$(recv_data,32+4+2) = "" then				! if just an echoed <cr>...
		gosub	qio_recv						! then wait for "ID="
	    end if								!
	    if edit$(recv_data,32+4+2) <> "" then
		print "-i- Dat-06>";recv_data;"<"	if applic_debug% > 0
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; restarting"				!
		goto restart							!
	    end if
	    goto ID		if mid$(recv_data,1%,2%) = "ID"			! this is what we want so jump to next section
	    goto ID		if mid$(recv_data,1%,2%) = "TDD"		! Quebec response ?
!~~~	    goto restart	if mid$(recv_data,2%,1%) = "N"			x
	    if mid$(recv_data,1%,05%) = "ATS10" then
		ats10% = 1%
	        goto reset_3plus
	    end if
	    goto restart	if mid$(recv_data,1%,10) = "NO CARRIER"		!
	    goto restart	if mid$(recv_data,1%,13) = "NO CONNECTION"	!
	    print " timeout_count = " + str$(timeout_count)			! added line to monitor missing pages
	    timeout_count = timeout_count + 1%					!
	    if timeout_count > 60% then						!
		notify_staff% = notify_staff% + 1%				!
		if notify_staff% > 10% then					! if not send after 10 minute notify admin/CTL
		    PRINT "-i- Entered alarm section"				!
!~~~		    mail alarm message to system admin				x
		end if								!
	        goto at_cleanup 						!
	    end if								!
	next									!
	!
	!	We just received the 'ID=' prompt so send '<esc>PG1' to Bell Mobility
	!
	id:
	print "-i- Msg> Sending <esc>PG1 <<<---***"	if applic_debug% > 0
	if edit$( WCSM_TrnLnm( "CSMIS$PROV", "LNM$SYSTEM_TABLE" ),32+4+2) = "QUEBEC"
	then
	    xmit_data = ESC1 + "PG1Bell01" + cr					! starting pager dialog (Quebec)
	else
	    xmit_data = ESC1 + "PG1" + cr					! starting pager dialog (Ontario)
	end if
	gosub	qio_xmit							! transmit section
	!
	timeout_count = 0%
	while 1									! wait for rec data
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then
		print "-i- Dat-07>";recv_data;"<"	if applic_debug% > 0
	    end if
	    if comm_error=1 then						!
		print "-e- comm error; restarting"				!
		goto restart							!
	    end if
	    goto send_packet	if mid$(recv_data,1%,2%) = "[p"			! this is what we want...
!~~~	    goto restart	if mid$(recv_data,2%,1%) = "N"			x ???
!~~~	    goto restart	if mid$(recv_data,1%,1%) = "N"			x ???
	    goto restart	if mid$(recv_data,1%,10) = "NO CARRIER"		!
	    goto restart	if mid$(recv_data,1%,13) = "NO CONNECTION"	!
	    if mid$(recv_data,1%,05%) = "ATS10" then
		ats10% = 1%
	        goto reset_3plus
	    end if
	    timeout_count = timeout_count + 1%
	    goto restart 	if timeout_count > 20%
	next
	!
	send_packet:
	!
	if total_message% > 0% then						! if > 0 the program
	    message_count% = message_count% + 1%				! has a message to
	    goto send_dis if message_count% > total_message%			! deliver
	    print "-i- Sending message "; + message_count%	if applic_debug% > 0
	end if									! the screen
	!
	print "-i- Msg> Sending Packet"	if applic_debug% > 0
	xmit_data = packet$(message_count%)
	gosub	qio_xmit							! sending message
1580										! to Bell Molility
	timeout_count = 0%
	while 1
	    gosub	qio_recv						! check receiver
	    if applic_debug% > 0 then
		if pos( recv_data, NAK, 1%) > 0%
		then
		    print "-i- Dat-08>NAK< Len:";len(recv_data)
		else
		    print "-i- Dat-08>";recv_data;"< Len:";len(recv_data)
		    if len(recv_data) = 1% then
			print "-i- Dat-08>";ASC(recv_data);"< Len:";len(recv_data)
		    end if
		end if
	    end if								!
	    if comm_error=1 then						!
		print "-e- comm error; goto NAK"				!
		goto NAK							!
	    end if								!
	    !
	    ! Moved this piece of code down below the test for NAKs. This is to satisfy Quebec Bell Mobility
	    !
	    !if mid$(recv_data, 1%, 1%) = ACK then				x message ack'ed
	    !	xmit_ok% = message_count%					x keeps track of
	    !    goto send_packet						x number of messages
	    !end if								x sent
	    goto NAK	if pos( recv_data, NAK, 1%) > 0%			!
	    goto NAK	if mid$(recv_data,1%,1%)	= CAN			! added AGD 1996-03-14
	    goto NAK	if mid$(recv_data,1%,5%)	= "Illeg"		!
	    goto NAK	if mid$(recv_data,1%,5%)	= "Too S"		!
	    goto NAK	if mid$(recv_data,1%,10)	= "NO CARRIER"		!
	    goto NAK	if mid$(recv_data,1%,13)	= "NO CONNECTION"	!
	    !
	    if mid$(recv_data,1%,05%) = "ATS10" then				!
		ats10% = 1%							!
	        goto reset_3plus						!
	    end if								!
	    if mid$(recv_data, 1%, 1%) = ACK then				! message ack'ed
		    xmit_ok% = message_count%					! keeps track of
	            goto send_packet						! number of messages
	    end if								! sent
	    timeout_count = timeout_count + 1%					!
	    print "Waiting for ACK timeout_count = " + str$(timeout_count)	!
	    goto send_dis if timeout_count > 40%				!
	    iterate								!
	next									!
	!+
	!	Message was not OK
	!-
	NAK:
	print "-e- Something is wrong please try again later..."		!
	print "-i- Dat-09>";recv_data;"<"					!
	illegal% = illegal% + 1%						! keeps track of failed
	illegal_num$(illegal%) = str$(message_count%)				! messages
	xmit_ok% = message_count%						!
	goto ACK	if mid$(recv_data,1%,10) = "NO CARRIER"			!
	goto ACK	if mid$(recv_data,1%,13) = "NO CONNECTION"		!
	goto send_packet							!
	!
	!	Message was OK
	!
	ACK:
	send_dis:
	message_count% = 0%							!
	total_message% = 0% 							!
	print "-i- Msg> Sending disconnect"	if applic_debug% > 0		!
	xmit_data = EOT + cr							! backing away from Bell
	gosub	qio_xmit							! Mobility
	!
	timeout_count = 0%							!
	while 1									!
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				!
		print "-i- Dat-10>";recv_data;"<"	if applic_debug% > 0	!
	    end if								!
	    if comm_error=1 then						!					bf_130.1
		print "-e- comm error; goto reset_3plus"			!
		goto reset_3plus						!
	    end if								!
1590	    goto at_cleanup	if mid$(recv_data,1%,03%) = "+++"		!
	    goto at_cleanup	if mid$(recv_data,1%,10) = "NO CARRIER"		!
	    goto at_cleanup	if mid$(recv_data,1%,13) = "NO CONNECTION"	!
	    if mid$(recv_data,1%,05%) = "ATS10" then				!
		ats10% = 1%							!
	        goto reset_3plus						!
	    end if								!
	    timeout_count = timeout_count + 1%					!
	    goto reset_3plus if timeout_count > 20%				!
	next									!
	!
	!	send 3 plus signs to the modem (to get it out of data mode)
	!
	reset_3plus:								!
	sleep 2%								!
	print "-i- Sending +++ cleaning up modem port"	if applic_debug% > 0	!
	sleep 2									! produce a 2 second silent period
	xmit_data = "+++"							! send escape sequence to modem
	gosub	qio_xmit							!
	sleep 2									! produce a 2 second silent period
	!
	timeout_count = 0%							!
	while 1									!
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				!
		print "-i- Dat-11>";recv_data;"<"	if applic_debug% > 0	!
	    end if								!
	    !
	    !	we're probably in trouble so just ignore comm errors
	    !
	    if comm_error=1 then						!					bf_130.1
		comm_error=0							!
	    end if								!
	    !
!~~~	    goto at_cleanup	if mid$(recv_data,2%,1%)	= "N"		x ???					bf_128.7
!~~~	    goto at_cleanup	if mid$(recv_data,1%,1%)	= "N"		x ???					bf_128.7
	    goto at_cleanup	if mid$(recv_data,1%,10) = "NO CARRIER"		!
	    goto at_cleanup	if mid$(recv_data,1%,13) = "NO CONNECTION"	!
	    goto at_cleanup	if mid$(recv_data,1%,3%)	= "OK"		!
	    goto at_cleanup	if mid$(recv_data,1%,3%)	= "+++"		!
	    timeout_count = timeout_count + 1%					!
	    goto at_cleanup if timeout_count > 3%				!
	next									!
	!
	!	now send the ATTENTION command
	!
	at_cleanup:								!
	sleep 2%								!
	print "-i- Sending AT cleaning up modem port"	if applic_debug% > 0	!
	xmit_data = "AT" + cr							! send AT to modem
	gosub	qio_xmit							!
	!
	timeout_count = 0%							!
	while 1									!
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				!
		print "-i- Dat-12>";recv_data;"<"	if applic_debug% > 0	!
	    end if								!
	    if comm_error=1 then						!					bf_130.1
		print "-e- comm error; restarting"				!
		goto restart							!
	    end if								!
	    goto atz_cleanup	if mid$(recv_data,1%,3%) = "OK"			!
	    goto atz_cleanup	if mid$(recv_data,1%,10) = "NO CARRIER"		!
	    goto atz_cleanup	if mid$(recv_data,1%,13) = "NO CONNECTION"	!
	    if mid$(recv_data,1%,05%) = "ATS10" then				!
		ats10% = 1%							!
		print "-e- looping to reset_3plus"				!
	        goto reset_3plus						!
	    end if								!
	    timeout_count = timeout_count + 1%					!
	    goto atz_cleanup if timeout_count > 20%				!
	next									!
	!
1600	atz_cleanup:								!
	sleep 2%								!
	print "-i- Sending ATZ cleaning up modem port"	if applic_debug% > 0	!
	xmit_data = "ATZ" + cr							! send AT to modem
	gosub	qio_xmit							!
	!
	timeout_count = 0%							!
	while 1									!
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then				!
		print "-i- Dat-13>";recv_data;"<"	if applic_debug% > 0	!
	    end if								!
	    !
	    !	we're trying to get control so just ignore errors
	    !
	    if comm_error=1 then						!					bf_130.1
		comm_error=0							!
	    end if								!
	    goto ATH0_cleanup	if mid$(recv_data,1%,3%) = "OK"			!
	    if mid$(recv_data,1%,05%) = "ATS10" then				!
		ats10% = 1%							!
	        goto reset_3plus						!
	    end if								!
	    timeout_count = timeout_count + 1%					!
	    goto ath0_cleanup if timeout_count > 20%				!
	next									!
	!
	!	now go on hook
	!
	ATH0_cleanup:								!
	sleep 2%								!
	print "-i- Sending ATH0 (going on-hook) cleaning up modem port"	if applic_debug% > 0
	!
	xmit_data = "ATH0" + cr							! send ATH0 to modem
	gosub	qio_xmit							!
	!
	timeout_count = 0%							!
	while 1									!
	    gosub	qio_recv						! check receiver
	    if edit$(recv_data,32+4+2) <> "" then
		print "-i- Dat-14>";recv_data;"<"	if applic_debug% > 0
	    end if
	    !
	    !	we're trying tro regain control so ignore errors
	    !
	    if comm_error=1 then						!					bf_130.1
		comm_error=0							!
	    end if
	    goto pager_update	if mid$(recv_data,1%,3%) = "OK"
	    if mid$(recv_data,1%,05%) = "ATS10" then
		ats10% = 1%
	        goto reset_3plus
	    end if
		timeout_count = timeout_count + 1%
		goto pager_update if timeout_count > 20%
	next
	!
1700	pager_update:
	!
	! The following section is used to update the pagerdb_101.dat file.
	! The data file is updated with the time and date the pager was paged.
	! Also a status flag is set from "N" to "Y" to tell the program the message has been delivered.
	!
	goto no_data if  ats10% = 1%						! abandoning page update
	goto no_data if  test_page% = -99%					! test message sent
	gosub open_file81							! opening file
	notify_staff% = 0%

       	if file_open81% = 0%  then  						! file failed to open
	    print "-e- File pagerdb_101.dat didn't open"
	    goto fini								!
	end if
	illegal% = 1%
	!
	while (xmit_ok% > message_count%)					! stay in loop until  all messages are updated
	    message_count% = message_count% + 1%				!
	    when error in							!
		print "-i- message_count: ";xmit_count$(message_count%)	if applic_debug% > 0
		!
	        get #81,key#0 eq xmit_count$(message_count%),regardless		!
		error_handler% = 0%						! show that GET worked
		duplicate_rec_time:						! does another search if
		if d81_status = "Y" then					! duplicate rec time.
	            get #81%, regardless					!
		    goto duplicate_rec_time					!
		else								!
	            rfa_8x = getrfa(81%)					!
	            get #81%,rfa rfa_8x						! locks record number
		end if								!
		!
		!if d81_status = "Y" then
	        !    find #81%, regardless
	        !    rfa_8x = getrfa(81%)
	        !    get #81%,rfa rfa_8x              				x locks record number
		!else
	        !    get #81%,rfa rfa_8x					x locks record number
		!end if
		error_handler% = 0%						! show that FIND/GET worked
1900		!
		!  If the page passed, the following data is sent to the pagerdb_101.dat file
		!
		if str$(message_count%) <> illegal_num$(illegal%)		!
		then								!
                    current_dt$		= wcsm_dt_stamp      			!
                    d81_xmit_date	= left$(current_dt$,8)      		!
                    d81_xmit_time	= right$(current_dt$,9)      		!
	            d81_status		= "Y"					!
		else								!
		    illegal% = illegal% + 1					!
    		    d81_xmit_date = "PagerErr"					!
	            d81_status	=  "E"						!
		    !d81_message2 = "This is an invalid"			!
		    !d81_message3 = "pager number"				!
		end if								!
		update #81%							! update file
		error_handler% = 0%						! show that UPDATE worked
		xmit_count$(message_count%) = ""				! clear count
	    use
		error_handler% = err
		print "-e- error: "+ str$( error_handler% ) +" at line 1900" if error_handler% <> 11%
	    end when
	    !
	    goto no_data if error_handler% = 11%				! no more data
	    restore #81%,key# 0%						! go for another record
	next
	!
	no_data:
	mat illegal_num$ = nul$							! added to clear illegal page array
	xmit_ok% = 0%
	ats10% = 0%
	!
	close #81%								! close file
	!
	if pass_count% = 3% then						! if on last pass
	    !
	    !	run faster (sleep less) from 07:00 through 17:59
	    !
	    junk$ = wcsm_dt_stamp						! ccyymmddhhmmss
	    select mid$(junk$,9,2)
		case "07" to "17"
		    sleep% = 10
		case else
		    sleep% = 60
	    end select
	    !
	    print "-i- Sleeping for "+str$(sleep%)+" seconds: ";left$(junk$,8) +"."+ mid$(junk$,9,6)
	    sleep sleep%
	    pass_count% = 1%							! prep for first pass
	else
	    pass_count% = pass_count% + 1%					! prep for next pass
	end if
	total_message% = 0%
	illegal% = 0%
	sleeper% = 0%
	test_page% = 0%
    next
	!
	!=======================================================================
	! Qio_Xmit
	!=======================================================================
	qio_xmit:
	!
	dev_buf_xmit = xmit_data						! xfer data to mapped string
	char_count = len(xmit_data)						! get length of string for qio
	!
	!	<<< xmit data >>>
	!
	!	SYS$QIO [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm] ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]
	!
8000	rc% = sys$qio(	event_flag_xmit		by value,	! efn		&
			dev_ch_xmit		by value,	! chan		&
			funct_bits_xmit		by value,	! func		&
			iosb_xmit::quad_0	by ref,		! iosb		&
						,		! ast addr	&
						,		! ast param	&
			dev_buf_xmit		by ref,		! p1=buf addr	&
			char_count		by value,	! p2=buf size	&
						,		! p3=ignored	&
						,		! p4=cr spec	&
						,		! p5=N/A	&
							)	! p6=N/A
	!
	select rc%								!
	    case    ss$_normal							!
	    case    else							!
			sys_line = 8000%					!
			goto sys_error 						!
	end select								!
	!
	if applic_debug% > 0 then						!
	    dump_string$ = xmit_data						!
	    gosub hex_dump_of_dump_string					!
	end if
	!
	return
	!=======================================================================
	! Qio_Receive w/Purge
	!=======================================================================
	qio_recvp:
	!
	funct_bits_recv = funct_bits_rtp					! read, timed, purge
	!
	goto qio_recv_common							!
	!=======================================================================
	! Qio_Receive
	!=======================================================================
	qio_recv:
	!
	funct_bits_recv = funct_bits_rtnp					! read, timed, no purge
	qio_recv_common:
	!
	dev_buf_Recv	= ""							! init buffer for next qio
	!
	!	<<< read next line >>>
	!
	!	SYS$QIO [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm] ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]
	!
9000	rc% = sys$qiow(	event_flag_recv		by value	,	! efn			&
			dev_ch_recv		by value	,	! chan			&
			funct_bits_recv		by value	,	! func			&
			iosb_recv::quad_0	by ref		,	! iosb			&
								,	! ast addr		&
								,	! ast param		&
			dev_buf_Recv		by ref		,	! p1=buf addr		&
			k_buf_siz		by value	,	! p2=buf size		&
			2%			by value	,	! p3=timeout		&
			loc(TDB_Var::mask_type)	by value	,	! p4=read term		&
								,	! p5=prompt addr	&
								)	! p6=prompt size
	!
	timeout_flag	= 0%							! always reset this
	comm_error	= 0%							! ditto
	!
	if (rc% and 7%) = 1							! if we queued ok...
	then
	    select iosb_recv::rc						! then test the completion status	bf_129.1
		case	ss$_normal						! we must have detected a <cr>
		case    ss$_timeout						! we timed out (might have data, but no <cr>)
		    timeout_flag	= 1					! ...raise timeout flag
		case	ss$_parity						! we have a parity error
		    print "-e- parity error (recv)"
		    comm_error		= 1					!
		case else							! not sure but we'll try to cope with this
		    print "-e- ??? (recv) iosb-rc:";iosb_recv::rc		!
	    end select								!
	else									!
		sys_line = 9000%						!
		goto sys_error 							!
	end if									!
	!
	timeout_count = 0 if timeout_flag = 0					! always reset count on no-time-out
	!
	recv_data = left$(dev_buf_Recv, iosb_recv::xfer_count)			! extract data from buffer
	!
	if applic_debug% > 0 then
	    if timeout_flag=1% then						!
		print " (Recv timeout)"						!
	    else								!
		print								!
	    end if								!
	    print "                  ";						!
	    dump_string$ = left$(dev_buf_Recv, iosb_recv::xfer_count)		!
	    gosub hex_dump_of_dump_string					!
	end if									!
	!
	recv_data = edit$(recv_data, 128%+4%)					! drop trailing, drop controls (optional)
	!
	return
	!=======================================================================
	!	dump the data string in hex for analysis by humans
	!=======================================================================
	hex_dump_of_dump_string:
	declare string constant	hex_string$	= "0123456789abcdef"
	declare long	dump_i%		,&
			dump_j%		,&
			dump_k%		,&
			dump_hi%	,&
			dump_lo%	,&
		string	hex_data_string$
	!
	dump_i% = 0%								! init for 'no source data'
	dump_j% = len(dump_string$)						! test our data source
	hex_data_string$ = ""							!
	while (dump_i% < dump_j%)						! if not done...
		dump_i% = dump_i% + 1%						! advance index
		dump_k% = asc(mid$(dump_string$,dump_i%,1%))			! extract byte
		dump_hi%= integer(dump_k% / 16%)				! get high nibble
		dump_lo%= mod(dump_k%, 16%)					! get low  nibble
		hex_data_string$ = hex_data_string$ +				&
			mid$(hex_string$,dump_hi%+1%,1%)+			&
			mid$(hex_string$,dump_lo%+1%,1%)+			&
			" "							!
	next									!
	print "Hex dump>";hex_data_string$					!
	return									!
	!====================================================================================
	! This section retrieves the messages from the pager data base.
	! It also builds the packet to send Bell Mobility and generates the checksum.
	!====================================================================================
	pager_packet:
	!
	if pass_count% = 1% then						!
	    if  mid$(current_dt$,9%,4%) = rename_time$ then
		gosub open_file81
		when error in
            	    error_handler% = 0%
	            open pagerdb_fs$  as file #82%                          &
                        ,access             modify                          &
                        ,allow              modify                          &
                        ,contiguous                                         &
                        ,organization       indexed                         &
                        ,map                my_disk81                       &
                        ,connect 81
        	use
            	    error_handler% = err
        	end when
		select error_handler%
		    case 0%
		    case else
			print "-e- error Opening second channel on pagerdb.dat " + str$(error_handler%)
			goto delete_data_skip
		end select
		!
		when error in
            	    error_handler% = 0%
	 	    while 1
		        get #81%,regardless
	                rfa_8x = getrfa(81%)
	                get #82%,rfa rfa_8x					! locks record number
		        delete #82%
		    next
		use
            	    error_handler% = err
		end when
		select error_handler%
		    case 0%
		    case 11%
			print "-i- info Deleted yesterday's data"
		    case else
			print "-e- error Deleting yesterday's data " + str$(error_handler%)
		end select
		close #81%
		close #82%
		gosub open_file81
	        d81_last_name  = "DOHERTY"
	        d81_pager = "339885"
		rset d81_pager = d81_pager
	        d81_pager_type = "A"
	        d81_message1 = "Removed old Pages   "
	        d81_message2 =  left$(current_dt$,8)
	        d81_message3 = "                    "
	        d81_message4 = "                    "
	        d81_message5 = "                    "
	        current_dt$	= wcsm_dt_stamp
	        d81_recv_date	= left$(current_dt$,8)
	        d81_recv_time	= right$(current_dt$,9)
!~~~	        d81_status	= "N"
		!
	        d81_xmit_date	= left$(current_dt$,8)
	        d81_xmit_time	= right$(current_dt$,9)
	        d81_status	= "Y"
	        d81_pin		= "N194943"
	        put #81%
	        close #81%
	    end if
	end if
	!
	delete_data_skip:
	!
	gosub open_file81
	!
	current_dt$ = wcsm_dt_stamp
       	if file_open81% = 0%  then						! file failed to open
	    print "-e- File pagerdb_101.dat didn't open"
	    goto fini
	end if
	!
	!	<<< get packet >>>
	!
	get_packet:
        d81_whole_data  = ""
	when error in
	    !print "-i- info:  total_message% count = " +str$(total_message%)
	    goto new_message if total_message% > 0%
	    select pass_count%
		case = 1%
		   total_message% = 0%
	    	   restore #81%,key# 2%						! go for another record
		   error_handler% = 0%
	           d81_whole_data  = ""
                   get #81%, key# 2% eq "N", regardless				! now use it to search
	           rfa_8x = getrfa(81%)						!
		   if d81_pager_type = "P" then					!
			gosub pcs_page						!
		        goto get_packet						!
		   end if							!
 		   rset d81_pager = d81_pager					!
		   select left$(d81_pager,1)					! Only test first character
			case "4"						! used for paging SSMR
			case "2"						! used for paging Sudbury
			case else						! used for paging everyone else
	                    line1$ = "416"+edit$(d81_pager,32+4+2)		! Bell Mobility going to 10 digit dialing
	                    line2$ = d81_message1  + d81_message2 + d81_message3 + d81_message4 + d81_message5
		   end select
		case = 2%
		   total_message% = 0%
	    	   restore #81%,key# 2%						! go for another record
		   error_handler% = 0%
	           d81_whole_data  = ""
                   get #81%, key# 2% eq "N", regardless				! now use it to search
	           rfa_8x = getrfa(81%)
		   if d81_pager_type = "P" then
			gosub pcs_page
		        goto get_packet
		   end if
 		   rset d81_pager = d81_pager
!~~~		   select left$(d81_pager,2%)
		   select left$(d81_pager,1%)					! all 705 pagers start with 2
!~~~			case  "11"
			case  "2"						! paging Sudbury 705
	                    line1$ = right$(d81_pager,2%)			! subtracking the number 2
	                    line2$ = d81_message1  + d81_message2 + d81_message3 + d81_message4 + d81_message5
		   end select
		case = 3%
		   total_message% = 0%
	    	   restore #81%,key# 2%						! go for another record
		   error_handler% = 0%
	           d81_whole_data  = ""
                   get #81%, key# 2% eq "N", regardless 			! now use it to search
	           rfa_8x = getrfa(81%)
		   if d81_pager_type = "P" then
			gosub pcs_page
		        goto get_packet
		   end if
 		   rset d81_pager = d81_pager
	           rfa_8x = getrfa(81%)
!~~~		   select left$(d81_pager,2%)
		   select left$(d81_pager,1%)
			case  "4"						! used for paging SSMR
	                    line1$ = right$(d81_pager,2%)
	                    line2$ = d81_message1  + d81_message2 + d81_message3 + d81_message4 + d81_message5
		   end select
	    end select
	use
	    error_handler% = err
	end when
	!
	select error_handler%
	    case 0%
	    case else
		!print "-e- error: "+str$( error_handler% ) +" during get #81, key 2 eq 'N'"
		error_handler% = 0%
	        line1$ = ""
	        line2$ = ""
	        total_message% = 0%
	        message_count% = 0%
		close #81%
	        return
	end select
	goto build_packet
	!
	!	<<< new message >>>
	!
	new_message:
	line1$ = ""
	line2$ = ""
	when error in
	    select pass_count%
		case = 1%
	     	    error_handler% = 0%
	            d81_whole_data  = ""
            	    get #81%, regardless 					! now use it to search
	            rfa_8x = getrfa(81%)
		    if d81_pager_type = "P" then
			gosub pcs_page
		        goto new_message
		    end if
 		    rset d81_pager = d81_pager
	            rfa_8x = getrfa(81%)
!~~~		    select left$(d81_pager,2%)
		    select left$(d81_pager,1%)
!~~~			case "11"
!~~~			case "22"
			case "4"						! used for paging SSMR
			case "2"						! used for paging Sudbury
			case else						! used for paging everyone else
	                    line1$ = "416"+edit$(d81_pager,32+4+2)		! Bell Mobility going to 10 digit dialing
!~~~	                    line1$ = edit$(d81_pager,32+4+2)
	                    line2$ = d81_message1  + d81_message2 + d81_message3 + d81_message4 + d81_message5
		   end select
		case = 2%
	     	    error_handler% = 0%
	            d81_whole_data  = ""
            	    get #81%,regardless ! now use it to search
	            rfa_8x = getrfa(81%)
		    if d81_pager_type = "P" then
			gosub pcs_page
		        goto new_message
		    end if
 		    rset d81_pager = d81_pager
!~~~		    select left$(d81_pager,2%)
		    select left$(d81_pager,1%)
!~~~			case  "11"
			case  "2"						! paging Sudbury 705
	                    line1$ = right$(d81_pager,2%)			! subtracking the number 2
	                    line2$ = d81_message1  + d81_message2 + d81_message3 + d81_message4 + d81_message5
			case else
			    goto new_message
		    end select
		case = 3%
	     	    error_handler% = 0%
	            d81_whole_data  = ""
            	    get #81%,regardless						! now use it to search
	            rfa_8x = getrfa(81%)
		    if d81_pager_type = "P" then
			gosub pcs_page
		        goto new_message
		    end if
 		    rset d81_pager = d81_pager
		    select left$(d81_pager,1%)
			case  "4"						! used for paging SSMR
	                    line1$ = right$(d81_pager,2%)
	                    line2$ = d81_message1  + d81_message2 + d81_message3 + d81_message4 + d81_message5
			case else
			    goto new_message
		    end select
	    end select
	use
	    error_handler% = err
 	    d81_status = "E"  					     		! when set to "E" end of
	end when
	!
	select error_handler%
	    case 0%
	    case else
		if applic_debug% > 0 then
		    print "-i- info: "+str$( error_handler% ) +" during get #81, regardless"
		    print "-i- info: pass count "+str$( pass_count% )
		end if
		error_handler% = 0%
		line1$ = ""
		line2$ = ""
		total_message% = message_count%
		message_count% = 0%
		return
	end select
	!
	!	<<< build packet >>>
	!	modified the next few lines to stop search if page is blank
	!
	build_packet:
 	if edit$(d81_pager,32+4+2) = "" then					! if pager field is blank...
	    print "-i- info: pager field blank"	if applic_debug% > 0
	    when error in
	        get #81%,rfa rfa_8x						! lock record
	        delete #81%							! blow it away
	    use
		print "-e- error: Deleting record no pager number " + str$(err)
	    end when
	    line1$ = ""
	    line2$ = ""
	    total_message% = message_count%
	    message_count% = 0%
	    return
	end if
	!
	if line1$ + line2$ = "" then
	    print "-w- both line1$ + line2$ are blank" 	if applic_debug% > 0
	    line1$ = "blank"
	    line2$ = "blank"
	    total_message% = message_count%
	    message_count% = 0%
	    return
	end if
	!
 	if d81_status <> "N" then
	    print "-i- status <> 'N', no more messages to send " + "d81_status = " + d81_status	if applic_debug% > 0
	    line1$ = ""
	    line2$ = ""
	    total_message% = message_count%
	    message_count% = 0%
	    return
	end if
	!
	if d81_pager_type = "N"	then						! checking the first char
	    print "-i- pager type = 'N'"	if applic_debug% > 0
	    page_num% = 1%							! is a "1"
	    select left$(d81_pager,1%)
		case "4"							! used for paging SSMR (Sault Saint Marie)
                    line1$ = right$(d81_pager,2%)
		case "2"							! used for paging Sudbury
                    line1$ = right$(d81_pager,2%)
		case else							! used for paging everyone else
	            line1$ = "416"+edit$(d81_pager,32+4+2)			! Bell Mobility going to 10 digit dialing
!~~                    line1$ = edit$(d81_pager,32+4+2)
	   end select
!~~~	    line1$ = d81_pager
	    line2$ = left$(line2$,12%)
	    line2$ = edit$(line2$,32+4+2)
	end if
	!
	!	<<< wake >>>
	!
	wake:
	!
	!	940524, added edit$(4%) to prevent junk paging text
	!
	packet$ = STX + edit$(line1$,4%) + cr + edit$(Line2$,4%) + cr + ETX
	!packet$ = STX + line1$ + cr + Line2$ + cr + ETX
	!
	message_count% = message_count% + 1%
	!
	total_message% = message_count%
	!
	checksum%=0%
	for i% = 1% to len( packet$ )
	    checksum% = checksum% + asc( mid$(packet$,i%,1%) )
	next i%
	char1%		= checksum% / 256%					! 1st char
	checksum%	= checksum% - char1% * 256%
	!
	char2%		= checksum% / 16%					! 2cd char
	checksum%	= checksum% - char2% * 16%
	!
	char3%		= checksum%						! 3rd char
	!
  	checksum$	= chr$(48% + char1% ) + chr$(48% + char2% ) + chr$(48% + char3% )
	!
 	packet$(message_count%) = STX + line1$ + cr + Line2$ + cr + ETX + checksum$ + cr
	!
	! 'd81_recv_date' and 'd81_recv_time' are used to to find a record in the pagerdb_101.dat file.
	!
	xmit_count$(message_count%) = d81_recv_date + d81_recv_time
	if applic_debug% > 0 then
	    print "-i- line  : ";line1$
	    print "-i- packet: ";packet$
	end if
	!
	goto new_message
	!=======================================================================
	! Paging a PCS phone is done via smtp mail the phone number is the
	! mailing address 4161234567@txt.bellmobility.ca
	!=======================================================================
	pcs_page:
	when error in
            error_handler% = 0%
	    open pagerdb_fs$  as file #82                       &
            ,access             modify                          &
            ,allow              modify                          &
            ,contiguous                                         &
            ,organization       indexed                         &
            ,map                my_disk81                       &
            ,connect 81
        use
            error_handler% = err
        end when
	get #82%,rfa rfa_8x							! lock record number
	current_dt$	= wcsm_dt_stamp
	d81_xmit_date	= left$(current_dt$,8)
	d81_xmit_time	= right$(current_dt$,9)
	d81_status = "Y"
	rset d81_pager = edit$(d81_pager,32+4+2)				!
!	when error in
	    update #82%
!	use
!	end when
	close #82%
	select left$(d81_pager,1%)
	    case "A"
		Area_code$ = "416"
	    case "B"
		Area_code$ = "613"
	    case "C"
		Area_code$ = "514"
	    case "D"
		Area_code$ = "519"
 	    case "E"
		Area_code$ = "705"
	    case "F"
		Area_code$ = "905"
	    case "G"
		Area_code$ = "819"
	    case "H"
		Area_code$ = "418"
	end select
	!
	mail_filename$ =  "CSMIS$ROOT1:[spool]"+Area_code$+mid$(d81_pager,2%,7%)+".spl"
	open mail_filename$ for output as file #1%,  &
                                    recordsize 132
	print #1,d81_message1
	print #1,d81_message2
	print #1,d81_message3
	print #1,d81_message4
	print #1,d81_message5
	close #1
	mail_address$ = "smtp%" + '"""' + Area_code$+mid$(d81_pager,2%,7%)+"@txt.bellmobility.ca"  + '"""'
	junk% = wcsm_submit_to_batch( 										&
                                        "CSMIS$BATCH"                                   ,! batch queue                  &
                                        "CSMIS$COM:mail_queue_server.com"               ,! batch program                &
                                        "mail_queue_server.log"                         ,! batch logfile NSR 96.0813    &
                                        ""                                              ,! user                         &
                                        mail_filename$					,! p1$  print file              &
                                        mail_address$ 					,! p2$  print queue &
                                        ""                                              ,! p3$  print option            &
                                        ""		                                ,! p4$                          &
                                        ""                                              ,! p5$                          &
                                        ""                                              ,! p6$                          &
                                        ""                                              ,! p7$                          &
                                        ""                                               ! p8$                          &
                                        )

!~~~        junk% = lib$delete_file(mail_filename$ + ";*")
	return
20000	!=======================================================================
	!	Open section
	!=======================================================================
	open_file81:								!
	when error in								!
!~~~	    %include "[.fil]PAGERDB_101_OPEN81.opn"				x open pager database
	    open ( default_node$ + pagerdb_fs$ )  as #81				&
		,access		modify							&
		,allow		modify							&
		,contiguous								&
		,organization	indexed							&
		,map		my_disk81						&
		,primary key 	(d81_recv_date,d81_recv_time)	duplicates descending 	&
		,alternate key	d81_pager   			duplicates		&
		,alternate key  d81_status  			duplicates changes 	&
		,alternate key  d81_last_name  			duplicates changes
	    !
	    file_open81% = 1%							! show open
	use									!
	    print "-e- error: "+ str$(err) +" opening pager data file"		!
	    file_open81% = 0%							! show not open
	end when								!
	!
	return									!
	!=======================================================================
	!	BASIC Error Routine
	!=======================================================================
31000	Error_Trap:								!
	print
	print "-e- BASIC Error:"
	print "-e- Error = "+ str$( Err	)
	print "-e- Line  = "+ str$( Erl	)
	PRINT "-e- Text  = "+ ERT$( Err	)
	print
	!
	resume Fini								! fix stack
	!
	!	System Error Routine (note: 'rc%' must be setup before this call)
	!
	sys_error:								!
	print 									!
	print "========================================"			!
	print "-e- System Error:"
	print "-e- SysError = "+ str$( rc%	)
	print "-e- Line     = "+ str$( sys_line	)
	print "========================================"			!
	resume	fini								!
	!
31100	Fini:									!
	end									!
	!###################################################################################################################
	!
	!	<<< external functions >>>
	!
31110   %include "[.fun]wcsm_trnlnm.fun"					!
	!
31120	%include "[.fun]WCSM_submit_to_batch.fun"				!
	!
31130	%include "[.fun]Wcsm_DT_Stamp.fun"

Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.