amount in words in cobol any built in function
in [Cobol]
|
Prev: New to COBOL
Next: RosettaCode
From: e p chandler on 9 Aug 2010 15:47 On Aug 8, 5:20 am, "sharad kumar.j" <aryansmit3...(a)gmail.com> wrote: > hi, > I hhave started my programming in cobol and i'm 3 weeks old.I would > like to know that is there any built in function to convert amount in > number to words > eg:345 > as > three hundred and forty five.... a Google search on cobol dollar amount to words should be very helpful to you.
From: Charles Hottel on 9 Aug 2010 20:22 "e p chandler" <epc8(a)juno.com> wrote in message news:1c92f294-4b33-4423-b769-8243add7d9b8(a)g33g2000yqc.googlegroups.com... On Aug 8, 5:20 am, "sharad kumar.j" <aryansmit3...(a)gmail.com> wrote: > hi, > I hhave started my programming in cobol and i'm 3 weeks old.I would > like to know that is there any built in function to convert amount in > number to words > eg:345 > as > three hundred and forty five.... >>a Google search on >>cobol dollar amount to words >>should be very helpful to you. 000010 @OPTIONS MAIN,TEST 000020 Identification Division. 000030 Program-Id. Cutenum. 000040* By Thane Hubbell - 01/15/1999 000041* Compiled and Tested under Fujitsu COBOL 000042 Environment Division. 000050 Configuration Section. 000060 Source-Computer. IBM-PC. 000070 Object-Computer. IBM-PC. 000080 Data Division. 000090 Working-Storage Section. 000252 01 The-Number Pic 9(9) Value Zeros. 000254 01 Text-Field Pic X(200) Value Spaces. 000255 01 Number-Descriptions. 000256 03 Table-Area-Low. 000257 05 Filler Pic X(8) Value "One". 000258 05 Filler Pic X(8) Value "Two". 000259 05 Filler Pic X(8) Value "Three". 000260 05 Filler Pic X(8) Value "Four". 000261 05 Filler Pic X(8) Value "Five". 000262 05 Filler Pic X(8) Value "Six". 000263 05 Filler Pic X(8) Value "Seven". 000264 05 Filler Pic X(8) Value "Eight". 000265 05 Filler Pic X(8) Value "Nine". 000266 05 Filler Pic X(8) Value "Ten". 000267 05 Filler Pic X(8) Value "Eleven". 000268 05 Filler Pic X(8) Value "Twelve". 000269 05 Filler Pic X(8) Value "Thirteen". 000270 03 Low-Numbers Redefines Table-Area-Low. 000271 05 Low-Number Pic X(8) Occurs 13 Times. 000272 03 Table-Area-Secondary. 000273 05 Filler Pic X(7) Value Spaces. 000274 05 Filler Pic X(7) Value "Twenty". 000275 05 Filler Pic X(7) Value "Thirty". 000276 05 Filler Pic X(7) Value "Fourty". 000277 05 Filler Pic X(7) Value "Fifty". 000278 05 Filler Pic X(7) Value "Sixty". 000279 05 Filler Pic X(7) Value "Seventy". 000280 05 Filler Pic X(7) Value "Eighty". 000281 05 Filler Pic X(7) Value "Ninety". 000282 03 Secondary-Numbers Redefines Table-Area-Secondary. 000283 05 Secondary-Number Pic X(7) Occurs 9 Times. 000284 03 Table-Area-Ante. 000285 05 Filler Pic X(8) Value Spaces. 000286 05 Filler Pic X(8) Value "Million". 000287 05 Filler Pic X(8) Value Spaces. 000288 05 Filler Pic X(8) Value "Thousand". 000289 05 Filler Pic X(8) Value Spaces. 000290 05 Filler Pic X(8) Value Spaces. 000292 03 Ante-Numbers Redefines Table-Area-Ante. 000293 05 Ante-Number Pic X(8) Occurs 6 Times. 000294 01 Cntr Pic 99 Value Zeros. 000295 01 String-Pointer Pic 99 Value 1. 000296 01 Digits Pic 9 Value Zeros. 000297 01 Offset Pic 9 Value Zeros. 000298 01 Offset-Value Pic 9v9 Value Zeros. 000299 01 Test-Num Pic 99 Value Zeros. 000300 01 Second-Num Pic 99 Value Zeros. 000301 01 Ante-Flag Pic X Value Spaces. 000302 88 Print-Ante Value "Y". 000303 88 No-Print-Ante Value Spaces. 000304 Screen Section. 000305 01 Main-Screen 000306 Blank Screen, Auto, Required, 000307 Foreground-Color Is 7, 000308 Background-Color Is 1. 000309 03 Line 1 Column 1 Value "Enter Amount". 000310 03 Line 3 Column 1 Value "Result ". 000311 03 Line 1 Column 14 Pic 9(9) Using The-Number. 000312 03 Line 4 Column 1 Pic X(80) From Text-Field. 000313 Procedure Division. 000314 Cutenum-Start. 000315 Display Main-Screen 000316 Accept Main-Screen 000324 Perform Varying Cntr From 1 By 1 Until Cntr > 6 000325 If Digits = 2 000326 Subtract 1 From Digits 000327 Else 000328 Add 1 To Digits 000329 End-If 000330 Move Offset-Value to Offset 000331 Add .5 to Offset-Value 000332 Compute Test-Num = 000334 Function Numval (The-Number (Cntr + Offset:Digits)) 000335 Evaluate Digits Also Test-Num 000338 When 1 Also 1 Thru 9 000339 String Low-Number (Test-Num) 000340 Delimited By Space 000341 " Hundred " Delimited By Size 000342 Into Text-Field 000343 Pointer String-Pointer 000344 Set Print-Ante To True 000345 When 2 Also 1 Thru 9 000346 String Low-Number (Test-Num) 000347 Delimited by Space 000348 Space Delimited by Size 000349 Into Text-Field 000350 Pointer String-Pointer 000351 Set Print-Ante To True 000352 When 2 Also 10 Thru 13 000353 String Low-Number (Test-Num) 000354 Delimited By Space 000355 Space Delimited By Size 000356 Into Text-Field 000357 Pointer String-Pointer 000358 Set Print-Ante To True 000359 When 2 Also 14 Thru 19 000360 Compute Second-Num = 000361 Function Rem (Test-Num 10) 000362 String Low-Number (Second-Num) 000363 "teen" Delimited By Space 000364 Space Delimited by Size 000365 Into Text-Field 000366 Pointer String-Pointer 000367 Set Print-Ante To True 000368 When 2 Also 20 Thru 99 000369 Move Test-Num To Second-Num 000370 Move "0" To Second-Num (2:1) 000371 Subtract Second-Num From Test-Num 000372 Divide Second-Num By 10 Giving Second-Num 000373 String Secondary-Number (Second-Num) 000374 Low-Number (Test-Num) 000375 Delimited By Space 000376 Space Delimited By Size 000377 Into Text-Field 000378 Pointer String-Pointer 000379 Set Print-Ante To True 000380 End-Evaluate 000381 If Digits = 2 And Print-Ante 000382 String Ante-Number (Cntr) 000383 Delimited By Space 000384 Space Delimited By Size 000385 Into Text-Field 000386 Pointer String-Pointer 000387 Set No-Print-Ante To True 000388 End-if 000389 End-Perform 000390 Display Main-Screen 000391 Display Text-Field Upon Console 000460 Stop Run.
From: Pete Dashwood on 10 Aug 2010 05:55 Charles Hottel wrote: > "e p chandler" <epc8(a)juno.com> wrote in message > news:1c92f294-4b33-4423-b769-8243add7d9b8(a)g33g2000yqc.googlegroups.com... > On Aug 8, 5:20 am, "sharad kumar.j" <aryansmit3...(a)gmail.com> wrote: >> hi, >> I hhave started my programming in cobol and i'm 3 weeks old.I would >> like to know that is there any built in function to convert amount in >> number to words >> eg:345 >> as >> three hundred and forty five.... > >>> a Google search on > >>> cobol dollar amount to words > >>> should be very helpful to you. > > 000010 @OPTIONS MAIN,TEST > 000020 Identification Division. > 000030 Program-Id. Cutenum. > 000040* By Thane Hubbell - 01/15/1999 > 000041* Compiled and Tested under Fujitsu COBOL > 000042 Environment Division. > 000050 Configuration Section. > 000060 Source-Computer. IBM-PC. > 000070 Object-Computer. IBM-PC. > 000080 Data Division. > 000090 Working-Storage Section. > 000252 01 The-Number Pic 9(9) Value Zeros. > 000254 01 Text-Field Pic X(200) Value Spaces. > 000255 01 Number-Descriptions. > 000256 03 Table-Area-Low. > 000257 05 Filler Pic X(8) Value "One". > 000258 05 Filler Pic X(8) Value "Two". > 000259 05 Filler Pic X(8) Value "Three". > 000260 05 Filler Pic X(8) Value "Four". > 000261 05 Filler Pic X(8) Value "Five". > 000262 05 Filler Pic X(8) Value "Six". > 000263 05 Filler Pic X(8) Value "Seven". > 000264 05 Filler Pic X(8) Value "Eight". > 000265 05 Filler Pic X(8) Value "Nine". > 000266 05 Filler Pic X(8) Value "Ten". > 000267 05 Filler Pic X(8) Value "Eleven". > 000268 05 Filler Pic X(8) Value "Twelve". > 000269 05 Filler Pic X(8) Value "Thirteen". > 000270 03 Low-Numbers Redefines Table-Area-Low. > 000271 05 Low-Number Pic X(8) Occurs 13 Times. > 000272 03 Table-Area-Secondary. > 000273 05 Filler Pic X(7) Value Spaces. > 000274 05 Filler Pic X(7) Value "Twenty". > 000275 05 Filler Pic X(7) Value "Thirty". > 000276 05 Filler Pic X(7) Value "Fourty". > 000277 05 Filler Pic X(7) Value "Fifty". > 000278 05 Filler Pic X(7) Value "Sixty". > 000279 05 Filler Pic X(7) Value "Seventy". > 000280 05 Filler Pic X(7) Value "Eighty". > 000281 05 Filler Pic X(7) Value "Ninety". > 000282 03 Secondary-Numbers Redefines Table-Area-Secondary. > 000283 05 Secondary-Number Pic X(7) Occurs 9 Times. > 000284 03 Table-Area-Ante. > 000285 05 Filler Pic X(8) Value Spaces. > 000286 05 Filler Pic X(8) Value "Million". > 000287 05 Filler Pic X(8) Value Spaces. > 000288 05 Filler Pic X(8) Value "Thousand". > 000289 05 Filler Pic X(8) Value Spaces. > 000290 05 Filler Pic X(8) Value Spaces. > 000292 03 Ante-Numbers Redefines Table-Area-Ante. > 000293 05 Ante-Number Pic X(8) Occurs 6 Times. > 000294 01 Cntr Pic 99 Value Zeros. > 000295 01 String-Pointer Pic 99 Value 1. > 000296 01 Digits Pic 9 Value Zeros. > 000297 01 Offset Pic 9 Value Zeros. > 000298 01 Offset-Value Pic 9v9 Value Zeros. > 000299 01 Test-Num Pic 99 Value Zeros. > 000300 01 Second-Num Pic 99 Value Zeros. > 000301 01 Ante-Flag Pic X Value Spaces. > 000302 88 Print-Ante Value "Y". > 000303 88 No-Print-Ante Value Spaces. > 000304 Screen Section. > 000305 01 Main-Screen > 000306 Blank Screen, Auto, Required, > 000307 Foreground-Color Is 7, > 000308 Background-Color Is 1. > 000309 03 Line 1 Column 1 Value "Enter Amount". > 000310 03 Line 3 Column 1 Value "Result ". > 000311 03 Line 1 Column 14 Pic 9(9) Using The-Number. > 000312 03 Line 4 Column 1 Pic X(80) From Text-Field. > 000313 Procedure Division. > 000314 Cutenum-Start. > 000315 Display Main-Screen > 000316 Accept Main-Screen > 000324 Perform Varying Cntr From 1 By 1 Until Cntr > 6 > 000325 If Digits = 2 > 000326 Subtract 1 From Digits > 000327 Else > 000328 Add 1 To Digits > 000329 End-If > 000330 Move Offset-Value to Offset > 000331 Add .5 to Offset-Value > 000332 Compute Test-Num = > 000334 Function Numval (The-Number (Cntr + Offset:Digits)) > 000335 Evaluate Digits Also Test-Num > 000338 When 1 Also 1 Thru 9 > 000339 String Low-Number (Test-Num) > 000340 Delimited By Space > 000341 " Hundred " Delimited By Size > 000342 Into Text-Field > 000343 Pointer String-Pointer > 000344 Set Print-Ante To True > 000345 When 2 Also 1 Thru 9 > 000346 String Low-Number (Test-Num) > 000347 Delimited by Space > 000348 Space Delimited by Size > 000349 Into Text-Field > 000350 Pointer String-Pointer > 000351 Set Print-Ante To True > 000352 When 2 Also 10 Thru 13 > 000353 String Low-Number (Test-Num) > 000354 Delimited By Space > 000355 Space Delimited By Size > 000356 Into Text-Field > 000357 Pointer String-Pointer > 000358 Set Print-Ante To True > 000359 When 2 Also 14 Thru 19 > 000360 Compute Second-Num = > 000361 Function Rem (Test-Num 10) > 000362 String Low-Number (Second-Num) > 000363 "teen" Delimited By Space > 000364 Space Delimited by Size > 000365 Into Text-Field > 000366 Pointer String-Pointer > 000367 Set Print-Ante To True > 000368 When 2 Also 20 Thru 99 > 000369 Move Test-Num To Second-Num > 000370 Move "0" To Second-Num (2:1) > 000371 Subtract Second-Num From Test-Num > 000372 Divide Second-Num By 10 Giving Second-Num > 000373 String Secondary-Number (Second-Num) > 000374 Low-Number (Test-Num) > 000375 Delimited By Space > 000376 Space Delimited By Size > 000377 Into Text-Field > 000378 Pointer String-Pointer > 000379 Set Print-Ante To True > 000380 End-Evaluate > 000381 If Digits = 2 And Print-Ante > 000382 String Ante-Number (Cntr) > 000383 Delimited By Space > 000384 Space Delimited By Size > 000385 Into Text-Field > 000386 Pointer String-Pointer > 000387 Set No-Print-Ante To True > 000388 End-if > 000389 End-Perform > 000390 Display Main-Screen > 000391 Display Text-Field Upon Console > 000460 Stop Run. > Nice to see you back here Charlie. :-) Couple of quick questions: 1. Are you sure that is public domain? (If it is from Thane's book it is copyright, unless he posts it himself.) 2. Won't it return "fiveteen" for "fifteen"? (Didn't have time to set it up and compile and test it but a cursory glance raised an alarm...) Pete. -- "I used to write COBOL...now I can do anything."
From: Anonymous on 10 Aug 2010 08:16 In article <8ccm12FbsvU1(a)mid.individual.net>, Pete Dashwood <dashwood(a)removethis.enternet.co.nz> wrote: >Charles Hottel wrote: [snip] >> 000040* By Thane Hubbell - 01/15/1999 >> 000041* Compiled and Tested under Fujitsu COBOL [snip] >Nice to see you back here Charlie. :-) > >Couple of quick questions: > >1. Are you sure that is public domain? (If it is from Thane's book it is >copyright, unless he posts it himself.) >2. Won't it return "fiveteen" for "fifteen"? (Didn't have time to set it up >and compile and test it but a cursory glance raised an alarm...) Might not return much of anything, depending on the compiler one uses; I believe that IGYCRCTL might have a bit of difficulty with one of the Sections specified. DD
From: Vince Coen on 10 Aug 2010 16:04
iF6M15) Hello sharad! 08 Aug 10 10:20, sharad kumar.j wrote to All: > I hhave started my programming in cobol and i'm 3 weeks old.I would > like to know that is there any built in function to convert amount in > number to words > eg:345 > as > three hundred and forty five.... Sorry for my previous msg I misread it, here is a program that writes cheques and converts amounts to figures as you seem to need it. Note that it uses the fixed format version of Cobol and that is is rewriten for Open Cobol v1.1. You will need to extract the bits you need. === Cut === 000010******************************************************** 000020* * 000030* Cheque File Writer * 000040* * 000050******************************************************** 000060* 000080 identification division. 000090*================================ 000100* 000110*** 000120 program-id. pl940. 000130*** 000140* Author. V B Coen FBCS, 18/04/84 000150* For Applewood Computers. *** 001400* Security. Copyright (C) 1967-2009, Vincent Bryan Coen. 001500* Distributed under the GNU General Public License 001600* v2.0. Only. See the file COPYING for details. 000160*** 000190* Remarks. Cheque File Writer. 000210*** 000220* Version. See Prog-Name In Ws. 000230* 000240* Called Modules. Maps04. 000250***** * Changes: 002100* 22/03/09 vbc - Migration to Open Cobol v3.00.00 *> *>******************************************************************* *>****** *> *> Copyright Notice. *>***************** *> *> This file/program is part of the Applewood Computers Accounting *> System *> and is copyright (c) Vincent B Coen. 1976 - 2009 and later. *> *> This program is free software; you can redistribute it and/or *> modify it *> under the terms of the GNU General Public License as published by *> the *> Free Software Foundation; version 2 ONLY. *> *> ACAS is distributed in the hope that it will be useful, but *> WITHOUT *> ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *> or *> FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public *> License *> for more details. If it breaks, you own both pieces but I will *> endevor *> to fix it, providing you tell me about the problem. *> *> You should have received a copy of the GNU General Public License *> along *> with ACAS; see the file COPYING. If not, write to the Free *> Software *> Foundation, 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. *>******************************************************************* *>****** *> 000260 environment division. 000270*================================ 000280* 003500 copy "envdiv.cob". 000380 input-output section. 000390*------------------------------- 000400* 000410 file-control. 000420*------------ 000430* 004600 copy "selpl.cob". 000510* 000520 select cheque-file assign file-32-c 000530 organization line sequential. 000540* 005110 copy "selpay.cob". 000620 data division. 000630*================================ 000640* 000650 file section. 000660*------------ 000670* 006500 copy "fdpl.cob". 001230 fd cheque-file. 001260* 001270 01 cheque-record pic x(645). 001330* 007410 copy "fdpay.cob". 001610 working-storage section. 001620*----------------------- 001630 77 prog-name pic x(15) value "PL940 (3.00.02)". 001650* 008000 copy "wsmaps03.cob". 008200 copy "wsfnctn.cob". 008400 copy "wsoi.cob". 002680* 002690 01 ws-data. 002700 03 y pic 99. 002710 03 z pic 99. 002720 03 cheque-nos pic 9(8). 002730 03 pound-flag pic 9 value zero. 002740* 002750 01 files. 000000 copy "file22.cob". 000000 copy "file32.cob". 002840 03 file-32-c pic x(10) value "cheque.dat". 002870* 002880 01 cheque. 002890* 002900* rec size 645 bytes 002910* 002920 03 c-account pic x(7). 002930 03 filler pic x value ",". 002940 03 c-name pic x(30). 002950 03 filler pic x value ",". 002960 03 filler occurs 5. 002970 05 c-address pic x(32). 002980 05 c-adr-filler pic x. 002990 03 c-words-1 pic x(64). 003000 03 filler pic x value ",". 003010 03 c-words-2 pic x(64). 003020 03 filler pic x value ",". 003030 03 c-gross pic z(6)9.99. 003040 03 filler pic x value ",". 03 c-cheque-x. 003050 05 c-cheque pic z(8)9. 003060 03 filler pic x value ",". 003070 03 c-date pic x(10). 003080 03 filler pic x value ",". 003090 03 filler occurs 9. 003100 05 c-inv pic x(10). 003110 05 c-inv-filler pic x. 003120 05 c-folio pic z(7)9 blank when zero. 003130 05 c-folio-fil pic x. 003140 05 c-value pic z(6)9.99 blank when zero. 003150 05 c-last pic x. 003160* 003180 77 test-amount pic 9(7)v99. 003190 77 asterix-fill pic x(64) value all "*". 003200* 003210 01 word-filler. 003220 03 filler pic x(15) value "One*". 003230 03 filler pic x(15) value "Two*". 003240 03 filler pic x(15) value "Three*". 003250 03 filler pic x(15) value "Four*". 003260 03 filler pic x(15) value "Five*". 003270 03 filler pic x(15) value "Six*". 003280 03 filler pic x(15) value "Seven*". 003290 03 filler pic x(15) value "Eight*". 003300 03 filler pic x(15) value "Nine*". 003310 03 filler pic x(15) value "Ten*". 003320 03 filler pic x(15) value "Eleven*". 003330 03 filler pic x(15) value "Twelve*". 003340 03 filler pic x(15) value "Thirteen*". 003350 03 filler pic x(15) value "Fourteen*". 003360 03 filler pic x(15) value "Fifteen*". 003370 03 filler pic x(15) value "Sixteen*". 003380 03 filler pic x(15) value "Seventeen*". 003390 03 filler pic x(15) value "Eighteen*". 003400 03 filler pic x(15) value "Nineteen*". 003410 03 filler pic x(15) value "Twenty*". 003420 03 filler pic x(15) value "Twenty-One*". 003430 03 filler pic x(15) value "Twenty-Two*". 003440 03 filler pic x(15) value "Twenty-Three*". 003450 03 filler pic x(15) value "Twenty-Four*". 003460 03 filler pic x(15) value "Twenty-Five*". 003470 03 filler pic x(15) value "Twenty-Six*". 003480 03 filler pic x(15) value "Twenty-Seven*". 003490 03 filler pic x(15) value "Twenty-Eight*". 003500 03 filler pic x(15) value "Twenty-Nine*". 003510 03 filler pic x(15) value "Thirty*". 003520 03 filler pic x(15) value "Thirty-One*". 003530 03 filler pic x(15) value "Thirty-Two*". 003540 03 filler pic x(15) value "Thirty-Three*". 003550 03 filler pic x(15) value "Thirty-Four*". 003560 03 filler pic x(15) value "Thirty-Five*". 003570 03 filler pic x(15) value "Thirty-Six*". 003580 03 filler pic x(15) value "Thirty-Seven*". 003590 03 filler pic x(15) value "Thirty-Eight*". 003600 03 filler pic x(15) value "Thirty-Nine*". 003610 03 filler pic x(15) value "Forty*". 003620 03 filler pic x(15) value "Forty-One*". 003630 03 filler pic x(15) value "Forty-Two*". 003640 03 filler pic x(15) value "Forty-Three*". 003650 03 filler pic x(15) value "Forty-Four*". 003660 03 filler pic x(15) value "Forty-Five*". 003670 03 filler pic x(15) value "Forty-Six*". 003680 03 filler pic x(15) value "Forty-Seven*". 003690 03 filler pic x(15) value "Forty-Eight*". 003700 03 filler pic x(15) value "Forty-Nine*". 003710 03 filler pic x(15) value "Fifty*". 003720 03 filler pic x(15) value "Fifty-One*". 003730 03 filler pic x(15) value "Fifty-Two*". 003740 03 filler pic x(15) value "Fifty-Three*". 003750 03 filler pic x(15) value "Fifty-Four*". 003760 03 filler pic x(15) value "Fifty-Five*". 003770 03 filler pic x(15) value "Fifty-Six*". 003780 03 filler pic x(15) value "Fifty-Seven*". 003790 03 filler pic x(15) value "Fifty-Eight*". 003800 03 filler pic x(15) value "Fifty-Nine*". 003810 03 filler pic x(15) value "Sixty*". 003820 03 filler pic x(15) value "Sixty-One*". 003830 03 filler pic x(15) value "Sixty-Two*". 003840 03 filler pic x(15) value "Sixty-Three*". 003850 03 filler pic x(15) value "Sixty-Four*". 003860 03 filler pic x(15) value "Sixty-Five*". 003870 03 filler pic x(15) value "Sixty-Six*". 003880 03 filler pic x(15) value "Sixty-Seven*". 003890 03 filler pic x(15) value "Sixty-Eight*". 003900 03 filler pic x(15) value "Sixty-Nine*". 003910 03 filler pic x(15) value "Seventy*". 003920 03 filler pic x(15) value "Seventy-One*". 003930 03 filler pic x(15) value "Seventy-Two*". 003940 03 filler pic x(15) value "Seventy-Three*". 003950 03 filler pic x(15) value "Seventy-Four*". 003960 03 filler pic x(15) value "Seventy-Five*". 003970 03 filler pic x(15) value "Seventy-Six*". 003980 03 filler pic x(15) value "Seventy-Seven*". 003990 03 filler pic x(15) value "Seventy-Eight*". 004000 03 filler pic x(15) value "Seventy-Nine*". 004010 03 filler pic x(15) value "Eighty*". 004020 03 filler pic x(15) value "Eighty-One*". 004030 03 filler pic x(15) value "Eighty-Two*". 004040 03 filler pic x(15) value "Eighty-Three*". 004050 03 filler pic x(15) value "Eighty-Four*". 004060 03 filler pic x(15) value "Eighty-Five*". 004070 03 filler pic x(15) value "Eighty-Six*". 004080 03 filler pic x(15) value "Eighty-Seven*". 004090 03 filler pic x(15) value "Eighty-Eight*". 004100 03 filler pic x(15) value "Eighty-Nine*". 004110 03 filler pic x(15) value "Ninety*". 004120 03 filler pic x(15) value "Ninety-One*". 004130 03 filler pic x(15) value "Ninety-Two*". 004140 03 filler pic x(15) value "Ninety-Three*". 004150 03 filler pic x(15) value "Ninety-Four*". 004160 03 filler pic x(15) value "Ninety-Five*". 004170 03 filler pic x(15) value "Ninety-Six*". 004180 03 filler pic x(15) value "Ninety-Seven*". 004190 03 filler pic x(15) value "Ninety-Eight*". 004200 03 filler pic x(15) value "Ninety-Nine*". 004210 01 filler redefines word-filler. 004220 03 wordn pic x(15) occurs 99. 004230* 004240 linkage section. 004250*=============== 004260* copy "wscall.cob". copy "wssystem.cob". 006170* 006180 01 to-day pic x(10). 006190* 006200 procedure division using ws-calling-data system-record to-day. 006210*============================================================== 006220* 006230 init section. 006290 display " " at 0101 with erase eos. 006300 display prog-name at 0101 with foreground-color 2. 006310 display "Cheque Print File Generation" 006320 at 0128 with foreground-color 2. 006330 display to-day at 0171 with foreground-color 2. 006340* 006350 open input purchase-file. 006370 open i-o pay-file. if fs-reply not = zero display "No data to process. Hit return" at 0401 with foreground-color 2 accept s1 at 0432 close purchase-file goback. 006360 open output cheque-file. 006380 move to-day to u-date. 006390 perform varying z from 1 by 1 until z > 9 008290 move "," to c-inv-filler (z) c-folio-fil (z) 008310 if z < 6 008320 move "," to c-adr-filler (z) end-if end-perform 006410* 006420 display "First Cheque number - [ ]" at 0611 with foreground-color 2. 006430 accept cheque-nos at 0634 with foreground-color 3. 006440 display "Payment date - [ ]" at 0811 with foreground-color 2. 006450* 006460 get-date. 006470********* 006480* 006490 display u-date at 0834 with foreground-color 3. 006500 accept u-date at 0834 with foreground-color 3 update. 006510 move zero to u-bin. 006520 call "maps04" using maps03-ws. 006530 if u-bin = zero 006540 go to get-date. 006550 move u-date to c-date. 006560* 006570 read-purchase. 006580************** 006590* 006600 read pay-file next record 006610 at end go to main-end. 006620* 006630 if pay-gross < .01 006640 go to read-purchase. 006650* 006660 move pay-supl-key to purch-key c-account. 006670 read purchase-file invalid key 006680 move "Missing data" to purch-name purch-address. 006690* 006700 move purch-name to c-name. 006710 move spaces to c-address (1) c-address (2) 006720 c-address (3) c-address (4) c-address (5). 006730 move 1 to z. 006740 perform varying y from 1 by 1 until y > 5 006820 unstring purch-address delimited by pl-delim 006830 into c-address (y) pointer z end-unstring end-perform 006850* 006860* get words. 006880* 006890 move pay-gross to c-gross test-amount. 006900 move spaces to c-words-1 c-words-2. 006910 move 1 to z. 006920 move zero to pound-flag. 006930* 006940 divide test-amount by 1000000 giving y. 006950 compute test-amount = test-amount - (1000000 * y). 006960* 006970 if y > 0 006980 string wordn (y) delimited by "*" 006990 into c-words-1 with pointer z. 007010 if y > 0 007020 string " Million " delimited by "*" 007030 into c-words-1 with pointer z. 007050* 007060 divide test-amount by 100000 giving y. 007070 compute test-amount = test-amount - (100000 * y). 007080* 007090 if y > 0 007100 string wordn (y) delimited by "*" 007110 into c-words-1 with pointer z. 007130 if y > 0 007140 string " Hundred and " delimited by "*" 007150 into c-words-1 with pointer z. 007170* 007180 divide test-amount by 1000 giving y. 007190 compute test-amount = test-amount - (1000 * y). 007200* 007210 if y > 0 007220 string wordn (y) delimited by "*" 007230 into c-words-1 with pointer z. 007250 if y > 0 007260 string " Thousand " delimited by "*" 007270 into c-words-1 with pointer z. 007290 if z > 1 007300 move 1 to pound-flag. 007310* 007320 string asterix-fill delimited by size 007330 into c-words-1 with pointer z. 007340* 007350 divide test-amount by 100 giving y. 007360 compute test-amount = test-amount - (100 * y). 007370* 007380 move 1 to z. 007390* 007400 if y > 0 007410 string wordn (y) delimited by "*" 007420 into c-words-2 with pointer z. 007440 if y > 0 007450 string " Hundred and " delimited by "*" 007460 into c-words-2 with pointer z. 007480* 007490 divide test-amount by 1 giving y. 007500 compute test-amount = test-amount - y. 007510* 007520 if y > 0 007530 string wordn (y) delimited by "*" 007540 into c-words-2 with pointer z. 007560 if z > 1 007570 move 1 to pound-flag. 007580 if y > 0 007590 or pound-flag = 1 007600 string " Pounds " delimited by "*" 007610 into c-words-2 with pointer z. 007630* 007650 multiply 100 by test-amount giving y. 007660* 007670 if y > 0 007680 string wordn (y) delimited by "*" 007690 into c-words-2 with pointer z. 007710 if y > 0 007720 string " Pence " delimited by "*" 007730 into c-words-2 with pointer z. 007750* 007760 if y = 0 007770 string "ONLY" delimited by size 007780 into c-words-2 with pointer z. 007790* 007800 perform varying z from 1 by 1 until z > 9 007860 move pay-folio (z) to c-folio (z) 007880 move pay-invoice (z) to c-inv (z) 007900 move pay-value (z) to c-value (z) 007920 if z < 9 007930 move "," to c-last (z) 007940 else 007950 move " " to c-last (z) end-if end-perform 007990* if pay-sortcode = zero 008000 move cheque-nos to c-cheque pay-cheque add 1 to cheque-nos else move zero to pay-cheque move "BACS" to c-cheque-x 008020 end-if 008030 write cheque-record from cheque. 008040* 008050 move u-bin to pay-date. 008060 rewrite pay-record. 008090* 008100* now loop back for next item.... 008110* 008130 go to read-purchase. 008140* 008150 main-end. 008160********* 008170* 008180 close cheque-file purchase-file pay-file. 008190 exit program. 008200* === Cut === Vince |