1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 misc: charge:  proc;
 12 
 13 dcl  descn char (168) aligned,
 14     en char (32),
 15     (char8, char8a) char (8) aligned init (""),
 16     (date1, date2) fixed bin(71),
 17      instr char(28),
 18      pamt pic "(7)$v.99cr",
 19     (i, j, n) fixed bin,
 20      time fixed bin (71),
 21      ap ptr,
 22      al fixed bin,
 23      bchr char (al) unaligned based (ap),
 24      acredit bit(1) aligned init("1"b),
 25      amt float bin,
 26      proj char (12) aligned,
 27      pp ptr,
 28      (p1,p2 ) ptr,
 29      miscfilep ptr,
 30      ec fixed bin(35);
 31 
 32 dcl (null, addr, rel, bin, fixed, dec, round, substr, verify, search) builtin;
 33 
 34 dcl  movew(nmove) fixed bin based,
 35      (nmove, lomh, lome) fixed bin;
 36 
 37 dcl  clock_ entry () returns (fixed bin (71)),
 38      get_wdir_ entry () returns (char (168)),
 39      cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin),
 40      ioa_ entry options (variable),
 41      date_time_ entry (fixed bin (71), char (*) aligned),
 42      convert_date_to_binary_$relative entry(char(*),fixed bin(71), fixed bin(71), fixed bin(35)),
 43      com_err_ entry options (variable),
 44      hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1),
 45      fixed bin (2), ptr, fixed bin(35)),
 46      hcs_$make_seg entry(char(*),char(*),char(*),fixed bin(5),ptr,fixed bin(35)),
 47      hcs_$terminate_noname entry (ptr, fixed bin(35)),
 48      hcs_$delentry_seg entry(ptr, fixed bin(35)),
 49      ask_$ask_clr entry options (variable),
 50      ask_$ask_flo entry options (variable),
 51      ask_$ask_int entry options (variable),
 52      ask_ entry options (variable),
 53      ask_$ask_line entry options (variable);
 54 
 55 
 56 %include miscfile;
 57 
 58 %include projfile;
 59 
 60 /* ====================================================== */
 61 
 62           acredit="0"b;
 63 
 64 credit:   entry;
 65 
 66           en = "projfile";
 67           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, pp, ec);
 68           if pp = null then do;
 69 er:            call com_err_ (ec, "misc", en);
 70                return;
 71           end;
 72           en = "miscfile";
 73           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
 74           if miscfilep = null then go to er;
 75 
 76           time = clock_ ();
 77 
 78 main1:    call ask_$ask_clr;
 79 main:     call ask_ ("^/Project^-", proj);
 80           if proj = "x" then go to exit;
 81 
 82           do i = 1 to nproj;
 83                if proj = id (i) then go to found;
 84           end;
 85           call ioa_ ("misc: project ""^a"" not in projfile.", proj);
 86           go to main1;
 87 
 88 found:    /*  if off (i) ^= 0 then do;
 89                call ioa_ ("misc: project ""^a"" has been deleted.", proj);
 90                go to main1;
 91           end;  */
 92           call ask_$ask_flo ("amount^-", amt);
 93 
 94           call ask_$ask_line ("desc^-", descn);
 95           if descn = "x" then go to main;
 96 
 97           n_misc (i) = n_misc (i) + 1;
 98           if acredit then amt=-amt;
 99           misc_charges (i) = misc_charges (i) + amt;
