h37765
s 00018/00004/00053
d D 1.2 83/01/31 23:09:22 mjb 2 1
c fixed bug which allowed multiple - + and .
e
s 00057/00000/00000
d D 1.1 83/01/20 11:14:10 tes 1 0
c date and time created 83/01/20 11:14:10 by tes
e
u
tes
mjb
U
t
T
I 1
subroutine qgetd (item, string)
########################################################################
#                                                                      #
#          THIS MATERIAL IS CONFIDENTIAL AND IS FURNISHED UNDER        #
#          A WRITTEN LICENSE AGREEMENT.  IT MAY NOT BE USED,           #
#          COPIED OR DISCLOSED TO OTHERS EXCEPT IN ACCORDANCE          #
#          WITH THE TERMS OF THAT AGREEMENT.                           #
#                                                                      #
#          COPYRIGHT (C) 1982 GRAPHIC SOFTWARE SYSTEMS INC.            #
#          ALL RIGHTS RESERVED.                                        #
#                                                                      #
#     Function: Get decimal data from memory associated with item      #
#                                                                      #
#     Input Parameters:                                                #
#            item - (integer) data item to fetch from memory           #
#                                                                      #
#     Output Parameters:                                               #
#            string - (byte array) containg encoded real data          #
#                                                                      #
#     Routines Called:                                                 #
#            qgtdta - get data from memory                             #
#            pck4b   - function to encode 2 characters per byte        #
#                                                                      #
########################################################################
SHORTINT string(1)
integer item

D 2
SHORTINT buffer(CHARxREALxLENGTH), c1, c2, j1 ,j2, i
E 2
I 2
SHORTINT buffer(CHARxREALxLENGTH), c1, c2, j1 ,j2, i, period
E 2
SHORTINT pck4b

include(`mnucom')

call qgtdta (item, buffer)

I 2
period = NO

E 2
j1 = 1
while (buffer(j1) == BLANK & j1 < CHARxREALxLENGTH) j1 = j1 + 1

do i=1, DATAxREALxLENGTH {
   j2 = j1 + 1
   c2 = NUL
   c1 = buffer(j1)
D 2
   if (c1 == BLANK) c1 = NUL
E 2
I 2
   call ckvald (i, c1, period)
E 2
   if (c1 != NUL) {
      c1 = c1 - STAR
D 2

E 2
      c2 = buffer(j2)
D 2
      if (c2 == BLANK) c2 = NUL
E 2
I 2
      call ckvald (i+1, c2, period)
E 2
      if (c2 != NUL) c2 = c2 - STAR
I 2
      else if (c1 == 1 | c1 == 3) c1 = NUL
E 2
      }

   string(i) = pck4b (c1, c2)
   j1 = j1 + 2
   if (c2 == NUL) break
   }
I 2

return
end
subroutine ckvald (count, char, period)
SHORTINT char, period, count

   if (char == BLANK) char = NUL
   if ((char == MINUS | char == PLUS) & count > 1) char = NUL
   if (char == PERIOD) {
      if (period == NO) period = YES
      else char = NUL
      }
E 2

return
end
E 1
