In my new little rehydrate program...
Several of the dictionary fields that show up in BDT and LIST DICT INVOICE...
do not appear.
--Bill
_________________________________________________________________________________________________________
*R1 Bill Brutzman Aug.2012
open 'DICT', 'INVOICE' to fDictSource else null
include B.BP BASELINE.R10
crt @(0)
dArray = ''
*------------------------------------------------------------------------------
Main.Program:
gosub firstLoop
gosub secondLoop
go theEnd
*------------------------------------------------------------------------------
*------------------------------------------------------------------------------
firstScreen:
crt @(0)
call *HEADER.CLEAR.R1
crt
crt
crt
crt ' ________________
'
crt ' / \
'
crt ' \ Dict.Hydrate /
'
crt ' \______________/
'
crt
crt
crt
crt
crt ' [G] Go '
crt
crt ' [X] eXit '
crt ' ':
input Ans.Rep, 1
Ans.Rep = upcase(Ans.Rep)
begin case
case Ans.Rep = 'G' ; null
case Ans.Rep = 'X' ; go theEnd
case 1 ; crt @(-1) ; sleep ; go firstScreen
end case
return
*------------------------------------------------------------------------------
firstLoop:
call *HEADER.CLEAR.R1
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt Grn : ' Hydrating... ' :
hush on
execute "clearselect ALL"
execute 'SELECT DICT INVOICE'
hush off
call *HEADER.CLEAR.R1
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt
crt Red : ' Hydrating... ' : Grn :
crt
crt
done = false
loop
readnext dictID else done = true
until done do
read rDict from fDictSource, dictID else rDict = ''
type = rDict<1>
field = rDict<2>
item3 = rDict<3>
item4 = rDict<4>
item5 = rDict<5>
sm = rDict<6>
crtStr = dictID 'L#20' : ' '
crtStr := type 'L#10' : ' '
crtStr := field 'L#10' : ' '
crtStr := item3 'L#10' : ' '
crtStr := item4 'L#10' : ' '
crtStr := item5 'L#10' : ' '
crtStr := sm 'L#10'
crt crtStr
begin case
case type = 'D' ; gosub sortDrecords
* case 1 ; dArray<-1> = thisRecord
end case
thisRecord = ''
thisRecord := field : VM
thisRecord := dictID : VM
thisRecord := type : VM
thisRecord := item3 : VM
thisRecord := item4 : VM
thisRecord := item5 : VM
thisRecord := sm
repeat
crt
crt ' [<] ' :
*input Ans
crt
crt
return
*------------------------------------------------------------------------------
sortDrecords:
locate thisRecord in dArray<1> by 'AR' setting posn else null
ins thisRecord before dArray<posn>
return
*------------------------------------------------------------------------------
secondLoop:
totalNbrDictItems = dcount(dArray, AM)
for thisCount = 1 to totalNbrDictItems
newField = dArray<thisCount,1>
newID = dArray<thisCount,2>
newType = dArray<thisCount,3>
newField3 = dArray<thisCount,4>
newField4 = dArray<thisCount,5>
newField5 = dArray<thisCount,6>
newsm = dArray<thisCount,7>
newStr = Red
newStr := thisCount 'R#3' : ' ' : Grn
newStr := newField 'L#10' : ' '
newStr := newID 'L#20' : ' '
newStr := newType 'L#10' : ' '
newStr := newField3 'L#10' : ' '
newStr := newField4 'L#10' : ' '
newStr := newField5 'L#10' : ' '
newStr := newsm 'L#10'
crt newStr
next thisCount
crt
crt ' [<] ' :
input Ans, 1
return
*------------------------------------------------------------------------------
writeNewDict:
* call *SUB.LOCK.AND.WRITE.R1(R.JPL, 'JPL', Today)
return
*------------------------------------------------------------------------------
theEnd:
call *HEADER.CLEAR.R1
END
_______________________________________________
U2-Users mailing list
[email protected]
http://listserver.u2ug.org/mailman/listinfo/u2-users
