-- $Source: /commtar/monoBANK/CICS_INTF/sel_appl.ada,v $ -- $Revision: 1.29 $ $Date: 88/07/08 00:41:34 $ $Author: chris $ with Unchecked_conversion; with Host_character_pkg; Use Host_character_pkg; with CICS_Terminal_Control; use CICS_Terminal_Control; with CICS_Task_Control; use CICS_Task_Control; with CICS_exceptions; use CICS_exceptions; with CICS_Exec_Interface_Block; use CICS_Exec_Interface_Block; with Terminal_field_attributes; use Terminal_field_attributes; with Selection_menu_pkg; use Selection_menu_pkg; with Transaction_authority_file_pkg; use Transaction_authority_file_pkg; with Temp_IO; ---------------------------- procedure Sel_appl ---------------------------- is -- This program displays a screen of transaction codes from which the user -- selects one. Then it edits the user's selection. Upon a valid selection, -- control is transferred to the transaction associated with the selection -- via the transaction's id. package EIB renames CICS_Exec_Interface_Block; package TIO renames Temp_IO; use Selection_menu; use Authority_file; Debugging : Boolean := False; Map_name : constant string := "ATJ0LUM"; Mapset_name : constant string := "ATJ0LU2"; Auth_file_name : constant string := "ATJ0KA"; Taps_file_name : constant string := "ATJ0LA"; Reprompt : String(1..1) := "S"; Reprompt_or_exit : String(1..1) := "M"; Not_applic : constant string := "N/A "; SBA : constant character := ASCII.dc1; Menu : Terminal_data; First_Time : Boolean := False; Single_Choice : Integer := 0; Cursor_pos : Position := Not_specified; Selection_Pos : Position := 1720; Host_rec : Host_authority_file_record; Rec : Authority_file_record; Num_Trans : constant Integer := 8; User_Prompt : String(1..22) := "Please enter user id: "; Prompt_Id_Len : constant integer := User_Prompt'Length + Rec.Userid'Length + 3; -- string read by receive will consist of the prompt, the user id -- and 3 characters for the SBA sequence. Prompt_Id : String(1.. Prompt_Id_Len); Amnu_Userid : String(1..Rec.Userid'length); Taps_userid : String(1..6); Error_return : exception ; -- return to main program from subprog exception type error_msg_enum is (Rec_not_found, Invalid_selection, Invalid_trans, Invalid_trans_id, Invalid_term_id, Nospace); subtype error_msg_text is string (1..Length(Errmsg)); type error_msg_array is array(error_msg_enum) of error_msg_text; Error_msg : Error_msg_array := ( --123456789-123456789-123456789-123456789-123456789-123456789-123456789 "USERID NOT ON FILE, NOTIFY SECURITY OFFICER, HIT ""CLEAR"" TO EXIT.", "SELECTION NOT WITHIN RANGE ""1"" TO ""21"", PLEASE RENTER. ", "CHOICE ENTERED IN ""N/A"", CORRECT AND REENTER. ", "TRANSID SELECTED INVALID, UPDATE ATJ0KA USER FILE, CLEAR TO EXIT.", "TERMINAL ID INVALID, NOTIFY SECURITY OFFICER, CLEAR TO EXIT. ", "NO SPACE IN FILE FOR TAPS RECORD, NOTIFY ESD "); -- note that Invalid_trans_id and Invalid_term_id will not be issued -- since their purpose is to report CICS Start command exceptions. ----------------------------- function Is_numeric(S:string) ----------------------------- return boolean -- Return true if input string has at least one character that is a -- number and the other characters are numbers, spaces or nulls. is subtype Numeric is character range '0'..'9'; At_least_one_number : boolean := false; begin for i in S'range loop if S(i) in Numeric then At_least_one_number := true; end if; if S(i) not in Numeric and then S(i) /= ' ' and then S(i) /= '_' and then S(i) /= ASCII.nul then return false; end if; end loop; return At_least_one_number; end; ----------------------------- function Sel_Value (S : String) return Integer ----------------------------- -- this is specifically to return the value of the two character -- selection field. it assumes that the string only has two -- characters. We also know there is at least one numeric character -- in the string. is begin if Debugging then TIO.Put_Line("Selection is: " & S); end if; if S(1) not in '1'..'9' then if S(2) not in '1'..'9' then -- if there is at least one numeric and it's not in 1-9 -- it must be 0 return 0; else return Integer'Value(S(2..2)); end if; elsif S(2) not in '0'..'9' then return Integer'Value(S(1..1)); else return Integer'Value(S); end if; end Sel_Value; ----------------------------- procedure Move_data_to_screen ----------------------------- is The_field : Selection_menu_pkg.Field_enum; begin -- Assign Trans ids to fields of the Selection Menu for i in Trans_ids_array'range loop The_field := Field_enum'val(i); -- this works because even though the enumeration values -- start at zero there is one field (the invisible state -- field) before the transactions start. if Rec.Trans_ids(i) = (Trans_id_type'range=>' ') then Set_field(Menu, The_field, Not_applic); else Set_field(Menu, The_field, Rec.Trans_ids(i)); Set_attribute(Menu, The_field, Askip_bright_mod); end if; end loop; -- Assign Stammis ids to fields of Selection Menu for i in Taps_sys_all_array'range loop The_field := Field_enum'val(Num_Trans+i); if Rec.taps_sys_all(i) = (Taps_sys_id=>(others=>' '), Dbid=>(others=>' '), Stammis=>(others=>' ')) then Set_field(Menu, The_field, Not_applic); else Set_field(Menu, The_field, Rec.Taps_sys_all(i).Stammis); Set_attribute(Menu, The_field, Askip_bright_mod); end if; end loop; -- Assign Deii, Dqry, and Updt to fields of Selection Menu if Rec.Deii = (Rec.Deii'range=>' ') then Set_field(Menu, Deii, Not_applic); else Set_field(Menu, Deii, Rec.Deii); Set_attribute(Menu, Deii, Askip_Bright_Mod); end if; if Rec.Dqry = (Rec.Dqry'range=>' ') then Set_field(Menu, Dqry, Not_applic); else Set_field(Menu, Dqry, Rec.Dqry); Set_attribute(Menu, Dqry, Askip_Bright_Mod); end if; if Rec.Updt = (Rec.Updt'range=>' ') then Set_field(Menu, Updt, Not_applic); else Set_field(Menu, Updt, Rec.Updt); Set_attribute(Menu, Updt, Askip_Bright_Mod); end if; end; ------------------------- function Is_single_choice ------------------------- return Boolean -- if only a single choice is present in authority record return true is Choice, Count : integer := 0; begin -- check for multiple choices of Trans ids for i in Trans_ids_array'range loop if Rec.Trans_ids(i) /= (Rec.Trans_ids(i)'range=>' ') then Choice := i; Count := Count + 1; exit when Count > 1; end if; end loop; -- check for multiple choices of Stammis ids if Count <= 1 then for i in Taps_sys_all_array'range loop if Rec.Taps_sys_all(i).Stammis /= (Rec.Taps_sys_all(i).Stammis'range =>' ') then Choice := Num_Trans + i; Count := Count + 1; exit when Count > 1; end if; end loop; end if; -- check for choices of Deii, Dqry, Updt if Count <= 1 and then Rec.Deii /= (Rec.Deii'range=>' ') then Choice := 19; Count := Count + 1; if Count <= 1 and then Rec.Dqry /= (Rec.Dqry'range=>' ') then Choice := 20; Count := Count + 1; if Count <= 1 and then Rec.Updt /= (Rec.Updt'range=>' ') then Choice := 21; Count := Count + 1; end if; end if; end if; -- if only a single choice exists then assign its value to -- the Selection field of the menu If Count = 1 then if Debugging then TIO.Put_Line("Count is only 1, Choice:" & integer'image(Choice) & ":"); end if; Single_Choice := Choice; -- save Choice return True; else Set_field(Menu, Selection, String'(1..Length(Selection)=>'_')); return False; end if; end; ------------------------------------- procedure Display_rec_not_found_error ------------------------------------- is begin Set_field(Menu, Userout, Amnu_userid); Set_attribute(Menu, Userout, Unprot_bright); Set_field(Menu, Errmsg, Error_msg(Rec_not_found)); Set_attribute(Menu, Errmsg, Prot_bright); Set_field(Menu, Menut, Reprompt_or_exit); Set_Field(Menu, Userid, Amnu_Userid); Send_map(Map=>Map_name, Mapset=>Mapset_name, From=>Menu, Cursor=>Selection_Pos, Erase=>Screen, Free_Keyboard=>False); raise Error_return; end; ------------------------ procedure Display_error( ------------------------ I : Error_msg_enum; Action_code : String) is begin Set_field(Menu, Errmsg, Error_msg(I)); Set_attribute(Menu, Errmsg, Prot_bright); Set_attribute(Menu, Selection, Unprot_bright); Set_field(Menu, Menut, Action_code); Set_Field(Menu, Userid, Amnu_Userid); Send_map(Map=>Map_name, Mapset=>Mapset_name, From=>Menu, Cursor=>Selection_Pos, Erase=>Screen, Free_Keyboard=>True); raise Error_return; -- for good measure, but may not be necessary end; ---------------------------- procedure Write_taps_record( ---------------------------- Taps_id : integer) is Userid : String(1..8); begin declare Taps_string : constant String := Integer'Image(Taps_Id); begin Userid := Amnu_Userid(1..6) & Taps_String(Taps_String'Last-1..Taps_String'Last); if Taps_String(Taps_String'Last-1) = ' ' then -- if the id is a single digit then the previous char -- is a blank. Replace this with a zero. Userid(7) := '0'; end if; end; Rec.Userid := Userid; Write(File=>Taps_file_name, From=>To_host_rec(Rec), Key=>To_Host_String(Userid)); exception when Duplicate_record => null; when others => -- assume this is for nospace Display_error(Nospace, Reprompt_or_exit); end; -------------------------- procedure Xctl_to_program( -------------------------- Trans_id : Trans_id_type) is begin -- If a blank transaction was selected reprompt user. Otherwise -- a transid or Deii, Dqry, or Updt was selecetd then send -- send the transaction's name to terminal (as if the user has -- entered this). Then start these transactions or start the -- "TAPS" (stammis) Transaction, using the input transaction name. if Trans_id = (Trans_id_type'range=>' ') then Display_error(Invalid_trans, Reprompt); else if Trans_id /= "TAPS" then -- not stammis id Send_text(From=>Trans_id, Erase=>Screen, Free_keyboard=>True); elsif Trans_id = "TAPS" then Send_Text(From=>" ", Erase=>Screen, Cursor=>0); end if; end if; if Trans_id = "AMUP" or Trans_id = "DQRY" then Send_text(From=>"PLEASE HIT ""ENTER"" TO CONTINUE", Erase=>Screen, Free_keyboard=>True); end if; Setup_return(Trans_id); end; ---------------------- procedure Xctl_to_appl ---------------------- -- If user's selection is invalid then reprompt. Otherwise attempt -- to transfer control. is -- the range of selections subtype Selection_item is integer range 1..21; subtype Trans_id_item is Selection_item range 1..8; subtype Stammis_id_item is Selection_item range 9..18; subtype Deii_item is Selection_item range 19..19; subtype Dqry_item is Selection_item range 20..20; subtype Updt_item is Selection_item range 21..21; Trans_id : Trans_id_type := (others=>' '); Taps_id : integer; Sel_Field : String(1..2); Choice : Integer := 1; Not_possible : exception; begin -- get authority record against which user's selection is checked if Single_Choice = 0 then -- Single_Choice was never set, there are many selections -- possible, so get the Choice from the Menu Read(File=>Auth_file_name, Element=>Host_rec, Key=>To_Host_String(Amnu_userid)); Rec := To_rec(Host_rec); -- on value out of range reprompt user for selection Sel_Field := Field(Menu, Selection); if Is_Numeric(Sel_Field) then Choice := Sel_Value(Sel_Field); if Debugging then TIO.Put_Line("Choice:" & Integer'Image(Choice)); end if; end if; if (not Is_Numeric(Sel_Field)) or else (Choice not in Selection_item) then Display_error(Invalid_selection, Reprompt); -- on choice that is for a Stammis id, Deii, Dqry, or Updt -- that is "N/A", reprompt user for selection elsif (Choice in Stammis_id_item'first..Stammis_id_item'last or Choice in Deii_item or Choice in Dqry_item or Choice in Updt_item) and then (Field(Menu, Field_enum'val(Choice)) = Not_applic) then Display_error(Invalid_trans, Reprompt); end if; else Choice := Single_Choice; end if; -- if selection is a trans id then transfer control to program -- (trans id is checked later for erroneous value) -- else if selection is a stammis id, write Taps record and then -- transfer control -- if selection is Deii, Dqry, or Updt, handle like trans ids if (Choice in Trans_id_item) then Trans_id := Rec.Trans_ids(Choice); elsif (Choice in Stammis_id_item) then Taps_id := Choice; Trans_id := "TAPS"; Write_taps_record(Taps_id); elsif Choice in Deii_item then Trans_id := "DEII"; elsif Choice in Dqry_item then Trans_id := "DQRY"; elsif Choice in Updt_item then Trans_id := "AMUP"; else -- theoretically impossible raise Not_possible; end if; Xctl_to_program(Trans_id); exception when Not_found => Display_rec_not_found_error; end; ------------------------- procedure Read_ATJ0KA_rec ------------------------- is begin Read(File=>Auth_file_name, Element=>Host_rec, Key=>To_Host_String(Amnu_userid)); Rec := To_rec(Host_rec); if Is_single_choice then Xctl_to_appl; else Set_field(Menu, Selection, String'(1..Length(Selection)=>'_')); Move_data_to_screen; Set_field(Menu, Menut, Reprompt); Set_Field(Menu, Userid, Amnu_Userid); Send_map(Map=>Map_name, Mapset=>Mapset_name, From=>Menu, Cursor=>Selection_pos, Erase=>Screen, Free_Keyboard=>True); end if; exception when Not_found => Display_rec_not_found_error; end; begin -- Select_application begin Receive_map(Map=>Map_name, Mapset=>Mapset_name, Into=>Menu); exception when MAPFAIL => -- there are two reasons that the receive map may fail: -- 1. this is the first time through, so do initial stuff -- 2. the user hit "clear" or someother AID like PA1. if EIB.EIB_AID = EIB.Clear or else EIB.EIB_AID = EIB.PA1 or else EIB.EIB_AID = EIB.PA2 or else EIB.EIB_AID = EIB.PA3 then Send_Text("DONE"); return; else -- this is the first time into the transaction First_Time := True; end if; end; if First_Time then -- if this is the first time through the transaction then get -- the user id from the user since we cannot get it from the -- system loop Send_Text(User_Prompt, Erase=>Screen, Free_Keyboard=>True, Cursor=>23); Wait_Terminal; begin Receive(Prompt_Id); -- exit the loop if we got something from the terminal ok exit; exception when Length_Error => -- report the error. User_Prompt := "Invalid id, re-enter: "; end; end loop; -- Receive comes back with both the string we wrote and anything -- the user entered. So strip off the prompt. if Prompt_Id(1) = SBA then -- received from a formatted screen so also need to strip -- off the SBA sequence of three characters at the beginning -- of the string Amnu_userid := Prompt_Id( User_Prompt'Length+4 .. Prompt_Id'Last); else -- this will probably be an error later because the user -- cleared the screen and then entered their id. so the -- characters that this is reading will be blank. Amnu_userid := Prompt_Id( User_Prompt'Length+1 .. User_Prompt'Length + Amnu_userid'Length); end if; if Debugging then TIO.Put_Line("User id is: " & Amnu_Userid); end if; Read_ATJ0KA_rec; elsif Field(Menu, Menut) = Reprompt then -- user has made a menu selection (may be first selection, or -- a retry of erroneous selection) Amnu_Userid := Field(Menu, Userid); Xctl_to_appl; elsif Field(Menu, Menut) = Reprompt_or_exit then -- user does not have valid id or no space or write of taps record, Amnu_Userid := Field(Menu, Userid); Read_ATJ0KA_rec; end if; exception when MAPFAIL => if EIB.EIB_AID = EIB.Clear then Send_Text("DONE"); else Send_Text("Unexpected Map Fail, quitting"); end if; return; when Error_return => -- orderly exit from subprogram error null; end; -- $Cprt start$ -- -- Copyright (C) 1988 by Intermetrics, Inc. -- -- This material may be used duplicated or disclosed by or for the -- U.S. Government pursuant to the copyright license under DAR clause -- 7-104.9(a) (May 1981). -- -- This project was spnsored by the STARS Foundation -- Naval Research Laboratory, Washington DC -- -- $Cprt end$