100 
101           misc_ents = misc_ents + 1;
102           j = misc_ents;
103 
104           mproj (j) = proj;
105           mdate (j) = time;
106           mamt (j) = amt;
107           mdesc (j) = descn;
108 
109           go to main;
110 
111 exit:     call hcs_$terminate_noname (miscfilep, ec);
112           call hcs_$terminate_noname (pp, ec);
113 
114           return;
115 
116 /* - - - - - - - - - - - - - - - - - - - - - - - - - */
117 
118 print_misc: entry;
119 
120 bug:      en = "x";
121           en = "miscfile";
122           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
123           if miscfilep = null then go to er;
124 
125 mainp:    call ask_$ask_clr;
126 mainp1:   call ask_("^/Project^-", proj);
127 mainp2:   call ask_$ask_line("dates^-",instr);
128           if instr="all"
129           then do;
130                date1=mdate(1);
131                date2=mdate(misc_ents);
132                end;
133           else do;
134                i=verify(instr,"/0123456789");
135                j=search(substr(instr,i+1),"0123456789")+i;
136                time=mdate(1)-86400000000;         /* make sure we get beginning of period */
137                call convert_date_to_binary_$relative(substr(instr,1,i-1)||" 0000.",date1,time,ec);
138                if ec^=0
139                then do;
140                     call ioa_("Illegal date ^a",substr(instr,1,i-1));
141                     go to mainp2;
142                     end;
143                if j>i
144                then call convert_date_to_binary_$relative(substr(instr,j)||" 2400.",date2,mdate(1),ec);
145                else date2=date1+86400000000;
146                if ec^=0
147                then do;
148                     call ioa_("Illegal date ^a",substr(instr,j));
149                     go to mainp2;
150                     end;
151                end;
152 
153           amt = 0.0e0;
154           n=0;
155           do i = 1 to misc_ents while(mdate(i)<=date2);
156                call date_time_ (mdate (i), char8);
157                if (proj="all"&mproj(i)^="")|proj=mproj(i)
158                then if mdate(i)>=date1
159                     then do;
160                          if char8 = char8a then char8 = "";
161                          else char8a = char8;
162                          pamt=round(fixed(dec(mamt(i)),14,8),2);                /* form picture representation */
163                          call ioa_ ("^8a ^5d    ^12a ^12a ^a", char8, i, mproj (i), pamt, mdesc (i));
164                          amt = amt + mamt (i);
165                          n=n+1;
166                          end;
167           end;
168           if n=0
169           then call ioa_("No entries matching project and date");
170           else if proj="all"&instr="all"
171                then do;
172                     pamt=round(fixed(dec(amt),14,8),2);               /* picture representation */
173                     call ioa_("^/Total:^24x ^12a^/^d entries in ""miscfile""",pamt,n);
174                     end;
175 
176           call hcs_$terminate_noname (miscfilep, ec);
177           return;
178 
179 /* ------------------------------------------ */
180 
181 print_all_miscs:    entry;
182 
183           en = "miscfile";
184           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
185           if miscfilep = null then go to er;
186 
187           amt = 0.0e0;
188           n=0;
189           do i = 1 to misc_ents;
190                if mproj(i)^=""
191                then do;
192                     call date_time_ (mdate (i), char8);
193                     if char8 = char8a then char8 = "";
194                     else char8a = char8;
195                     pamt=round(fixed(dec(mamt(i)),14,8),2); /* form picture representation */
196                     call ioa_ ("^8a ^5d    ^12a ^12a ^a", char8, i, mproj (i), pamt, mdesc (i));
197                     amt = amt + mamt (i);
198                     n=n+1;
199                     end;
200                end;
201           pamt=round(fixed(dec(amt),14,8),2);     /* picture representation */
202           call ioa_("^/Total:^24x ^12a^/^d entries in ""miscfile""",pamt,n);
203           call hcs_$terminate_noname (miscfilep, ec);
204           return;
205 
206 /* - - - - - - - - - - - - - */
207 
208 reset_misc: entry;
209 
210           en = "projfile";
211           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, pp, ec);
212           if pp = null then go to er;
213           do i = 1 to nproj;
214                misc_charges (i) = 0.0e0;
215                n_misc (i) = 0;
216           end;
217 
218           call hcs_$terminate_noname (pp, ec);
219           return;
220 
221 /* ------------------------------------------------------ */
222 
223 dmisc:    entry;
224 
225           en = "projfile";
226           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, pp, ec);
227           if pp=null then go to er;
228           en = "miscfile";
229           call hcs_$initiate ((get_wdir_ ()), en, "", 0, 1, miscfilep, ec);
230           if miscfilep=null then go to er;
231 
232 
233 maind:    call ask_$ask_clr;
234 maind1:   call ask_("^/Project^-",proj);
235           if proj="x" then go to exit;
236           do i=1 to nproj;
237                if proj=id(i) then go to foundd;
238                end;
239           call ioa_("misc: project ""^a"" not in projfile.",proj);
240           go to maind;
241 
242 foundd:   call ask_$ask_int("Number^-",j);
243           if j>misc_ents|j<1
244           then do;
245                call ioa_("Entry number ^d not in miscfile",j);
246                go to maind;
247                end;
248           if mproj(j)=""&mamt(j)=0.0e0
249           then do;
250                call ioa_("Entry number ^d has already been deleted",j);
251                go to maind;
252                end;
253           if mproj(j)^=proj
254           then do;
255                call ioa_("Entry number ^d not charged to project ^a",j,proj);
256                go to maind;
257                end;
258           n_misc(i)=n_misc(i)-1;
259           misc_charges(i)=misc_charges(i)-mamt(j);
260           if n_misc(i)=0 then misc_charges(i)=0.0e0;
261           mamt(j)=0;
262           mproj(j)="";
263           go to maind;
264 
265      end misc;