iX V6.5 (30391-90011)

ManualsBrandsHP ManualsSoftwareMPE/iX 6.5 Operating System

291

292

293

294

295

296

297

298

299

300

292 Chapter6

Host Language Access

FORTRAN 77

Equivalence (Search_Item_Value(1),Search_Item_Value_Is)

Parameter (End_Of_Chain=15,No_Chain_Head=17)

C** Set up for the predicate buffer used in item level locking.

Num_Of_Elements = 1

Length_Of_Descriptor = 21

Data_Set_Of_Descriptor ='SALES;'

Data_Item_Of_Descriptor='PURCH-DATE;'

Relative_Operator =' ='

C** Accept the search value.

Print*,' Enter The Date of Purchase as (YYMMDD) >>> '

Read (5,10) Search_Item_Value_Is

10 Format(A6)

C** Request item level locks on all items identified by the search

C** value. A mode value of 5 indicates an item level lock request.

Mode5_Unconditional =5

Value_For_Data_Item = Search_Item_Value_Is

Call DBLOCK (DBname,Lock_Descriptor_Array,Mode5_Unconditional,

& Status)

If (Condition.NE.0) then

Call Get_Error_And_Explain

EndIf

C** Locate all entries identified by the search value.

Data_Set_Name_Is = 'SALES;'

Mode1_Chained_Read = 1

Search_Item_Name_Is = 'PURCH-DATE;'

Call DBFIND (DBname,Sales_Detail,Mode1_Chained_Read,Status,

& Search_Item_Name,Search_Item_Value)

If (Condition.NE.0) Then

If (Condition.EQ.No_Chain_Head) Then

Print*,'_____________________________________________'

Print*,'| |'

Print*,'| No Such Entry In the Sales Data Set |'

Print*,'| |'

Print*,'|___________________________________________|'

Print*,'Hit Enter to Continue .................... '

Read(5,*)

Else

Call Get_Error_And_Explain

EndIf

Else

Write(6,20)

Write(6,30)

20 Format (' Acct-Number Stock-Number Qty Price Tax Total ',

&'Purch-Date Deliv-Date ')

30 Format (' --------------------------------------------------- ',

&'------------------------ ')

Mode5_Forward = 5

List = '

Do While (Condition.NE.End_Of_Chain)

Call DBGET (DBname,Sales_Detail,Mode5_Forward, Status,