;==File=================================================================;
; POMENU.DBL
;=======================================================================;
; Copyright 1999 by TAH Software Systems (TAH), Oklahoma City, Oklahoma ;
;									;
;	TAH provides this software under a license and may only be	;
;	used in accordance with the terms and conditions of such	;
;	license and with the inclusion of the above Copyright notice.	;
;==Function=============================================================;
;	pomenu		Purchase Order menu control.
;==Changes==============================================================;
; 01/20/2012 lso - expand Company name variable from 30 to 40
; 10/30/1997 tah - Add new inquiry menu option.
;=======================================================================;
.subroutine pomenu

.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dteut.def"
.include "POS:dtepo.def"

.include "UTS:utcomm.gbl"
.include "POS:pocomm.gbl"
.include "INS:incomm.gbl"

external function
	smctrl		,a

record
	cur_entry	,a8,	'[      ]'
	  cur_entnam	,a6	@cur_entry+1	; menu option chosen
	hold_mnustrng	,a100			; saved menu string
	ut_clen		,d2			; length of company name
.start nopage,list

.proc
	xcall e_enter
	xcall lodcol ('RL')

	if (%smctrl(ut_cmcomp,'SM','APPL-PO').ne.'Y')
	  begin
	    xcall message (DTEPO_CND,D_ERROR)
	    goto end
	  end

	xcall poctrl (ut_cmcomp)
	xcall inctrl (ut_cmcomp)

	;	create and load main menu

	xcall gettxt (DTEM_DTE)
	xcall e_sect (ut_msgtext(1:ut_msgsize),D_HEADER,D_LEFT)
	xcall gettxt (DTEPO_POS)
	xcall e_sect (ut_msgtext(1:ut_msgsize),D_HEADER,D_NOCLEAR,D_CENTER)
	clear ut_msgno
	ut_clen = %trim(ut_cmname)
	if (ut_clen.gt.40) ut_clen = 40
	xcall e_sect (ut_cmname(1:ut_clen),D_HEADER,D_NOCLEAR,D_RIGHT)

	xcall lodcol ('LPL','pomaintmenu',po_menu_col[1])
	xcall lodcol ('LPL','potranmenu',po_menu_col[2])
	xcall lodcol ('LPL','poreptmenu',po_menu_col[3])
	xcall lodcol ('LPL','pomiscmenu',po_menu_col[4])

	ut_cmtype = 'PO'
	xcall getsec ('DTE_PO')
	if (sec_opte.eq.'N')
	  begin
	    xcall message (DTER_SNA,D_ERROR)
	    goto end
	  end

	case po_cmrectyp of
	  begincase
	  1: xcall m_disable (po_menu_col[2],"t_por2")
	  2: xcall m_disable (po_menu_col[2],"t_por1")
	  endcase
	xcall status
	cur_entnam = 'T_OENT'
	hold_mnustrng = cur_entry

	repeat
	  begin
	    xcall gettxt (DTER_UAK)
	    xcall e_sect (ut_msgtext(1:ut_msgsize), D_INFO, D_CENTER)
	    xcall m_process (hold_mnustrng,'PODTEPO')
	    xcall e_sect (, D_INFO, D_CLEAR)
	    if g_select
	      begin
		if (g_entnam.eq.'END') goto end
		hold_mnustrng = g_mnustrng
		cur_entnam = g_entnam
		call select
		if (g_entnam.eq.'QUIT') goto end
	      end
	  end

	;	do menu selection processing
select,
	xcall getsec (g_entnam)			; get operator security
	if (sec_opte.eq.'N')
	 then xcall message (DTER_SNA,D_ERROR)
	 else
	  begin
	    if (sec_opt_pass.ne.ut_blanks)
	      begin
		xcall passwd (ut_err)
		if (ut_err) return
	      end
	    xcall acslog (cur_entnam)		; log operator/option
	    xcall status
	    ut_cmprog = cur_entnam
	    ut_calprg = 'POMENU'
	    case cur_entnam of
	      begincase
	      'M_NAME': xcall na2000	; name/address
	      'M_ITEM':	xcall in2000	; items
	      'M_COD':	xcall ut_codes	; Codes
	      'M_COMP':	xcall sm2900 ('PO')	; company

	      'T_OENT':	xcall po4000	; order entry
	      'T_PRNT':	xcall po4100	; print purchase orders
	      'T_WSHT':	xcall po4200	; print receivings worksheets
	      'T_RECL':	xcall po4210	; print receivings label pages
	      'T_SENT':	xcall po4300	; (1)receivings entry
	      'T_PROF':	xcall po4310	; (1)print receivings proof list
	      'T_LBLS':	xcall po4320	; (1)print receiving labels
	      'T_RDOK': xcall po4350 ('DOCK') ; (2)receivings at dock scan
	      'T_STOK': xcall po4350 ('STOK') ; (2)receivings from dock to stock
	      'T_SLBL': xcall po4360	; (2)stocking labels
	      'T_ATDK': xcall po4380	; (2)items at dock report
	      'T_REPT': xcall po4500	; daily receivings report
	      'T_BACK':	xcall po4600	; receivings backorder list
	      'T_POST':	xcall po4700	; post receivings

	      'R_PQUE':	xcall lpque		; queued reports
	      'R_PCRP':	xcall lpcustom('PO')	; custom reports
	      'R_':	xcall po_rept ('M')	; standard reports
	      'I_':	xcall ut_inquiry	; standard inquiry

	      'Z_PURI':	xcall po8000	; purge orders
	      'Z_RESI':	xcall po8100	; reset onorder quantity
	      'Z_PURH':	xcall po8200	; purge history
	      'Z_CLOS':	xcall po8300	; close purchase order
	      'Z_OPEN':	xcall po8400	; reopen purchase order
	      'Z_PURR':	xcall po8500	; purge receivings file
	      endcase
	    xcall set_coname_header
	  end
	return

	;	end of program, clean up and back to main menu
end,
	if (pohedr_chan) xcall close (pohedr_chan,DTE_CLOSE)
	if (pohist_chan) xcall close (pohist_chan,DTE_CLOSE)
	if (poline_chan) xcall close (poline_chan,DTE_CLOSE)
	if (pomail_chan) xcall close (pomail_chan,DTE_CLOSE)
	if (porecv_chan) xcall close (porecv_chan,DTE_CLOSE)
	if (posnlt_chan) xcall close (posnlt_chan,DTE_CLOSE)

	for ut_clen from 1 thru 10 clear po_menu_col[ut_clen]

	xcall e_exit
	xreturn	; to calling program
.end

