COMPILATION LISTING OF SEGMENT write_billing_summary Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 09/18/84 1243.0 mst Tue Options: optimize map 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 write_billing_summary: proc; 12 13 /* This program writes a summary report, one line per requisition. 14* It is a print pass over "reqfile" after "charge_accts" has been run. 15* 16* inputs: 17* . "reqfile" per-account requisition info 18* 19* outputs: 20* . "sumry" one line per requisition showing status & charges 21* THVV 11/69 */ 22 /* Modified Feb 1980 by M. B. Armstrong to remove invalid (and useless) call to get prices. */ 23 24 dcl ec fixed bin (17), /* file-system error code */ 25 subacct1_exit fixed bin, 26 (i, j) fixed bin (17), /* counters */ 27 old_reqno char (12) aligned, /* project names */ 28 old_acctno char (12) aligned, /* temp account name */ 29 ocutoff fixed bin (71), 30 (coxx, dpxx) char (4) aligned, /* junk args to "system_info_" */ 31 (cods, dpds) char (120) aligned, /* Comapny name & department name for header */ 32 dtemp char (8) aligned, /* ... */ 33 (rv, rb) char (15) aligned, /* ... */ 34 (account_total (4), grand_total (4)) float bin (27), /* totals for summary page */ 35 open char (15) aligned internal static init (" open"), 36 month (12) char (12) aligned int static init 37 ("January", "February", "March", "April", "May", "June", "July", 38 "August", "September", "October", "November", "December"), 39 (mm, dd, year) fixed bin (17), /* converted args */ 40 pp ptr, /* ptr to "projfile" */ 41 qp ptr, /* ptr to "reqfile" */ 42 page fixed bin (17), /* page number */ 43 bchr char (i) unal based (ap), /* pickup args */ 44 ap ptr, 45 user_count fixed bin (17) init (0); /* number of users this proj */ 46 47 dcl (null, substr) builtin; 48 49 dcl sumry char (32) int static aligned init ("sumry"); /* Streamname on which output is written */ 50 51 52 /* format statements */ 53 54 dcl l3 char (48) aligned int static init 55 ("^-^-^-Multics ^a for the month of ^a, 19^d^/"), 56 xl1 char (72) int static aligned init 57 ("^-^-^-The following charges have been billed to account no. ^a^/^/^/"), 58 xl2a char (90) aligned int static init 59 ("^-^-^4xRequisition^8xCharge^10xRequisition^8xCharge^9xRequisition Termination"), 60 xl2b char (80) aligned int static init 61 ("^-^14a or PO no.^8xthis month^6xAmount^13xthis req.^6xBalance^6xDate"), 62 xl3 char (60) aligned int static init 63 ("^/^-^12a ^12a ^15a ^15a ^15a ^15a ^8a"), 64 dashx char (120) aligned int static init 65 ("^/^------------- ------------^3x--------------^3x--------------^3x--------------^3x-------------- --------"); 66 67 /* procedures called by this program */ 68 69 dcl get_wdir_ entry returns (char (168) aligned), 70 ioa_ entry options (variable), 71 ioa_$ioa_stream entry options (variable), 72 system_info_$titles entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned), 73 cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin), 74 date_time_ ext entry (fixed bin (71), char (*) aligned), 75 cv_$mwvf ext entry (float bin (27)) returns (char (15) aligned), /* dollar converter */ 76 cv_dec_check_ entry (char (*) unal, fixed bin) returns (fixed bin), /* ASCII to binary */ 77 hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, 78 fixed bin (1), fixed bin (2), ptr, fixed bin), 79 hcs_$terminate_noname entry (ptr, fixed bin), 80 com_err_ entry options (variable); 81 1 1 /* Requisition file declaration */ 1 2 /* Modified BIM 1984-07-10 for unaligned strings */ 1 3 /* Modified BIM 1984-09-14 foor 3000 size-array */ 1 4 1 5 dcl 1 reqfile based (qp) aligned, /* MIT accounting data */ 1 6 2 nacts fixed, 1 7 2 version fixed bin, 1 8 2 pad (6) bit (36) aligned, 1 9 2 reqfiletab (3000), /* one entry per Multics account */ 1 10 /* same size as projfile */ 1 11 3 acctid char (12) unal, /* account id. usually same as Proj */ 1 12 3 mitacct char (12) unal, /* MIT account no. */ 1 13 3 reqno char (12) unal, /* requisition or PO no. */ 1 14 3 qflag char (8), /* class & activity */ 1 15 3 procssd fixed bin, /* temp for usage report */ 1 16 3 qdn fixed bin (71), /* date on for account */ 1 17 3 qdf fixed bin (71), /* date off */ 1 18 3 billing_name char (32) unal, /* where to send bill */ 1 19 3 billing_addr char (32) unal, 1 20 3 chg_mo float bin (63), /* charges this month */ 1 21 3 chg_tr float bin (63), /* charges this req */ 1 22 3 req_amt float bin (63), /* req face value */ 1 23 3 cutoff fixed bin (71); /* term date for req */ 1 24 1 25 dcl loqh int static fixed bin (17) init (8), /* length of reqfile head */ 1 26 loqe int static fixed bin (17) init (40); /* lth of reqfile entry */ 1 27 1 28 declare REQFILE_VERSION fixed bin init (2) int static options (constant); 1 29 1 30 /* End include file reqfile.incl.pl1 */ 82 83 84 /* ====================================================================================================== */ 85 86 call system_info_$titles (coxx, dpxx, cods, dpds); /* Get installation ID */ 87 88 call cu_$arg_ptr (1, ap, i, ec); /* get date */ 89 if ec ^= 0 then do; 90 aer: call com_err_ (0, "write_billing_summary", "argument error. mm yy"); 91 return; 92 end; 93 mm = cv_dec_check_ (bchr, ec); /* Convert month to binary. */ 94 if ec ^= 0 then go to aer; 95 if mm > 12 then go to aer; /* Check for legality. */ 96 call cu_$arg_ptr (2, ap, i, ec); /* Get second argument. */ 97 if ec ^= 0 then go to aer; 98 year = cv_dec_check_ (bchr, ec); /* Convert year to binary */ 99 if ec ^= 0 then go to aer; 100 if year < 69 then go to aer; /* Check. */ 101 102 call hcs_$initiate ((get_wdir_ ()), "reqfile", "", 0, 1, qp, ec); 103 if qp = null then do; 104 err: call com_err_ (ec, "write_billing_summary", "reqfile"); 105 return; 106 end; 107 108 account_total (1), account_total (2), account_total (3), account_total (4) = 0.0e0; /* zero counters */ 109 grand_total (1), grand_total (2), grand_total (3), grand_total (4) = 0.0e0; /* Clear grand total. */ 110 call ioa_$ioa_stream (sumry, "^|^-^-^a^/", cods); /* heading on summary */ 111 call ioa_$ioa_stream (sumry, "^-^-^-^a^/", dpds); 112 call ioa_$ioa_stream (sumry, l3, "billing summary", month (mm), year); 113 call ioa_$ioa_stream (sumry, xl2a); 114 call ioa_$ioa_stream (sumry, xl2b, "Account"); 115 call ioa_$ioa_stream (sumry, dashx); 116 117 old_reqno = ""; 118 old_acctno = ""; 119 do i = 1 to reqfile.nacts; 120 if qdf (i) ^= 0 then if chg_mo (i) = 0.0e0 then go to skipb; 121 if mitacct (i) = "nonbill" then go to skipb; 122 if acctid (i) = "" then go to skipb; /* skip deleted acct */ 123 if reqno (i) ^= old_reqno | mitacct (i) ^= old_acctno then do; 124 subacct1_exit = 1; 125 go to subacct1; /* pseudocall */ 126 subacct1_ret1: account_total (1), account_total (2), account_total (3), account_total (4) = 0.0e0; 127 old_reqno = reqno (i); 128 old_acctno = mitacct (i); 129 ocutoff = cutoff (i); 130 end; 131 account_total (1) = account_total (1) + chg_mo (i); /* Add up charges this month. */ 132 account_total (2) = account_total (2) + req_amt (i); /* Add up face amount. */ 133 account_total (3) = account_total (3) + chg_tr (i) + chg_mo (i); /* Calculate charges this req. */ 134 if req_amt (i) > 0.0e0 then account_total (4) = account_total (4) + req_amt (i) - chg_tr (i) - chg_mo (i); 135 skipb: end; 136 subacct1_exit = 2; 137 go to subacct1; 138 subacct1_ret2: call ioa_$ioa_stream (sumry, dashx); /* Write final line of dashes. */ 139 call ioa_$ioa_stream (sumry, xl3, "", "", cv_$mwvf (grand_total (1)), cv_$mwvf (grand_total (2)), 140 cv_$mwvf (grand_total (3)), cv_$mwvf (grand_total (4)), ""); 141 142 143 144 call ioa_ ("End of billing summary. Grand total ^a", cv_$mwvf (grand_total (1))); 145 146 call hcs_$terminate_noname (qp, ec); /* Terminate reqfile. */ 147 return; /* FINAL EXIT */ 148 149 /* - - - - - - - */ 150 151 subacct1: 152 if old_reqno = "" then go to subx; 153 if account_total (2) = 0.0e0 then do; /* Check for OPEN */ 154 rv, rb = open; 155 end; 156 else do; /* ... no */ 157 rv = cv_$mwvf (account_total (2)); 158 rb = cv_$mwvf (account_total (4)); 159 end; 160 call date_time_ (ocutoff, dtemp); 161 call ioa_$ioa_stream (sumry, xl3, old_acctno, old_reqno, /* Write account line. */ 162 cv_$mwvf (account_total (1)), rv, cv_$mwvf (account_total (3)), rb, dtemp); 163 164 skipp: do j = 1 to 4; /* Add up grand total, reset account total */ 165 grand_total (j) = grand_total (j) + account_total (j); 166 end; 167 168 subx: if subacct1_exit = 1 then go to subacct1_ret1; 169 else go to subacct1_ret2; 170 171 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/18/84 0802.8 write_billing_summary.pl1 >special_ldd>online>09/18/84>write_billing_summary.pl1 82 1 09/18/84 1000.6 reqfile.incl.pl1 >special_ldd>online>09/18/84>reqfile.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. account_total 000224 automatic float bin(27) array dcl 24 set ref 108* 108* 108* 108* 126* 126* 126* 126* 131* 131 132* 132 133* 133 134* 134 153 157* 158* 161* 161* 161* 161* 165 acctid 10 based char(12) array level 3 packed unaligned dcl 1-5 ref 122 ap 000240 automatic pointer dcl 24 set ref 88* 93 96* 98 bchr based char unaligned dcl 24 set ref 93* 98* chg_mo 50 based float bin(63) array level 3 dcl 1-5 ref 120 131 133 134 chg_tr 52 based float bin(63) array level 3 dcl 1-5 ref 133 134 cods 000116 automatic char(120) dcl 24 set ref 86* 110* com_err_ 000254 constant entry external dcl 69 ref 90 104 coxx 000114 automatic char(4) dcl 24 set ref 86* cu_$arg_ptr 000240 constant entry external dcl 69 ref 88 96 cutoff 56 based fixed bin(71,0) array level 3 dcl 1-5 ref 129 cv_$mwvf 000244 constant entry external dcl 69 ref 139 139 139 139 139 139 139 139 144 144 157 158 161 161 161 161 cv_dec_check_ 000246 constant entry external dcl 69 ref 93 98 dashx 000172 internal static char(120) initial dcl 54 set ref 115* 138* date_time_ 000242 constant entry external dcl 69 ref 160 dpds 000154 automatic char(120) dcl 24 set ref 86* 111* dpxx 000115 automatic char(4) dcl 24 set ref 86* dtemp 000212 automatic char(8) dcl 24 set ref 160* 161* ec 000100 automatic fixed bin(17,0) dcl 24 set ref 88* 89 93* 94 96* 97 98* 99 102* 104* 146* get_wdir_ 000230 constant entry external dcl 69 ref 102 grand_total 000230 automatic float bin(27) array dcl 24 set ref 109* 109* 109* 109* 139* 139* 139* 139* 139* 139* 139* 139* 144* 144* 165* 165 hcs_$initiate 000250 constant entry external dcl 69 ref 102 hcs_$terminate_noname 000252 constant entry external dcl 69 ref 146 i 000102 automatic fixed bin(17,0) dcl 24 set ref 88* 93 93 96* 98 98 119* 120 120 121 122 123 123 127 128 129 131 132 133 133 134 134 134 134* ioa_ 000232 constant entry external dcl 69 ref 144 ioa_$ioa_stream 000234 constant entry external dcl 69 ref 110 111 112 113 114 115 138 139 161 j 000103 automatic fixed bin(17,0) dcl 24 set ref 164* 165 165 165* l3 000064 internal static char(48) initial dcl 54 set ref 112* mitacct 13 based char(12) array level 3 packed unaligned dcl 1-5 ref 121 123 128 mm 000234 automatic fixed bin(17,0) dcl 24 set ref 93* 95 112 month 000010 internal static char(12) initial array dcl 24 set ref 112* nacts based fixed bin(17,0) level 2 dcl 1-5 ref 119 null builtin function dcl 47 ref 103 ocutoff 000112 automatic fixed bin(71,0) dcl 24 set ref 129* 160* old_acctno 000107 automatic char(12) dcl 24 set ref 118* 123 128* 161* old_reqno 000104 automatic char(12) dcl 24 set ref 117* 123 127* 151 161* open 000000 constant char(15) initial dcl 24 ref 154 qdf 26 based fixed bin(71,0) array level 3 dcl 1-5 ref 120 qp 000236 automatic pointer dcl 24 set ref 102* 103 119 120 120 121 122 123 123 127 128 129 131 132 133 133 134 134 134 134 146* rb 000220 automatic char(15) dcl 24 set ref 154* 158* 161* req_amt 54 based float bin(63) array level 3 dcl 1-5 ref 132 134 134 reqfile based structure level 1 dcl 1-5 reqfiletab 10 based structure array level 2 dcl 1-5 reqno 16 based char(12) array level 3 packed unaligned dcl 1-5 ref 123 127 rv 000214 automatic char(15) dcl 24 set ref 154* 157* 161* subacct1_exit 000101 automatic fixed bin(17,0) dcl 24 set ref 124* 136* 168 sumry 000054 internal static char(32) initial dcl 49 set ref 110* 111* 112* 113* 114* 115* 138* 139* 161* system_info_$titles 000236 constant entry external dcl 69 ref 86 user_count 000242 automatic fixed bin(17,0) initial dcl 24 set ref 24* xl2a 000100 internal static char(90) initial dcl 54 set ref 113* xl2b 000127 internal static char(80) initial dcl 54 set ref 114* xl3 000153 internal static char(60) initial dcl 54 set ref 139* 161* year 000235 automatic fixed bin(17,0) dcl 24 set ref 98* 100 112* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. REQFILE_VERSION internal static fixed bin(17,0) initial dcl 1-28 dd automatic fixed bin(17,0) dcl 24 loqe internal static fixed bin(17,0) initial dcl 1-25 loqh internal static fixed bin(17,0) initial dcl 1-25 page automatic fixed bin(17,0) dcl 24 pp automatic pointer dcl 24 substr builtin function dcl 47 xl1 internal static char(72) initial dcl 54 NAMES DECLARED BY EXPLICIT CONTEXT. aer 000156 constant label dcl 90 ref 94 95 97 99 100 err 000376 constant label dcl 104 skipb 000756 constant label dcl 135 ref 120 121 122 skipp 001324 constant label dcl 164 subacct1 001153 constant label dcl 151 ref 125 137 subacct1_ret1 000704 constant label dcl 126 ref 168 subacct1_ret2 000763 constant label dcl 138 ref 169 subx 001337 constant label dcl 168 ref 151 write_billing_summary 000105 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1504 1762 1343 1514 Length 2214 1343 256 215 140 220 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME write_billing_summary 280 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 month write_billing_summary 000054 sumry write_billing_summary 000064 l3 write_billing_summary 000100 xl2a write_billing_summary 000127 xl2b write_billing_summary 000153 xl3 write_billing_summary 000172 dashx write_billing_summary STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME write_billing_summary 000100 ec write_billing_summary 000101 subacct1_exit write_billing_summary 000102 i write_billing_summary 000103 j write_billing_summary 000104 old_reqno write_billing_summary 000107 old_acctno write_billing_summary 000112 ocutoff write_billing_summary 000114 coxx write_billing_summary 000115 dpxx write_billing_summary 000116 cods write_billing_summary 000154 dpds write_billing_summary 000212 dtemp write_billing_summary 000214 rv write_billing_summary 000220 rb write_billing_summary 000224 account_total write_billing_summary 000230 grand_total write_billing_summary 000234 mm write_billing_summary 000235 year write_billing_summary 000236 qp write_billing_summary 000240 ap write_billing_summary 000242 user_count write_billing_summary THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr cv_$mwvf cv_dec_check_ date_time_ get_wdir_ hcs_$initiate hcs_$terminate_noname ioa_ ioa_$ioa_stream system_info_$titles NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000104 24 000112 86 000113 88 000135 89 000154 90 000156 91 000213 93 000214 94 000237 95 000241 96 000244 97 000263 98 000265 99 000310 100 000312 102 000315 103 000372 104 000376 105 000427 108 000430 109 000435 110 000441 111 000467 112 000514 113 000553 114 000570 115 000613 117 000630 118 000633 119 000636 120 000645 121 000655 122 000663 123 000670 124 000701 125 000703 126 000704 127 000711 128 000722 129 000730 131 000732 132 000740 133 000743 134 000747 135 000756 136 000760 137 000762 138 000763 139 001000 144 001110 146 001141 147 001152 151 001153 153 001157 154 001161 155 001175 157 001176 158 001207 160 001220 161 001235 164 001324 165 001331 166 001335 168 001337 169 001342 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved