|
* 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.
¤ Dauer der Verarbeitung: 0.14 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
