Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/C/Firefox/dom/smil/test/   (Firefox Browser Version 153.0.1©)  Datei vom 27.6.2026 mit Größe 399 B image not shown  

Bilddatei

de027.cob.org.txt


products/Sources/formale Sprachen/COBOL/verschiedene-Autoren/Deutsche-Bank/de027.cob.org.txt

* DATA SET: X2H100.PRO.COBOL MEMBER:DE027 * DATE: 03/03/28 TIME: 18:07:00 PAGE: 1 * USERID: X2H100 *PARMMVS ENV=DB2 *PARMMVS DBRMNAME=DE027 *PARMMVS COMPILER=COBOL2 *PARMMVS PARM.DB2=(SOURCE,VERSION(AUTO) *PARMMVS PARM.COB=(NOADV, *PARMMVS DATA(31), *PARMMVS NODYN, *PARMMVS MAP, " *PARMMVS OFFSET, *PARMMVS OPT, *PARMMVS RENT, *PARMMVS RES, *PARMMVS NOTEST, *PARMMVS TRUNC(BIN» *PARMMVS PARM.LNK=(MAP,RENT,LIST, 'AMODE=31', 'RMODE=ANY') *PARMMVS LNK.IN ENTRY DE027 identification division. program-id. de027. author. pcam-gt-pbs-credit decisions & surveillance -jd. date-written. 7.7.2002. date-compiled. data division. working-storage section. 77 i pic 9(4). 77 j pic 9(4). 77 k pic 9(4). 77 ind pic 9(4). 77 pic 9. 88 nongood-found value 1. 88 good-found value 0. 77 pic 9. 88 nonblank-found value 1. 88 blank-found value 0. 77 zeile pic x(132). 77 ausgabe pic x(132). 77 aus-ll pic 9(4). 77 adresse pic 9(12). 01 kt1240-dummy-dfheiblk pic x. 01 kt1240-dummy-dfhcommarea pic x. 01 kt1240-in-interface. 05 kt1240-h-aufruf-pgm pic x(6). 05 kt1240-h-count pic 9(3). 05 filler redefines kt1240-h-count. 10 kt1240-h-count-x pic x(3). 05 kt1240-h-text pic x(900). 05 filler redefines kt1240-h-text. 10 kt1240-h-tab occurs 9 pic x(100). 01 kt1240-pgm pic x(8). 01 kt1240-s9 pic 9(8). 01 kt1240-s9-1 pic -9(8). 01 kt1240-s9-2 pic -9(8). 01 kt1240-s9-tab. 05 kt1240-s9-ind occurs 256 pic -9(4). 01 adressfeld-x pic 9(9). 01 adressfeld-zeile1 pic 9(9). 01 dummy. 10 adressfeld pointer. 10 adressfeld-c redefines adressfeld pic s9(9) comp. 01 de026-pgm pic x(8). exec sql include sqlca end-exec. 01 umgebung. 10 u pic 9. 88 online value 1. 88 batch value 2. 10 db2server pic x(16) value space. 88 testserver value 'TOOO01'. 88 abnahmeserver value 'TOOO06'. 88 produktionsserver value 'POOO04'. 10 pic 9. 88 testsystem value 1. 88 abnahme value 2. 88 produktion value 3. linkage section. 01 zeile1 pic x(132). 01 zeile2 pic x(132). 01 zeile3 pic x(132). 01 zeile4 pic x(132). 01 zeile5 pic x(132). procedure division using zeile1 zeile2 zeile3 zeile4 zeile5. * vorsicht: parameterübergabe soll nur "by content" erfolgen, weil * der pufferbereich auf blank gesetzt wird! main. perform init move space to ausgabe move zero to aus-ll set adressfeld to address of zeile1 move adressfeld-c to adressfeld-zeile1 * move zeile1 to zeile perform check if k > 0 then move space to zeile1(1:k) end-if * set adressfeld to address of zeile2 move adressfeld-c to adressfeld-x if adressfeld-x(1:4) = adressfeld-zeile1(1:4) and zeile2(1:1) > space and <= '9' then move zeile2 to zeile perform check if k > 0 then move space to zeile2(1:k) end-if end-if * set adressfeld to address of zeile3 move adressfeld-c to adressfeld-x if adressfeld-x(1:4) = adressfeld-zeile1(1:4) and zeile3(1:1) > space and <= '9' then move zeile3 to zeile perform check if k > 0 then move space to zeile3(1:k) end-if end-if * set adressfeld to address of zeile4 move adressfeld-c to adressfeld-x if adressfeld-x(1:4) = adressfeld-zeile1(1:4) and zeile4(1:1) > space and <= '9' then move zeile4 to zeile perform check if k > 0 then move space to zeile4(1:k) end-if end-if * set adressfeld to address of zeile5 move adressfeld-c to adressfeld-x if adressfeld-x(1:4) = adressfeld-zeile1(1:4) and zeile5(1:1) > space and <= '9' then move zeile5 to zeile perform check if k > 0 then move space to zeile5(1:k) end-if end-if * move space to kt1240-h-text perform wri-que. goback . init. exec sql set :db2server = CURRENT SERVER end-exec move 'de026' to de026-pgm call de026-pgm on exception goback end-call if return-code = zero then set batch to true end-if if return-code = 16 then set online to true end-if . check. set good-found to true perform varying i from 1 by 1 until i > 131 or nongood-found if zeile(i:1) < space then set nongood-found to true compute j = i -1 if j < 1 then move 1 to j end-if end-if end-perform if good-found then move 132 to j end-if set blank-found to true perform varying i from j by -1 until i < 2 or nonblank-found if zeile(i:1) not = space then set nonblank-found to true compute k = i if k <= 1 then move 1 to k end-if end-if end-perform if blank-found then move j to k end-if if aus-ll> 0 and< length of ausgabe then string ausgabe(1:aus-ll) zeile(1:k) delimited by size into ausgabe add k to aus-ll else if aus-ll = zero then string zeile(1:k) delimited by size into ausgabe move k to aus-ll end-if end-if . wri-que. if batch then display ausgabe else move 1 to kt1240-h-count move ausgabe to kt1240-h-tab(1) move 'KT1240' to kt1240-pgm move 'de027' to kt1240-h-aufruf-pgm call kt1240-pgm using kt1240-dummy-dfheiblk kt1240-dummy-dfhcommarea kt1240-in-interface end-if . end-program de027.