000100 IDENTIFICATION DIVISION. 000500 PROGRAM-ID. DU055. 000550**---------------------------------------------------------------- 000560**Einsatzinformationen Rv-interne Informationen - 000570**---------------------------------------------------------------- 000580**Version Einsatz- verteilt an Version Version Programm- - 000582**Anlage 9 termin Software Programm Datum - 000583** Entwurf - 000590**---------------------------------------------------------------- 000600** 2.05 01.02.2001 Krankenkassen 22 50 11.01.2001- 000610** VDR, BfA, BA - 000611**---------------------------------------------------------------- 000612** 2.051 23.03.2001 VDR, BfA, BA 23 51 21.03.2001- 000620**---------------------------------------------------------------- 000630** 2.06 01.06.2001 Krankenkassen 24 52 16.05.2001- 000640** VDR, BfA, BA - 000700**---------------------------------------------------------------- 000800** 2.07 01.12.2001 Krankenkassen 25 53 15.10.2001- 000810** VDR, BfA, BA - 000820**---------------------------------------------------------------- 000890** 2.07 01.01.2002 Krankenkassen 26 54 14.12.2001- 000891** VDR, BfA, BA - 000892**---------------------------------------------------------------- 000893** 2.08 01.06.2002 Krankenkassen 27 55 17.05.2002- 000894** VDR, BfA, BA - 000895**---------------------------------------------------------------- 000896** 2.08 01.06.2002 Krankenkassen 27 56 14.06.2002- 000897** VDR, BfA, BA - 000898**---------------------------------------------------------------- 000899** 2.09 01.11.2002 Krankenkassen 28 57 09.08.2002- 000900** VDR, BfA, BA - 000901**---------------------------------------------------------------- 000902** 2.10 01.12.2002 Krankenkassen 29 58 04.11.2002- 000903** VDR, BfA, BA - 000904**---------------------------------------------------------------- 000905** 2.11 01.03.2003 Krankenkassen 30 59 06.02.2003- 000906** VDR, BfA, BA - 000907**---------------------------------------------------------------- 000908** 2.12 01.04.2003 Krankenkassen 31 60 12.03.2003- 000909** VDR, BfA, BA - 000910**---------------------------------------------------------------- 000911** 2.12 09.04.2003 Krankenkassen 32 61 09.04.2003- 000912** VDR, BfA, BA - 000913**---------------------------------------------------------------- 000914** 2.12 01.06.2003 Krankenkassen 33 62 13.05.2003- 000915** VDR, BfA, BA - 000916**---------------------------------------------------------------- 000917** 2.12 04.06.2003 Krankenkassen 34 63 03.06.2003- 000918** VDR, BfA, BA - 000919**---------------------------------------------------------------- 000920** 2.12 01.08.2003 Krankenkassen 35 64 17.07.2003- 000921** VDR, BfA, BA - 000922**---------------------------------------------------------------- 000923** 2.13 01.12.2003 Krankenkassen 36 65 20.10.2003- 000924** VDR, BfA, BA - 000925**---------------------------------------------------------------- 000926** 2.13 02.12.2003 Krankenkassen 37 66 02.12.2003- 000927** VDR, BfA, BA - 000928**---------------------------------------------------------------- 000929** 2.13 02.02.2004 Krankenkassen 38 67 23.01.2004- 000930** VDR, BfA, BA - 000931**---------------------------------------------------------------- 000932** 2.15 01.03.2004 VDR, BfA 39 68 23.02.2004- 000934**---------------------------------------------------------------- 000935** 2.16 01.07.2004 Krankenkassen 40 69 17.05.2004- 000936** VDR, BfA, BA, - 000937** ZfA - 000938**---------------------------------------------------------------- 000939** 2.16 08.07.2004 VDR, BfA 40 70 05.07.2004- 000942**---------------------------------------------------------------- 000943** 2.18 01.12.2004 Krankenkassen 41 71 08.11.2004- 000944** VDR, BfA, BA, - 000945**---------------------------------------------------------------- 000946** 2.18 01.01.2005 Krankenkassen 42 72 22.12.2004- 000947** VDR, BfA, BA, - 000948**---------------------------------------------------------------- 000949** 2.18 01.01.2005 Krankenkassen 42 73 03.02.2005- 000950** VDR, BfA, BA, - 000951**---------------------------------------------------------------- 000952** 2.19 14.02.2005 Krankenkassen 43 74 07.02.2005- 000953** VDR, BfA, BA, - 000954** kommunale Träger - 000955** der BA - 000956**---------------------------------------------------------------- 000957** 2.20 01.04.2005 Krankenkassen 44 75 16.02.2005- 000958** VDR, BfA, BA, - 000959** kommunale Träger - 000960** der BA - 000961**---------------------------------------------------------------- 000962** 2.21 01.06.2005 Krankenkassen 45 76 03.05.2005- 000963** VDR, BfA, BA, - 000964** kommunale Träger - 000965** der BA - 000966**---------------------------------------------------------------- 000967** 2.21 01.07.2005 Krankenkassen 46 77 15.06.2005- 000968** VDR, BfA, BA, - 000969** kommunale Träger - 000970** der BA - 000971**---------------------------------------------------------------- 000977** 2.21 01.08.2005 VDR, BfA 47 78 20.07.2005- 000981**---------------------------------------------------------------- 000982** 2.21 25.08.2005 VDR, BfA, Bkn 48 79 24.08.2005- 000983**---------------------------------------------------------------- 000984** 2.21 05.09.2005 BfA 49 80 02.09.2005- 000985**---------------------------------------------------------------- 000986** 2.22 01.12.2005 50 81 03.11.2005- 000987**---------------------------------------------------------------- 000988** 2.22 06.12.2005 VDR, BfA 51 82 05.12.2005- 000989**---------------------------------------------------------------- 000990** 2.23 10.01.2006 BA, 52 83 09.01.2006- 000991** Krankenkassen 000992**---------------------------------------------------------------- 000993** 2.24 01.06.2006 Krankenkassen 53 84 28.04.2006- 000994** VDR, BfA, BA, 000995** kommunale Träger - 000996** der BA - 000997**---------------------------------------------------------------- 000998** 2.25 19.06.2006 Deutsche 54 85 20.06.2006- 000999** Rentenversicheru 001000** ng Bund / ZfA 001001**---------------------------------------------------------------- 001002** 2.25 21.08.2006 Deutsche 55 86 26.07.2006- 001003** Rentenversicheru 001004** ng Bund/BA 001005**---------------------------------------------------------------- 001006** 2.26 01.12.2006 Krankenkassen, 56 87 03.11.2006- 001007** DSRV, DRV-Bund, 001008** BA, kommunale 001009** Träger der BA 001010**---------------------------------------------------------------- 001011** 2.26 01.12.2006 Krankenkassen, 57 88 23.11.2006- 001012** DSRV, DRV-Bund, 001013** BA, kommunale 001014** Träger der BA 001015**---------------------------------------------------------------- 001016** 2.27 01.02.2007 Krankenkassen, 58 89 19.12.2006- 001017** DSRV, DRV-Bund, 001018** BA, kommunale 001019** Träger der BA 001020**---------------------------------------------------------------- 001021** 2.27 07.02.2007 Krankenkassen, 59 90 05.02.2007- 001022** DSRV, DRV-Bund, 001023** BA, kommunale 001024** Träger der BA 001025**---------------------------------------------------------------- 001026** 2.28 01.04.2007 Krankenkassen, 60 91 05.03.2007- 001027** DSRV, DRV-Bund, 001028** BA, kommunale 001029** Träger der BA 001030**---------------------------------------------------------------- 001031** 2.28 05.04.2007 DSRV, DRV-Bund 61 92 30.03.2007- 001035**---------------------------------------------------------------- 001036** 2.28 01.06.2007 Krankenkassen, 62 93 30.04.2007- 001037** DSRV, DRV-Bund, 001038** BA, kommunale 001039** Träger der BA 001041**---------------------------------------------------------------- 001042** 2.28 01.06.2007 Krankenkassen, 62 94 11.05.2007- 001043** DSRV, DRV-Bund, 001044** BA, kommunale 001045** Träger der BA 001047**---------------------------------------------------------------- 001048** 2.28 12.06.2007 Krankenkassen, 62 95 11.06.2007- 001049** DSRV, DRV-Bund, 001050** BA, kommunale 001051** Träger der BA 001052**---------------------------------------------------------------- 001053** PROGRAMM : DU055 001054** FUNKTION : KERNPRUEFUNG DEUEV 001055** PROGRAMMIERER : Klemke Michael 001056** COPYRIGHT: 001057** VERBAND DEUTSCHER RENTENVERSICHERUNGSTRAEGER 001058** BUNDESVERSICHERUNGSANSTALT FUER ANGESTELLTE 001059** VERSION : 001060** 001061** PROGRAMM : 95 001062** VOM : 11.06.2007 001070** GEM SOFTWAREENTWURF : Version 62 001100**---------------------------------------------------------------- 002040** 002400 ENVIRONMENT DIVISION. 002401**---------------------------------------------------------------- 002402 CONFIGURATION SECTION. 002403**---------------------------------------------------------- 002404 SPECIAL-NAMES. 002405* COPY DCLASS. 000210 CLASS SONDERZ IS 000220 "-" "/" " " "," "(" ")" "." "'", 000230 CLASS ZIFF-ALLG IS "0" "1" "2" "3" "4" "5" "6" "7" "8" "9", 000240 CLASS GROSSBUCHSTABE IS 000250 "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000260 "Ä" "Ö" "Ü", 000270 CLASS VSNRBUCHSTABE IS 000280 "A" THRU "I" "J" THRU "R" "S" THRU "Z", 000290 CLASS FMNA-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000300 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000310 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" " " "-" "." 000320 "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" 000330 "'", 000340 CLASS VONA-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000350 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000360 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "-" " ", 000370 CLASS VOSA-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000380 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000390 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" " " "." 000400 "'", 000410 CLASS ALPHA-ALLG IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000420 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000430 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß", 000440 CLASS ORT-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000450 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000460 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" " " "." "-" 000470 "/" "(" ")" ",", 000480 CLASS FMNAL-ALLG IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000490 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000500 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "." "0" "1" 000510 "2" "3" "4" "5" "6" "7" "8" "9", 000520 CLASS VOSAL-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000530 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000540 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "." "'", 000550 CLASS TITEL-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000560 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000570 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "-" " " "." 000580 "(" ")", 000590 CLASS TITELL-ALPH IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000600 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000610 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "." ")", 000620 CLASS GBOT-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000630 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000640 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" " " "-" "." 000650 "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" 000660 "/" "(" ")" "'" ",", 000661 CLASS STR-ALPHA IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000662 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000663 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" " " "-" "." 000664 "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" 000665 "/" "(" ")" "'" ",", 000670 CLASS HNR-ALLG IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000680 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000690 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "0" "1" 000700 "2" "3" "4" "5" "6" "7" "8" "9" " " "-" 000710 "/" "," ".", 000720 CLASS HNRL-ALLG IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000730 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000740 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "." "0" "1" 000750 "2" "3" "4" "5" "6" "7" "8" "9" ")", 000751 CLASS STRL-ALLG IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000752 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000753 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "." "0" "1" 000754 "2" "3" "4" "5" "6" "7" "8" "9" ")", 000760 CLASS APLZ IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000770 "a" THRU "i" "j" THRU "r" "s" THRU "z" 000780 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "-" "0" "1" 000790 "2" "3" "4" "5" "6" "7" "8" "9" " ", 000800 CLASS ANZU IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 000900 "a" THRU "i" "j" THRU "r" "s" THRU "z" 001000 "Ä" "Ö" "Ü" "ä" "ö" "ü" "ß" "0" "1" 001100 "2" "3" "4" "5" "6" "7" "8" "9" , 001200 CLASS EMAIL IS "A" THRU "I" "J" THRU "R" "S" THRU "Z" 001300 "a" THRU "i" "j" THRU "r" "s" THRU "z" 001400 "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" 001600 "!" "$" "%" "&" "'" "(" ")" 001700 "*" "+" "," "-" "." "/" ":" ";" 001800 "<" ">" "?" "§" "_" "=" "@" 001900 "#" "^" "`" 002000 "Ä" "Ö" "Ü" "ä" "ö" "ü", 002464 DECIMAL-POINT IS COMMA. 002465**---------------------------------------------------------------- 002470*INPUT-OUTPUT SECTION. 003426**---------------------------------------------------------------- 003427 DATA DIVISION. 003428**---------------------------------------------------------------- 003500 WORKING-STORAGE SECTION. 003600**---------------------------------------------------------------- 003601*COPY DCOPYDEF. 000100**---------------------------------------------------------------- 000900** COPY-MEMBER : DCOPYDEF 000910** PROGRAMMIERER : WERNER KRAUS 000920** ERSTELLUNGSDATUM : 09.02.1998 000930** VERSION : 001 (PGM-NEUERSTELLUNG) 000940** FUNKTION : ALLGEMEINE DATENDEFINITIONEN FüR FEHLER- 000950** PRüFUGEN 000961**---------------------------------------------------------------- 000962** PROGRAMMIERER : GERTRAUD SCHUHMACHER 000963** ÄNDERUNG : 001 VOM 15.05.2001 VERSION 24 Nachgang 01 000970**---------------------------------------------------------------- 000971** PROGRAMMIERER : MICHAEL KLEMKE 000972** ÄNDERUNG : 002 VOM 28.06.2001 VERSION 25 000973** Variable Längenfelder eingefügt 000974** (ANZ-PRUEF-STELLEN) 000975**---------------------------------------------------------------- 000976** PROGRAMMIERER : MICHAEL KLEMKE 000977** ÄNDERUNG : 003 VOM 21.03.2002 VERSION 27 000978** TABELLE GEM. ANLAGE 13 000980**---------------------------------------------------------------- 000981** PROGRAMMIERER : MICHAEL KLEMKE 000982** ÄNDERUNG : 004 VOM 26.08.2002 VERSION 28 000983** TABELLE GEM. ANLAGE 3 ERWEITERT 000984**---------------------------------------------------------------- 000985** PROGRAMMIERER : MICHAEL KLEMKE 000986** ÄNDERUNG : 005 VOM 04.11.2002 VERSION 29 000987** TABELLE GEM. ANLAGE 3 ERWEITERT 000988**---------------------------------------------------------------- 000989** PROGRAMMIERER : MICHAEL KLEMKE 000990** ÄNDERUNG : 006 VOM 13.05.2003 VERSION 33 000992**---------------------------------------------------------------- 000993** PROGRAMMIERER : MICHAEL KLEMKE 000994** ÄNDERUNG : 007 VOM 26.10.2003 VERSION 36 000995**---------------------------------------------------------------- 000996** PROGRAMMIERER : MICHAEL KLEMKE 000997** ÄNDERUNG : 008 VOM 23.01.2004 VERSION 38 000998**---------------------------------------------------------------- 000999** PROGRAMMIERER : MICHAEL KLEMKE 001000** ÄNDERUNG : 009 VOM 18.05.2004 VERSION 40 001001**---------------------------------------------------------------- 001002** PROGRAMMIERER : MICHAEL KLEMKE 001003** ÄNDERUNG : 010 VOM 11.10.2004 VERSION 41 001004**---------------------------------------------------------------- 001005** PROGRAMMIERER : MICHAEL KLEMKE 001006** ÄNDERUNG : 011 VOM 07.12.2004 VERSION 42 001007**---------------------------------------------------------------- 001008** PROGRAMMIERER : MICHAEL KLEMKE 001009** ÄNDERUNG : 012 VOM 13.04.2005 VERSION 45 001010**---------------------------------------------------------------- 001011** PROGRAMMIERER : MICHAEL KLEMKE 001012** ÄNDERUNG : 013 VOM 11.10.2006 VERSION 56 001013**---------------------------------------------------------------- 001014** PROGRAMMIERER : HEINZ STANG 001015** ÄNDERUNG : 11.01.2006 Auftrag 551-2007-3 001016**---------------------------------------------------------------- 001017** PROGRAMMIERER : MICHAEL KLEMKE 001018** ÄNDERUNG : 05.02.2007 Auftrag 551-2007-012 001019**---------------------------------------------------------------- 001020** PROGRAMMIERER : MICHAEL KLEMKE 001021** ÄNDERUNG : 18.04.2007 Auftrag Version-62 001022**---------------------------------------------------------------- 001023** RECHENFELDER ZUR PRüFFZIFFERBERECHNUNG 001024**---------------------------------------------------------------- 001025 01 FAKTOREN-TABELLE. 001026 05 FILLER PIC X(7) VALUE "1212121". 001027** 001030 01 FAKTOREN-TAB REDEFINES FAKTOREN-TABELLE. 001040 05 FAKTOR PIC 9(01) OCCURS 7 TIMES. 001050 01 ZIFFER-TABELLE. 001060 05 ZIFF-1-8 PIC 9(08). 001070 05 ZIFF-9-A2 PIC 9(02). 001080 05 ZIFF-11-12. 001090 10 ZIFF-11 PIC 9(01). 001100 10 ZIFF-12 PIC 9(01). 001110** 001120 01 ZIFFER-TAB REDEFINES ZIFFER-TABELLE. 001130 05 ZIFFER PIC 9(01) OCCURS 12 TIMES. 001140 01 QUERSUMME PIC 9(02) VALUE ZEROS. 001150** 001160 01 QUERSUMME-TEIL REDEFINES QUERSUMME. 001170 05 QUERSUMME-1 PIC 9(01). 001180 05 QUERSUMME-2 PIC 9(01). 001190** 001200 01 HFELD-ZUSCHLAG PIC 9(01). 001201 01 REST PIC 9(01). 001210 01 RESTB PIC 9(02). 001220 01 RESTBR REDEFINES RESTB. 001230 05 RESTBR1 PIC 9. 001240 05 RESTBR2 PIC 9. 001250 01 ERG PIC 9(09). 001260 01 HILFSFELD PIC 9(4). 001270 01 INDICES. 001280 05 I PIC 9(02) VALUE ZERO. 001290 05 J PIC 9(02) VALUE ZERO. 001300**---------------------------------------------------------------- 001310** TABELLE ZUR SCHALTJAHRBEREHNUNG 001320**---------------------------------------------------------------- 001330 01 SCHALTJAHRTAB. 001340 05 TG-TABELLE. 001350 10 PIC X(24) VALUE "312931303130313130313031". 001360 10 PIC X(24) VALUE "312831303130313130313031". 001370 10 PIC X(24) VALUE "312831303130313130313031". 001380 10 PIC X(24) VALUE "312831303130313130313031". 001390 05 TG-TABELLE-1 REDEFINES TG-TABELLE. 001400 10 OCCURS 4. 001410 15 TGT PIC 99 OCCURS 12. 001420 05 SCHALTJAHR PIC 99. 001430**---------------------------------------------------------------- 001440** HILFSTAB ZUR PRüFUNG PERSONENGRUPPEN 001450**---------------------------------------------------------------- 001460 01 PERSGR-TAB PIC 9(3). 001470 88 PERSGR-OK VALUES 101 THRU 114, 116, 118, 119, 120, 001480 140 THRU 143, 149, 201 THRU 205, 001490 207, 208, 209, 210, 301, 302, 303, 304. 001500**---------------------------------------------------------------- 001510** HILFSTAB ZUR PRüFUNG ABGABEGRUND 001520**---------------------------------------------------------------- 001530 01 GD-TAB PIC 9(2). 001540 88 GD-OK VALUES 10 THRU 13, 30 THRU 36, 40, 001550 49 THRU 56, 59 THRU 63, 70 THRU 72, 80, 001551** ----------------------------------------------- 001552** ÄNDERUNG VON 26.08.2002 001553** ----------------------------------------------- 001560 90, 99, 001561** ----------------------------------------------- 001562** ÄNDERUNG VON 04.11.2002 001563** ----------------------------------------------- 001564 94, 95. 001570**---------------------------------------------------------------- 001580** HILFSTAB ZUR PRüFUNG ABGABEGRUND FIKTIV 001590**---------------------------------------------------------------- 001600 01 GDFIKT-TAB PIC 9(2). 001610 88 GDFIKT-OK VALUES 00, 01, 02, 03, 04, 05, 07, 08, 09. 001620**---------------------------------------------------------------- 001630** HILFSTAB ZUR PRüFUNG GüLTIGER ABGABEGRUND DBME110 001640**---------------------------------------------------------------- 001650 01 GDDBME-TAB PIC X(2). 001660 88 GDDBME-OK VALUE "02", "03", "04", "05", "07", "08", "09", 001670 "10", "13", "30", "33", "49", "50", "51", 001680 "54", "71", "72", "00", "01", "31", "32". 001681**---------------------------------------------------------------- 001682** HILFSTAB ZUR PRüFUNG europäische Staatsangehörigkeit 001683**---------------------------------------------------------------- 001684 01 EU-SASC-TAB PIC X(3). 001685 88 EU-SASC-OK VALUE "124", "126", "127", "128", "129", 001686 "131", "134", "135", "136", "137", "139", 001687 "141", "142", "143", "145", "148", "149", 001688 "151", "152", "153", "155", "157", 001689 "161", "164", "165", "168", 001690 "181", 001691** ------------------------------------------ 001692** ÄNDERUNG VERSION 56 - 11.10.2006 001693** ------------------------------------------ 001694 "125", 001695 "154". 001696 001697**---------------------------------------------------------------- 001698** TABELLE ENTHAELT ZUL. KOMBINATIONEN VON PERSGR / BEITRAGSGR. 001699**---------------------------------------------------------------- 001700 01 TABELLE-PERSGR-BYGR. 001701 05 FILLER PIC X(43) VALUE 001702 "101012369 01234 012 012 ". 001703 05 FILLER PIC X(43) VALUE 001704 "10201349 012 01 012 ". 001705 05 FILLER PIC X(43) VALUE 001706 "103012349 012 012 012 ". 001707 05 FILLER PIC X(43) VALUE 001708 "1040 13 0 0 ". 001709 05 FILLER PIC X(43) VALUE 001710 "105012 012 01 012 ". 001711 05 FILLER PIC X(43) VALUE 001712 "10606 01234 0 0 ". 001713 05 FILLER PIC X(43) VALUE 001714 "1070123 01234 01 012 ". 001715 05 FILLER PIC X(43) VALUE 001716 "1080349 012 0 012 ". 001717 05 FILLER PIC X(43) VALUE 001718 "1090136 01256 012 012 ". 001719 05 FILLER PIC X(43) VALUE 001720 "1100 0 0 0 ". 001721 05 FILLER PIC X(43) VALUE 001722 "1110123 12 01 012 ". 001723 05 FILLER PIC X(43) VALUE 001724 "11204 01234 012 012 ". 001725 05 FILLER PIC X(43) VALUE 001726 "1130139 01234 012 012 ". 001727 05 FILLER PIC X(43) VALUE 001728 "1145 01234 012 0 ". 001729 05 FILLER PIC X(43) VALUE 001730 "11603 012 0 012 ". 001731 05 FILLER PIC X(43) VALUE 001732 "11801239 1234 0 012 ". 001733 05 FILLER PIC X(43) VALUE 001734 "119039 34 012 012 ". 001735 05 FILLER PIC X(43) VALUE 001736 "14001239 01234 012 012 ". 001737 05 FILLER PIC X(43) VALUE 001738 "1411 12 01 12 ". 001739 05 FILLER PIC X(43) VALUE 001740 "14201239 012 012 012 ". 001741 05 FILLER PIC X(43) VALUE 001742 "1430 12 0 0 ". 001743 05 FILLER PIC X(43) VALUE 001744 "149039 34 012 012 ". 001745 001746 001747 01 FILLER REDEFINES TABELLE-PERSGR-BYGR. 001748 05 FILLER OCCURS 22. 001749 10 TAB-PERSGR PIC 9(3). 001750 10 FILLER OCCURS 4. 001751 15 TAB-BYGR PIC X OCCURS 10. 001752 001753 001754**---------------------------------------------------------------- 001755** SCHALTER FÜR VERGLEICH GÜLTIGER PERSGR / BEITRAGSGR. 001756**---------------------------------------------------------------- 001757 01 BYGR-PERSGR-S PIC 9. 001758 88 BYGR-PERSGR-OK VALUE 0. 001759 88 BYGR-PERSGR-NOK VALUE 1. 001760 001761**---------------------------------------------------------------- 001762** SCHALTER FÜR 001763**---------------------------------------------------------------- 001764 01 DSME05XS PIC 9. 001765 88 DSME05X-VORH VALUE 0. 001766 88 NOT-DSME05X-VOR VALUE 1. 001767 001768**---------------------------------------------------------------- 001769** SCHALTER FÜR 001770**---------------------------------------------------------------- 001771 01 DBME05XS PIC 9. 001772 88 DBME05X-VOR VALUE 0. 001773 88 NOT-DBME05X-VOR VALUE 1. 001774 001775**---------------------------------------------------------------- 001776** SCHALTER FÜR DSKO610 001777**---------------------------------------------------------------- 001778 01 DSKO610S PIC 9. 001779 88 DSKO610-VORH VALUE 0. 001780 88 DSKO610-NOT VALUE 1. 001781 001782 001783**---------------------------------------------------------------- 001784** SCHALTER FÜR T52211 001785**---------------------------------------------------------------- 001786 01 T52211S PIC 9. 001787 88 PRUEF-T52211 VALUE 0. 001788 88 PRUEF-T52212 VALUE 1. 001789 001790 001791**---------------------------------------------------------------- 001792** SCHALTER FÜR T524112 001793**---------------------------------------------------------------- 001794 01 T524112S PIC 9. 001795 88 T524112-AUSF VALUE 0. 001796 88 T524112-NOT-AUSF VALUE 1. 001797 001798 001799**---------------------------------------------------------------- 001800** SCHALTER FÜR T53302-01 001801**---------------------------------------------------------------- 001802 01 T53302-0S PIC 9. 001803 88 T53302-01 VALUE 0. 001804 88 NOT-T53302-01 VALUE 1. 001805 001806 001807**---------------------------------------------------------------- 001808** SCHALTER FÜR T53300101 001809**---------------------------------------------------------------- 001810 01 T5330101S PIC 9. 001811 88 T5330101-AUSF VALUE 0. 001812 88 T5330101-NOT-AUSF VALUE 1. 001813 001814 001815**---------------------------------------------------------------- 001816** SCHALTER FÜR DSKO612 001817**---------------------------------------------------------------- 001818 01 DSKO612S PIC 9. 001819 88 DSKO612-VORH VALUE 0. 001820 88 DSKO612-NOT VALUE 1. 001821 001822 01 ANZ-SZ PIC 99. 001823 001824**---------------------------------------------------------------- 001825** HILFSFELD ZUR PRüFUNG VSNR 001826**---------------------------------------------------------------- 001827 01 HVSNR. 001828 05 HVSNR1 PIC X(8). 001829 05 HVSNRNUM1 REDEFINES HVSNR1. 001830 10 HVSNRBNR PIC 9(2). 001831 10 HVSNRGEB. 001832 15 HVSNRGEBTT PIC 9(2). 001833 15 HVSNRGEBMM PIC 9(2). 001834 15 HVSNRGEBJJ PIC 9(2). 001835 05 HVSNR2 PIC X. 001836 05 HVSNR3 PIC X(3). 001837 05 HVSNRNUM2 REDEFINES HVSNR3. 001838 10 HVSNRSS PIC 99. 001840 10 HVSNRPR PIC 9. 001850**---------------------------------------------------------------- 001860** HILFSTAB ZUR PRüFUNG BEREICHNSNUMMER BEI VSNR (DSME084) 001870**---------------------------------------------------------------- 001880 01 HVSNRBNR-TAB0 PIC XX. 001890 88 BNR-TAB0-OK VALUES "02", "03", "04", "08", "09", "10", "11", 001900 "12", "13", "14", "15", "16", "17", "18", 001910 "19", "20", "21", "23", "24", "25", "26", 001920 "28", "29", "38", "39", "42", "43", "44", 001930 "48", "49", "50", "51", "52", "53", "54", 001940 "55", "56", "57", "58", "59", "60", "61", 001950 "63", "64", "65", "66", "68", "69", "78", 001960 "79", "80", "81", "82", "89". 001961**---------------------------------------------------------------- 001962** HILFSTAB ZUR PRüFUNG BEREICHNSNUMMER BEI VSNR 001963**---------------------------------------------------------------- 001964 01 HVSNRBNR-TAB PIC XX. 001965 88 BNR-OK VALUES "02", "03", "04", "08", "09", "10", "11", 001966 "12", "13", "14", "15", "16", "17", "18", 001967 "19", "20", "21", "23", "24", "25", "26", 001968 "28", "29", "38", "39", "42", "43", "44", 001969 "48", "49", "50", "51", "52", "53", "54", 001970 "55", "56", "57", "58", "59", "60", "61", 001971 "63", "64", "65", "66", "68", "69", "78", 001972 "79", "80", "81", "82", "89", 001973** ------------------------------------------------------------- 001974** ÄNDERUNG VOM 20.10.2003 / VERSION 36 001975** ------------------------------------------------------------- 001976 "40". 001977 001978 001979 001980**---------------------------------------------------------------- 001981** HILFSTAB ZUR PRüFUNG BEREICHNSNUMMER BEI VSNR VON KK --> RV 001990**---------------------------------------------------------------- 002000 01 HVSNRBNR-TAB1 PIC XX. 002010 88 BNR1-OK VALUES "00", "77", "83", "84", "85", "86", "87", 002020 "88", "91", "92", "94", 002021** ------------------------------------------------------------- 002022** ÄNDERUNG VOM 20.10.2003 / VERSION 36 002023** ------------------------------------------------------------- 002024 "41". 002025 002026 002027 002030**---------------------------------------------------------------- 002040** HILFSTAB ZUR PRüFUNG ZULäSSIGER ABSENDER, WENN ITVSNR 002050**---------------------------------------------------------------- 002060 01 HITVSNR-TAB PIC X(5). 002070 88 ITVSNR-OK VALUES "KVTRV", "RVTKV", "BATRV", "RVTBA", 002080 "BWTRV", "RVTBW", "BZTRV", "RVTBZ", 002090 "PVTRV", "RVTPV", "RVTKS", "RVTRV". 002100** -------------------------------------------------------------- 002110** FAKTORENTABELLE 002120** -------------------------------------------------------------- 002130 01 FAKTOREN-TABELLE-VSNR. 002140 05 FILLER PIC X(12) VALUE "212571212121". 002150** 002160 01 FAKTOREN-TAB-VSNR REDEFINES FAKTOREN-TABELLE-VSNR. 002170 05 FAKTOR-VSNR PIC 9(01) OCCURS 12 TIMES. 002180** -------------------------------------------------------------- 002190** ALPHATABELLE 002200** -------------------------------------------------------------- 002210 01 ALPHA-TABELLE. 002220 05 FILLER PIC X(26) VALUE 002230 "ABCDEFGHIJKLMNOPQRSTUVWXYZ". 002240* 002250 01 ALPHA-TAB REDEFINES ALPHA-TABELLE. 002260 05 ALPHA-B PIC X(01) OCCURS 26 TIMES. 002270**---------------------------------------------------------------- 002280** INDEX 002290**---------------------------------------------------------------- 002300 01 IND PIC 9. 002310 01 SX-BUCHSTABE PIC X(01) VALUE ZERO. 002320 88 BUCHSTABE-GEFUNDEN VALUE "1". 002330**---------------------------------------------------------------- 002340** ZULäSSIGER TäTIGKEITSSCHLüSSEL 002350**---------------------------------------------------------------- 002360 01 TTSC-TAB PIC X(03). 002370 88 TTSC-OK VALUES "011" "012" "021" "022" "031" "032" 002380 "041" THRU "044" "051" "052" "053" 002390 "061" "062" "071" "072" "081" "082" 002400 "083" "091" "101" "102" "111" "112" 002410 "121" "131" THRU "135" "141" THRU 002420 "144" "151" "161" THRU "164" "171" 002430 THRU "177" "181" THRU "184" "191" 002440 THRU "193" "201" THRU "203" "211" 002450 THRU "213" "221" THRU "226" "231" 002460 THRU "235" "241" THRU "244" "251" 002470 "252" "261" THRU "263" "270" THRU 002480 "275" "281" THRU "286" "291" "301" 002490 THRU "306" "311" THRU "315" "321" 002500 THRU "323" "331" "332" "341" THRU 002510 "346" "351" THRU "357" "361" "362" 002520 "371" THRU "378" "391" "392" "401" 002530 THRU "403" "411" "412" "421" THRU 002540 "424" "431" THRU "433" "441" "442" 002550 "451" THRU "453" "461" THRU "466" 002560 "470" THRU "472" "481" THRU "486" 002570 "491" "492" "501" THRU "504" "511" 002580 THRU "514" "521" "522" "531" "541" 002590 THRU "549" "555" "601" THRU "607" "611" 002600 "612" "621" THRU "629" "631" THRU 002610 "635" "666" "681" THRU "688" "691" THRU 002620 "694" "701" THRU "706" "711" THRU 002630 "716" "721" THRU "726" "731" THRU 002640 "734" "741" THRU "744" "751" THRU 002650 "753" "761" THRU "763" "771" THRU 002660 "774" "781" THRU "784" "791" THRU 002670 "794" "801" THRU "805" "811" THRU 002680 "814" "821" THRU "823" "831" THRU 002690 "838" "841" THRU "844" "851" THRU 002700 "857" "861" THRU "864" "871" THRU 002710 "877" "881" THRU "883" "891" THRU 002720 "893" "901" "902" "911" THRU "913" 002730 "921" THRU "923" "931" THRU "937" 002740 "971" "981" THRU "983" "991" "995" 002750 "997" "888" "924". 002760**---------------------------------------------------------------- 002770** ZULÄSSIGES LÄNDERKENNZEICHEN 002780**---------------------------------------------------------------- 002790 01 LDKZ-TAB PIC X(03). 002800 88 LDKZ-OK VALUES "AFG" "ET " "AL " "DZ " "AJ " "AS " 002810 "AND" "AGO" "ANG" "AT " "ANT" "AQU" 002820 "RA " "ARM" "ASE" "ETH" "AUS" "BS " 002830 "BRN" "BD " "BDS" "B " "BH " "DY " 002840 "BER" "BHT" "BOL" "BIH" "RB " "BR " 002850 "BJ " "BRU" "BG " "HV " "RU " "CUE" 002860 "RCH" "TJ " "COI" "CR " "CI " "DK " 002870 "D " "WD " "DOM" "DSC" "EC " "ES " 002880 "ERI" "EST" "FAL" "FR " "FJI" "FIN" 002890 "F " "FG " "FP " "GAB" "WAG" "GEO" 002900 "GH " "GIB" "WG " "GR " "GRO" "GB " 002910 "GUA" "GUM" "GCA" "RG " "GUB" "GUY" 002920 "RH " "HCA" "HOK" "IND" "RI " "MAN" 002930 "IRQ" "IR " "IRL" "IS " "IL " "I " 002940 "JA " "J " "YEM" "JOR" "YU " "KAI" 002950 "K " "CAM" "CDN" "KAN" "CV " "KAS" 002960 "QAT" "EAK" "KIS" "KIB" "CO " "KOM" 002970 "RCB" "ZRE" "KOR" "ROK" "HR " "C " 002980 "KWT" "LAO" "LS " "LV " "RL " "LB " 002990 "LAR" "FL " "LT " "L " "MAC" "RM " 003000 "MK " "MW " "MAL" "BIO" "RMM" "M " 003010 "MA " "MAR" "MAT" "RIM" "MS " "MAY" 003020 "MEX" "MIK" "MD " "MC " "MON" "MOT" 003030 "MOZ" "MYA" "SWA" "NAU" "NEP" "NKA" 003040 "NZ " "NIC" "NL " "NLA" "RN " "WAN" 003050 "NIU" "NMA" "N " "MAO" "A " "PK " 003060 "PAL" "PA " "PNG" "PY " "PIN" "PE " 003070 "RP " "PIT" "PL " "P " "PRI" "REU" 003080 "RWA" "RO " "RUS" "PIE" "SOL" "Z " 003090 "WS " "RSM" "STP" "SAU" "S " "CH " 003100 "SN " "SY " "WAL" "ZW " "SGP" "SK " 003110 "SLO" "SP " "E " "CL " "HEL" "SCN" 003120 "WL " "WV " "ZA " "SUD" "SME" "SD " 003130 "SYR" "TAD" "RC " "EAT" "T " "TG " 003140 "TOK" "TON" "TT " "CHD" "CZ " "TN " 003150 "TR " "TUR" "TUC" "TUV" "EAU" "UA " 003160 "H " "ROU" "USB" "VAN" "V " "YV " 003170 "UAE" "USA" "VN " "BY " "RCA" "CY " 003171** ---------------------------------------------- 003172** ÄNDERUNG VOM 26.10.2003 / VERSION 36 003173** ---------------------------------------------- 003174 "OTI" 003175** ---------------------------------------------- 003176** ÄNDERUNG VOM 19.05.2004 / VERSION 40 003177** ---------------------------------------------- 003178 "SCG" 003179** ---------------------------------------------- 003180** ÄNDERUNG VOM 23.04.2007 / VERSION 62 003181** ---------------------------------------------- 003182 "SRB" "MNE". 003183**---------------------------------------------------------------- 003190** TABELLE ZUR ERMITTLUNG MONATSENDE 003200**---------------------------------------------------------------- 003210 01 MON-ENDE-KONST PIC X(48) VALUE 003220 "013102280331043005310630073108310930103111301231". 003230 01 MON-ENDE-TAB REDEFINES MON-ENDE-KONST. 003240 05 MON-TAB-ELEM OCCURS 12. 003250 10 MON-TAB-MM PIC 9(02). 003260 10 MON-TAB-TT PIC 9(02). 003270 01 MON-ENDE-IND PIC 9(02). 003280**---------------------------------------------------------------- 003290** TABELLE ZUR NAMENS- UND ANSCHRIFTENPRüFUNG 003300**---------------------------------------------------------------- 003310 01 ALPHA-TAB1. 003320 05 FILLER PIC X(2) VALUE LOW-VALUE. 003330 05 ALPHA-TAB11. 003340 10 ALPHA-ELEM PIC X(1) OCCURS 50. 003350 01 ALPHA-IND PIC 9(02). 003360 01 KLEINBUCHSTB PIC X(29) VALUE 003370 "abcdefghijklmnopqrstuvwxyzäöü". 003380 01 KLEINBUCHST-TAB REDEFINES KLEINBUCHSTB. 003390 05 KLEINBST PIC X(1) OCCURS 29. 003400 01 GROSSBUCHSTB PIC X(29) VALUE 003410 "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ". 003420 01 GROSSBUCHST-TAB REDEFINES GROSSBUCHSTB. 003430 05 GROSSBST PIC X(1) OCCURS 29. 003440**---------------------------------------------------------------- 003450** Variable Laengenfelder 003460**---------------------------------------------------------------- 003470 01 ANZ-PRUEF-STELLEN. 003480 05 DBNA-VOSA-LEN PIC 99 VALUE 20. 003490 05 DBAN-PLZ-LEN PIC 99 VALUE 10. 003500 05 DBAN-WHOT-LEN PIC 99 VALUE 34. 003600 05 DBAN-STR-LEN PIC 99 VALUE 33. 003700 05 DBAN-ADRZU-LEN PIC 99 VALUE 40. 003800 003900 003602*COPY DFEKTLG. 003603*COPY DKTLG. 003450**---------------------------------------------------------------- 003460** COPY-MEMBER : DKTLG 003470** PROGRAMMIERER : WERNER KRAUS 003480** ERSTELLUNGSDATUM : 17.04.1998 003490** VERSION : 001 (PGM-NEUERSTELLUNG) 003500** FUNKTION : FEHLERKATALOG 003501**---------------------------------------------------------------- 003502** PROGRAMMIERER : GERTRAUD SCHUHMACHER 003503** ÄNDERUNG : 002 VOM 22.11.2000 1. NACHGANG VERSION 21 003504** DBME043 003505**---------------------------------------------------------------- 003506** PROGRAMMIERER : GERTRAUD SCHUHMACHER 003507** ÄNDERUNG : 003 VOM 10.01.2001 VERSION 22 003508**---------------------------------------------------------------- 003509** PROGRAMMIERER : GERTRAUD SCHUHMACHER 003510** ÄNDERUNG : 004 VOM 30.04.2001 VERSION 24 003511**---------------------------------------------------------------- 003512** PROGRAMMIERER : GERTRAUD SCHUHMACHER 003513** ÄNDERUNG : 005 VOM 15.05.2001 VERSION 24 Nachgang 01 003514**---------------------------------------------------------------- 003515** PROGRAMMIERER : MICHAEL KLEMKE 003516** ÄNDERUNG : 006 VOM 15.10.2001 VERSION 25 Nachgang 01 003517**---------------------------------------------------------------- 003518** PROGRAMMIERER : MICHAEL KLEMKE 003519** ÄNDERUNG : 007 VOM 14.11.2001 VERSION 26 003520**---------------------------------------------------------------- 003521** PROGRAMMIERER : MICHAEL KLEMKE 003522** ÄNDERUNG : 008 VOM 13.12.2001 VERSION 26 Nachgang 03 003523**---------------------------------------------------------------- 003524** PROGRAMMIERER : MICHAEL KLEMKE 003525** ÄNDERUNG : 009 VOM 26.08.2002 VERSION 28 Nachgang 01 003526**---------------------------------------------------------------- 003527** PROGRAMMIERER : MICHAEL KLEMKE 003528** ÄNDERUNG : 010 VOM 04.11.2002 VERSION 29 003529**---------------------------------------------------------------- 003530** PROGRAMMIERER : MICHAEL KLEMKE 003531** ÄNDERUNG : 011 VOM 03.02.2003 VERSION 30 003532**---------------------------------------------------------------- 003533** PROGRAMMIERER : MICHAEL KLEMKE 003534** ÄNDERUNG : 012 VOM 06.02.2003 VERSION 30 NACHGANG 01 003535**---------------------------------------------------------------- 003536** PROGRAMMIERER : MICHAEL KLEMKE 003537** ÄNDERUNG : 013 VOM 24.02.2003 VERSION 31 003538**---------------------------------------------------------------- 003539** PROGRAMMIERER : MICHAEL KLEMKE 003540** ÄNDERUNG : 014 VOM 12.03.2003 VERSION 31 NACHGANG 01 003541**---------------------------------------------------------------- 003542** PROGRAMMIERER : MICHAEL KLEMKE 003543** ÄNDERUNG : 015 VOM 26.10.2003 VERSION 36 003544**---------------------------------------------------------------- 003545** PROGRAMMIERER : MICHAEL KLEMKE 003546** ÄNDERUNG : 016 VOM 14.10.2004 VERSION 41 003547**---------------------------------------------------------------- 003548** PROGRAMMIERER : MICHAEL KLEMKE 003549** ÄNDERUNG : 017 VOM 08.12.2004 VERSION 42 003550**---------------------------------------------------------------- 003551** PROGRAMMIERER : MICHAEL KLEMKE 003552** ÄNDERUNG : 018 VOM 07.02.2005 VERSION 43 003553**---------------------------------------------------------------- 003554** PROGRAMMIERER : MICHAEL KLEMKE 003555** ÄNDERUNG : 019 VOM 16.02.2005 VERSION 44 003556**---------------------------------------------------------------- 003557** PROGRAMMIERER : MICHAEL KLEMKE 003558** ÄNDERUNG : 020 VOM 13.04.2005 VERSION 45 003559**---------------------------------------------------------------- 003560** PROGRAMMIERER : MICHAEL KLEMKE 003561** ÄNDERUNG : 021 VOM 02.06.2005 VERSION 46 003562**---------------------------------------------------------------- 003563** PROGRAMMIERER : MICHAEL KLEMKE 003564** ÄNDERUNG : 022 VOM 31.10.2005 VERSION 50 003565**---------------------------------------------------------------- 003566** PROGRAMMIERER : MICHAEL KLEMKE 003567** ÄNDERUNG : 023 VOM 24.04.2006 VERSION 53 003568**---------------------------------------------------------------- 003569** PROGRAMMIERER : MICHAEL KLEMKE 003570** ÄNDERUNG : 024 VOM 14.07.2006 VERSION 55 003571**---------------------------------------------------------------- 003572** PROGRAMMIERER : MICHAEL KLEMKE 003573** ÄNDERUNG : 025 VOM 13.10.2006 VERSION 56 003574**---------------------------------------------------------------- 003575** PROGRAMMIERER : MICHAEL KLEMKE 003576** ÄNDERUNG : 026 VOM 11.12.2006 VERSION 58 003577**---------------------------------------------------------------- 003578** PROGRAMMIERER : MICHAEL KLEMKE 003579** ÄNDERUNG : 027 VOM 23.02.2007 VERSION 60 003580**---------------------------------------------------------------- 003581** PROGRAMMIERER : MICHAEL KLEMKE 003582** ÄNDERUNG : 028 VOM 13.03.2007 VERSION 61 003583**---------------------------------------------------------------- 003584** PROGRAMMIERER : MICHAEL KLEMKE 003585** ÄNDERUNG : 029 VOM 23.04.2007 VERSION 62 003586**---------------------------------------------------------------- 003590 01 FEHLERKONST. 003820 05 FILLER PIC X(72) VALUE 003830 "DSME004 KENNUNG unzulässig für diesen Absender (VFMM im VOSZ 003840- ")". 003850 05 FILLER PIC X(72) VALUE 003860 "DSME010 VF KVNR unzul. bei VFMM im VOSZ <> KVTRV, RVTKV, KVT 003861- "WL u. WLTKV". 003870 05 FILLER PIC X(72) VALUE 003880 "DSME020 BBNR-ABSENDER fehlerhaft (Ziffer 1.3.2.2 Gem. Rundsc 003890- "hreiben)". 003900 05 FILLER PIC X(72) VALUE 003910 "DSME022 BBNRAB bei sonst. Stellen unzulässig i. V. m. VFMM i 003920- "m VOSZ". 003930 05 FILLER PIC X(72) VALUE 003940 "DSME030 BBNR-EMPFAENGER fehlerhaft (Ziffer 1.3.2.2 Gem. Rund 003950- "schreiben)". 003960 05 FILLER PIC X(72) VALUE 003970 "DSME032 BBNREP unzulässig bei Meldungen an die RV oder der R 003971- "V an die BA". 003972 05 FILLER PIC X(72) VALUE 003973 "DSME040 VERSIONS-NR nicht numerisch". 003980 05 FILLER PIC X(72) VALUE 003990 "DSME042 VERSIONS-NR nicht zugelassen". 004000 05 FILLER PIC X(72) VALUE 004010 "DSME050 DATUM-ERSTELLUNG nicht numerisch". 004020 05 FILLER PIC X(72) VALUE 004030 "DSME052 DATUM-ERSTELLUNG logisch falsch". 004040 05 FILLER PIC X(72) VALUE 004050 "DSME054 DATUM-ERSTELLUNG größer Verarbeitungsdatum". 004060 05 FILLER PIC X(72) VALUE 004070 "DSME056 DATUM-ERSTELLUNG (Uhrzeit) logisch falsch". 004080 05 FILLER PIC X(72) VALUE 004090 "DSME058 DATUM-ERSTELLUNG (Uhrzeit) größer/gleich Verarbeitun 004100- "gszeitpunkt". 004110 05 FILLER PIC X(72) VALUE 004120 "DSME060 FEHLER-KZ nicht numerisch". 004130 05 FILLER PIC X(72) VALUE 004140 "DSME062 FEHLER-KZ ungleich 0 - 4". 004200 05 FILLER PIC X(72) VALUE 004210 "DSME070 FEHLER-ANZAHL nicht numerisch". 004220 05 FILLER PIC X(72) VALUE 004230 "DSME072 FEHLER-ANZAHL ungleich 0, FEHLER-KZ gleich 0". 004240 05 FILLER PIC X(72) VALUE 004250 "DSME080 VSNR Grundstellung, keine Meldung mit GD 00, 01, 10- 004260- "13 oder 40". 004270 05 FILLER PIC X(72) VALUE 004280 "DSME082 VSNR / ITVSNR unvollständig/enthält unzulässige Zeic 004290- "hen". 004300 05 FILLER PIC X(72) VALUE 004310 "DSME084 VSNR unzulässige Bereichsnummer". 004311 05 FILLER PIC X(72) VALUE 004312 "DSME085 Die Angabe der Bereichsnummer 40 ist unzulässig". 004320 05 FILLER PIC X(72) VALUE 004330 "DSME086 VSNR (Geburtsdatum) unzulässig". 004340 05 FILLER PIC X(72) VALUE 004350 "DSME088 VSNR / ITVSNR - Prüfziffer falsch". 004351 05 FILLER PIC X(72) VALUE 004352 "DSME089 Die Verwendung der angegebenen VSNR ist unzulässig". 004360 05 FILLER PIC X(72) VALUE 004370 "DSME090 ITVSNR angegeben, unzulässiger Absender". 004380 05 FILLER PIC X(72) VALUE 004390 "DSME092 ITVSNR nicht angegeben, Absender BA oder Kommunen". 004400 05 FILLER PIC X(72) VALUE 004410 "DSME096 ITVSNR (Geburtsdatum) unzulässig". 004420 05 FILLER PIC X(72) VALUE 004430 "DSME098 ITVSNR (Bereichsnummer) unzulässig". 004440 05 FILLER PIC X(72) VALUE 004450 "DSME099 ITVSNR (Bereichsnummer) ungleich 41 zwischen ZfA und 004451- " RV". 004452 05 FILLER PIC X(72) VALUE 004453 "DSME100 ITVSNR (Bereichsnummer) ungleich 00 von KNV/See-Kran 004460- "kenkasse". 004470 05 FILLER PIC X(72) VALUE 004480 "DSME101 ITVSNR (Bereichsnummer) 41, Meldung nicht zwischen Z 004490- "fA und RV". 004491 05 FILLER PIC X(72) VALUE 004492 "DSME102 ITVSNR (Bereichsnummer) ungleich 77 von Künstlersozi 004493- "alkasse". 004500 05 FILLER PIC X(72) VALUE 004510 "DSME104 ITVSNR (Bereichsnummer) ungleich 83 - 87 von Kranken 004520- "kasse". 004530 05 FILLER PIC X(72) VALUE 004540 "DSME106 ITVSNR (Bereichsnummer) ungleich 88 von BA oder Komm 004541- "unen". 004550 05 FILLER PIC X(72) VALUE 004560 "DSME108 ITVSNR (Bereichsnummer) ungleich 91 von Wehrverwaltu 004570- "ng". 004580 05 FILLER PIC X(72) VALUE 004590 "DSME110 ITVSNR (Bereichsnummer) ungleich 92 von Zivildienstv 004600- "erwaltung". 004610 05 FILLER PIC X(72) VALUE 004620 "DSME112 ITVSNR (Bereichsnummer) ungleich 94 von prv. Pflegek 004630- "asse". 004640 05 FILLER PIC X(72) VALUE 004650 "DSME120 VSTR unzulässige Zeichen". 004651 05 FILLER PIC X(72) VALUE 004652 "DSME122 VSTR ungleich Grundstellung, 0A, 0B, 0C oder 0G". 004660 05 FILLER PIC X(72) VALUE 004670 "DSME124 VSTR ungleich 0A, 0B, 0C oder 0G". 004730 05 FILLER PIC X(72) VALUE 004740 "DSME132 VSTR ungleich BA, BB, BC, oder BG von Datenstelle". 004760 05 FILLER PIC X(72) VALUE 004770 "DSME140 Die Grundstellung im Feld BBNRVU ist unzulässig". 004781 05 FILLER PIC X(72) VALUE 004782 "DSME141 Die Verwendung der angegebenen BBNRVU ist unzulässig 004783- " ". 004790 05 FILLER PIC X(72) VALUE 004800 "DSME142 BBNRVU fehlerhaft (Ziffer 1.3.2.2 des Gem. Rundschre 004810- "ibens)". 004820 05 FILLER PIC X(72) VALUE 004830 "DSME143 BBNRVU gleich 0C oder 0G nicht von Knappschaftsbetri 004840- "eb". 004850 05 FILLER PIC X(72) VALUE 004860 "DSME144 BBNRVU für KSK; Meldung von AG, KK oder BA". 004880 05 FILLER PIC X(72) VALUE 004890 "DSME146 BBNRVU ungleich 32349289 für Wehrverwaltung". 004900 05 FILLER PIC X(72) VALUE 004910 "DSME148 BBNRVU ungleich 38065304 für Zivildienstverwaltung 004920- "". 004930 05 FILLER PIC X(72) VALUE 004940 "DSME150 BBNRVU in den ersten 3 Stellen ungleich 996 bei prv. 004950- " Pflegekasse". 004990 05 FILLER PIC X(72) VALUE 005000 "DSME154 BBNRVU ungleich 01085914 / 28180427 für die Künstler 005010- "sozialkasse". 005011 05 FILLER PIC X(72) VALUE 005012 "DSME155 BBNRVU ungleich 02998824 für Meldungen der ZfA an di 005013- "e RV". 005031 05 FILLER PIC X(72) VALUE 005032 "DSME159 BBNRVU ungleich 90209055 für Meldungen der RV an die 005033- " ZfA". 005040 05 FILLER PIC X(72) VALUE 005050 "DSME160 AZ-VU von BA, Kundennummer enthält unzulässige Zeich 005060- "en". 005061 05 FILLER PIC X(72) VALUE 005062 "DSME168 BBNR-KK bei Meldungen der ZfA an die RV nicht Grunds 005063- "tellung". 005064 05 FILLER PIC X(72) VALUE 005065 "DSME169 BBNR-KK bei Meldungen des BAZ an die RV ist Grundste 005066- "llung". 005070 05 FILLER PIC X(72) VALUE 005080 "DSME170 BBNR-KK fehlerhaft (Ziffer 1.3.2.2 des Gem. Rundschr 005090- "eibens)". 005091 05 FILLER PIC X(72) VALUE 005092 "DSME171 Die Verwendung der angegebenen BBNR-KK ist unzulässi 005093- "g". 005100 05 FILLER PIC X(72) VALUE 005110 "DSME172 BBNR-KK ungleich BBNRVU, Meldung der prv. Pflegekass 005120- "e/KSK". 005121 05 FILLER PIC X(72) VALUE 005122 "DSME174 BBNR-KK unzulässige Betriebsnummer verwendet". 005123 05 FILLER PIC X(72) VALUE 005124 "DSME176 BBNR-KK ungleich BBNR-Empfänger". 005130 05 FILLER PIC X(72) VALUE 005140 "DSME190 BBNR-AS fehlerhaft (Ziffer 1.3.2.2 Gem. Rundschreibe 005150- "n)". 005151 05 FILLER PIC X(72) VALUE 005152 "DSME195 Die Verwendung der angegebenen BBNR-AS ist unzulässi 005153- "g". 005160 05 FILLER PIC X(72) VALUE 005170 "DSME200 PERSGR nicht numerisch". 005180 05 FILLER PIC X(72) VALUE 005190 "DSME201 PERSGR 999, nicht vom AG". 005200 05 FILLER PIC X(72) VALUE 005210 "DSME202 PERSGR Stelle 1 ungleich 1 vom AG". 005220 05 FILLER PIC X(72) VALUE 005230 "DSME204 PERSGR unzulässig (Anl. 2 des Gemeinsamen Rundschrei 005240- "bens)". 005270 05 FILLER PIC X(72) VALUE 005280 "DSME208 PERSGR unzulässig in Verbindung mit BBNRVU 985xxxxx/ 005290- "987xxxxx". 005300 05 FILLER PIC X(72) VALUE 005310 "DSME209 PERSGR für Beschäftigte in Seefahrt, BBNRVU nicht 09 005320- "9, 990-992". 005390 05 FILLER PIC X(72) VALUE 005400 "DSME212 PERSGR nicht für Künstler/Publizisten, BBNRVU 010859 005410- "14/28180427". 005420 05 FILLER PIC X(72) VALUE 005430 "DSME216 PERSGR ungleich Grundstellung (Nullen) von BA oder K 005431- "ommunen". 005440 05 FILLER PIC X(72) VALUE 005450 "DSME218 PERSGR 301 oder 302, BBNRVU ungleich Wehrverwaltung 005460- "(32349289)". 005500 05 FILLER PIC X(72) VALUE 005510 "DSME222 PERSGR 303/304, BBNRVU ungleich Zivildienstverwaltun 005520- "g (38065304)". 005560 05 FILLER PIC X(72) VALUE 005570 "DSME226 PERSGR 207/208, BBNRVU nicht prv. Pflegek. (Beginn n 005580- "icht 996)". 005590 05 FILLER PIC X(72) VALUE 005600 "DSME228 PERSGR nicht 207/208, BBNRVU prv. Pflegek. (Beginn g 005610- "leich 996)". 005620 05 FILLER PIC X(72) VALUE 005630 "DSME230 GD nicht numerisch". 005640 05 FILLER PIC X(72) VALUE 005650 "DSME231 GD alter Art (DÜVO) nicht vom AG". 005660 05 FILLER PIC X(72) VALUE 005670 "DSME232 GD unzulässig (Anl. 1 des Gemeinsamen Rundschreibens 005680- ")". 005720 05 FILLER PIC X(72) VALUE 005730 "DSME234 GD 00, 01, 10-13 oder 40, VSNR Grundstellung". 005741 05 FILLER PIC X(72) VALUE 005742 "DSME235 PERSGR für Künstler/Publizisten, BBNRVU ungl. 281804 005743- "27/01085914". 005750 05 FILLER PIC X(72) VALUE 005760 "DSME236 GD ungl. Vergabe VSNR (99) von best. Absendern oder 005761- "VF = KVNR". 005770 05 FILLER PIC X(72) VALUE 005780 "DSME238 GD ungleich 30 oder 99 von Wehr- oder Zivildienstver 005790- "waltung". 005791 05 FILLER PIC X(72) VALUE 005792 "DSME239 GD gleich 59, nicht von Krankenkasse". 005800 05 FILLER PIC X(72) VALUE 005810 "DSME240 GD ungleich 30, 50, 60, 61 oder 99 von privater Pfle 005820- "gekasse". 005830 05 FILLER PIC X(72) VALUE 005840 "DSME241 VSTR bei Meldungen mit GD = 60-63, 80, 90 od. 99 unz 005850- "ulässig". 005851 05 FILLER PIC X(72) VALUE 005852 "DSME242 GD ungleich Vergabe/Rückmeldung VSNR, aber ITVSNR an 005853- "gegeben". 005854 05 FILLER PIC X(72) VALUE 005855 "DSME243 GD 56, aber Meldung nicht unter Personengruppe 103 o 005856- "der 142". 005860 05 FILLER PIC X(72) VALUE 005870 "DSME244 GD ungleich 60, 61, 90 oder 99, Personengruppe Grund 005880- "stellung". 005890 05 FILLER PIC X(72) VALUE 005900 "DSME245 PERSGR 107/204,GD ungl.60,61,80,90,99, BBNRVU nicht 005910- "985x/987x". 005920 05 FILLER PIC X(72) VALUE 005930 "DSME246 GD ungleich Anmeldung und Vergabe VSNR, keine VSNR a 005940- "ngegeben". 005950 05 FILLER PIC X(72) VALUE 005960 "DSME247 GD 63 oder 90, Meldung für PERSGR = 202". 005980 05 FILLER PIC X(72) VALUE 005990 "DSME248 Kombination GD / Datenbaustein unzulässig (Anl. 4 Ge 006000- "m. Runds.)". 006001 05 FILLER PIC X(72) VALUE 006002 "DSME249 GD 94 / 95, Meldung nicht zwischen Krankenkasse und 006003- "Rentenvers.". 006010 05 FILLER PIC X(72) VALUE 006020 "DSME250 STAATSANGEHOERIGKEITS-SC unzulässig (Grundstellung) 006030- "". 006040 05 FILLER PIC X(72) VALUE 006050 "DSME252 STAATSANGEHOERIGKEITS-SC unzulässig (Anl. 8 Gem. Run 006060- "dschreiben)". 006061 05 FILLER PIC X(72) VALUE 006062 "DSME253 SASC Jugoslawien oder Serbien-Montenegro unzulässig 006063- " ". 006070 05 FILLER PIC X(72) VALUE 006080 "DSME254 SASC ungleich 000 von Wehr-/Zivildienstverwaltung". 006090 05 FILLER PIC X(72) VALUE 006100 "DSME260 MM-MELDEDATEN ungleich N oder J". 006110 05 FILLER PIC X(72) VALUE 006120 "DSME264 MM-MELDEDATEN ungl. N bei Meldungen der BA oder der 006121- "Kommunen". 006130 05 FILLER PIC X(72) VALUE 006140 "DSME270 MM-NAME ungleich N oder J". 006150 05 FILLER PIC X(72) VALUE 006160 "DSME274 MM-NAME ungl. J bei Meldungen der BA oder der Kommun 006161- "en". 006170 05 FILLER PIC X(72) VALUE 006180 "DSME280 MM-GEBNAME ungleich N oder J". 006190 05 FILLER PIC X(72) VALUE 006200 "DSME284 MM-GEBNAME ungl. J bei Meldungen der BA oder der Kom 006201- "munen". 006210 05 FILLER PIC X(72) VALUE 006220 "DSME290 MM-ANSCHRIFT ungleich N oder J". 006230 05 FILLER PIC X(72) VALUE 006240 "DSME294 MM-ANSCHRIFT ungl. J bei Meldungen der BA oder der K 006241- "ommunen". 006250 05 FILLER PIC X(72) VALUE 006260 "DSME300 MM-EUDATEN ungleich N oder J". 006261 05 FILLER PIC X(72) VALUE 006262 "DSME302 MM-EUDATEN gleich J, Staatsangehörigkeit nicht von E 006263- "U/EWR-Land". 006270 05 FILLER PIC X(72) VALUE 006280 "DSME304 MM-EUDATEN = J, Meldung von BWV / BZV". 006290 05 FILLER PIC X(72) VALUE 006300 "DSME316 Reserve ungleich Grundstellung (Leerstellen)". 006310 05 FILLER PIC X(72) VALUE 006320 "DSME318 RESERVE enthält den Wert N; Absender dafür nicht zug 006330- "elassen". 006360 05 FILLER PIC X(72) VALUE 006370 "DSME320 MM-KNV-SEE ungleich N oder J". 006380 05 FILLER PIC X(72) VALUE 006390 "DSME322 MM-KNV-SEE ungl.N von BA/Kommunen/BWV/BZD/prv.Pflege 006400- "k./KSK". 006410 05 FILLER PIC X(72) VALUE 006420 "DSME324 MM-KNV-SEE gleich J; BBNRVU bzw. BBNR-KK fehlerhaft 006421- " ". 006425 05 FILLER PIC X(72) VALUE 006426 "DSME330 MM-SVA ungleich N oder J". 006430 05 FILLER PIC X(72) VALUE 006440 "DSME332 MM-SVA ungleich N, Meldung nicht von der Krankenkass 006450- "e". 006460 05 FILLER PIC X(72) VALUE 006470 "DSME340 MM-VERGABE-RUECKMELDUNG ungleich N oder J". 006480 05 FILLER PIC X(72) VALUE 006490 "DSME342 MM-VERGABE-RUECKMELDUNG ungleich N von AG / KSK". 006500 05 FILLER PIC X(72) VALUE 006510 "DSME344 MM-VERGABE-RUECKMELDUNG ungleich J von BA/Kommunen". 006520 05 FILLER PIC X(72) VALUE 006530 "DSME350 MM-RUECKMELDUNG-GERINGFUEGIG ungleich N oder J". 006540 05 FILLER PIC X(72) VALUE 006550 "DSME352 MM-RUECKMELDUNG-GERINGFUEGIG unzulässigerweise mit J 006560- " angegeben". 006600 05 FILLER PIC X(72) VALUE 006610 "DSME360 KENNZ-UEBERGANG nicht Grundstellung (Leerzeichen), 1 006611- " - 8 oder A". 006620 05 FILLER PIC X(72) VALUE 006630 "DSME361 KENNZ-UEBERGANG ungleich Grundstellung". 006640 05 FILLER PIC X(72) VALUE 006641 "DSME362 KENNZ-UEBERGANG = 1 - 7, Meldung nicht zwischen BA u 006642- "nd RV". 006643 05 FILLER PIC X(72) VALUE 006644 "DSME363 KENNZ-UEBERGANG = A, Verarb.-Datum größer 31.12.2004 006645- "". 006650 05 FILLER PIC X(72) VALUE 006660 "DSME364 KENNZ-UEBERGANG ungleich A, Personengruppe gleich 99 006670- "9". 006671 05 FILLER PIC X(72) VALUE 006672 "DSME365 KENNZ-UEBERGANG ungleich 8, Meldung nicht von einer 006673- "Kommune". 006680 05 FILLER PIC X(72) VALUE 006690 "DSME366 KENNZ-UEBERGANG ungleich A, Grund 00 - 05 oder 07 - 006700- "09". 006710 05 FILLER PIC X(72) VALUE 006720 "DSME380 MM-UEBERMITTLUNG ungleich Grundstellung, 1, 2, oder 006721- "9". 006722 05 FILLER PIC X(72) VALUE 006723 "DSME381 MM-UEBERMITTLUNG ungleich Grundstellung". 006724 05 FILLER PIC X(72) VALUE 006725 "DSME383 KENNZUP ungl. Grundstellung oder ungl. D". 006726 05 FILLER PIC X(72) VALUE 006727 "DSME385 KENNZUP gleich D; GD ungleich 99". 006728 05 FILLER PIC X(72) VALUE 006729 "DSME386 KENNZUP ungleich Grundstellung". 006730 05 FILLER PIC X(72) VALUE 006731 "DSME387 RESERVE ungleich Grundstellung, N oder J". 006734 05 FILLER PIC X(72) VALUE 006735 "DSME400 KENNZ-STATUS ist nicht Grundstellung, 1, 2, 3 oder 5 006736- "". 006737 05 FILLER PIC X(72) VALUE 006738 "DSME402 KENNZSTA nicht Grundstellung/1/2 bei Meldungen der A 006739- "rbeitgeber". 006740 05 FILLER PIC X(72) VALUE 006741 "DSME410 Reserve (Stelle 187 - 190 im DSME) ist nicht Grundst 006742- "ellung". 006743 05 FILLER PIC X(72) VALUE 006744 "DSME500 MMUE ist nicht Grundstellung, N oder J". 006745 05 FILLER PIC X(72) VALUE 006746 "DSME542 MMUE ungleich Grundstellung oder N; Meld nicht DRV B 006750- "und an DSRV". 006751 05 FILLER PIC X(72) VALUE 006752 "DSME910 Gesamtlänge DSME einschließl. der angeh. Datenbauste 006753- "ine falsch". 006760 05 FILLER PIC X(72) VALUE 006770 "DSME920 Datensatz enthält mehr als 9 Fehler, Prüfung abgebro 006780- "chen". 006790 05 FILLER PIC X(72) VALUE 006800 "DSME922 Datensatz enthält mehr als 9 Hinweise, Prüfung abgeb 006810- "rochen". 006820 05 FILLER PIC X(72) VALUE 006830 "DSME930 DBME - Meldesachverhalt fehlt oder an falscher Stell 006840- "e". 006850 05 FILLER PIC X(72) VALUE 006860 "DSME931 DBNA - Name fehlt oder an falscher Stelle". 006870 05 FILLER PIC X(72) VALUE 006880 "DSME932 DBGB - Geburtsangaben fehlt oder an falscher Stelle 006890- "". 006900 05 FILLER PIC X(72) VALUE 006910 "DSME933 DBAN - Anschrift fehlt oder an falscher Stelle". 006920 05 FILLER PIC X(72) VALUE 006930 "DSME934 DBEU - Europäische VSNR fehlt oder an falscher Stell 006940- "e". 006970 05 FILLER PIC X(72) VALUE 006980 "DSME936 DBKS - KNV-/See-KK-Daten fehlt oder an falscher Stel 006990- "le". 007000 05 FILLER PIC X(72) VALUE 007010 "DSME937 DBSV - Sozialversicherungsausweis fehlt oder an fals 007020- "cher Stelle". 007030 05 FILLER PIC X(72) VALUE 007040 "DSME938 DBVR - Vergabe/Rückmeldung fehlt oder an falscher St 007050- "elle". 007060 05 FILLER PIC X(72) VALUE 007070 "DSME939 DBRG - Rückmeldung geringf. Besch. fehlt oder an fal 007080- "scher Stelle". 007090 05 FILLER PIC X(72) VALUE 007100 "DSKO004 Kennung unzulässig für diesen Absender (VFMM im VOSZ 007101- ")". 007110 05 FILLER PIC X(72) VALUE 007120 "DSKO040 VERSIONS-NR nicht numerisch". 007200 05 FILLER PIC X(72) VALUE 007210 "DSKO042 VERSIONS-NR nicht zugelassen". 007220 05 FILLER PIC X(72) VALUE 007230 "DSKO050 DATUM-ERSTELLUNG nicht numerisch". 007240 05 FILLER PIC X(72) VALUE 007250 "DSKO052 DATUM-ERSTELLUNG logisch falsch". 007260 05 FILLER PIC X(72) VALUE 007270 "DSKO054 DATUM-ERSTELLUNG größer Verarbeitungsdatum". 007280 05 FILLER PIC X(72) VALUE 007290 "DSKO056 DATUM-ERSTELLUNG (Uhrzeit) logisch falsch". 007294 05 FILLER PIC X(72) VALUE 007295 "DSKO060 FEHLER-KENNZ nicht numerisch". 007296 05 FILLER PIC X(72) VALUE 007297 "DSKO062 FEHLER-KENNZ ungleich 0 und 1". 007298 05 FILLER PIC X(72) VALUE 007299 "DSKO070 FEHLER-ANZAHL nicht numerisch". 007300 05 FILLER PIC X(72) VALUE 007301 "DSKO072 FEHLER-ANZAHL ungleich 0, FEHLER-KZ gleich 0". 007303 05 FILLER PIC X(72) VALUE 007304 "DSKO500 NAME1-ABSENDER ist leer". 007305 05 FILLER PIC X(72) VALUE 007306 "DSKO530 PLZ-BETRIEB ist leer". 007307 05 FILLER PIC X(72) VALUE 007308 "DSKO540 ORT-BETRIEB ist leer". 007309 05 FILLER PIC X(72) VALUE 007310 "DSKO550 STRASSE-BETRIEB ist leer". 007311 05 FILLER PIC X(72) VALUE 007312 "DSKO570 ANREDE-ANSPRECHPARTNER ungleich Grundstellung, M ode 007313- "r W". 007314 05 FILLER PIC X(72) VALUE 007315 "DSKO605 EMAIL-EMPFAENGER-PROTOKOLLE ist leer". 007316 05 FILLER PIC X(72) VALUE 007317 "DSKO610 EMAIL-EMPFAENGER-PROTOKOLLE enthält unzulässige Zeic 007318- "hen". 007319 05 FILLER PIC X(72) VALUE 007320 "DSKO612 EMAIL-EMPFAENGER-PROTOKOLLE enthält unzulässige Zeic 007321- "hen". 007323 05 FILLER PIC X(72) VALUE 007324 "DSKO910 Zulässig ist nur die Datensatzlänge von 410". 007325 007326 05 FILLER PIC X(72) VALUE 007327 "DBME001 KENNUNG ungleich DBME". 007328 05 FILLER PIC X(72) VALUE 007330 "DBME010 KENNZ-STORNO ungleich N oder J". 007331 05 FILLER PIC X(72) VALUE 007332 "DBME012 KENNZST = N, Meldung für kurzfr. Beschäftigte mit GD 007333- " ungl. 40". 007334 05 FILLER PIC X(72) VALUE 007335 "DBME013 GD gleich 59, PERSGR ungleich 205". 007340 05 FILLER PIC X(72) VALUE 007350 "DBME015 KENNZST = N,Anmeldung für Beschäftigte mit Statusken 007351- "nzeichen = 1". 007352 05 FILLER PIC X(72) VALUE 007353 "DBME017 KENNZUE = A ist für Meldungen ab 01.01.2005 unzuläss 007354- "ig". 007355 05 FILLER PIC X(72) VALUE 007356 "DBME018 SASC 132 oder 138 bei Anmeldungen ungl. Stornierung 007357- "unzulässig". 007358 05 FILLER PIC X(72) VALUE 007359 "DBME020 KENNZGLE ungleich Grundstellung (Leerzeichen), N, J, 007360- " 0, 1 oder 2". 007361 05 FILLER PIC X(72) VALUE 007362 "DBME021 KENNZGLE gleich Grundstellung (Leerzeichen) unzuläss 007363- "ig". 007364 05 FILLER PIC X(72) VALUE 007365 "DBME022 KENNZGLE ungleich Grundstellung, 0, 1 oder 2 ab dem 007366- "01.01.2007". 007367 05 FILLER PIC X(72) VALUE 007368 "DBME024 KENNZGLE gleich 1 oder 2 bei unzulässiger Personengr 007369- "uppe". 007370 05 FILLER PIC X(72) VALUE 007371 "DBME028 ZRBG kleiner 01.01.2005,Statuskennzeichen ungleich G 007372- "rundstellung". 007373 05 FILLER PIC X(72) VALUE 007374 "DBME029 ZRBG größer 31.03.2003, MM-KNV-SEE = J, geringfügig 007380- "beschäftigt". 007390 05 FILLER PIC X(72) VALUE 007400 "DBME030 ZEITRAUM-BEGINN nicht numerisch". 007401 05 FILLER PIC X(72) VALUE 007402 "DBME031 Meldung mit VSTR = 0B für Zeiten ab 01.01.2005 ist u 007403- "nzulässig". 007410 05 FILLER PIC X(72) VALUE 007420 "DBME032 ZEITRAUM-BEGINN bei GD 55 oder 56 vor dem 01.01.1999 007430- "". 007431 05 FILLER PIC X(72) VALUE 007432 "DBME033 ZREN größer 31.03.2003, MM-KNV-SEE = J, geringfügig 007433- "beschäftigt". 007440 05 FILLER PIC X(72) VALUE 007450 "DBME034 ZEITRAUM-BEGINN logisch falsch". 007451 05 FILLER PIC X(72) VALUE 007452 "DBME035 ZRBG bei Zivildienst/frw. soz./ökol. Jahr vor dem 16 007453- ". Lebensjahr". 007460 05 FILLER PIC X(72) VALUE 007470 "DBME036 ZEITRAUM-BEGINN vor dem 01.01.1973". 007471 05 FILLER PIC X(72) VALUE 007472 "DBME037 ZEITRAUM-ENDE nach dem 31.03.2003 (Haushaltsscheck) 007473- "". 007480 05 FILLER PIC X(72) VALUE 007490 "DBME038 ZEITRAUM-BEGINN größer/gleich Verarb.Datum plus 2 Ka 007500- "lendermonate". 007501 05 FILLER PIC X(72) VALUE 007502 "DBME039 ZEITRAUM-BEGINN kleiner 01.01.2003, KENNZGLE 1 oder 007503- "2". 007510 05 FILLER PIC X(72) VALUE 007520 "DBME040 ZEITRAUM-BEGINN größer/gleich Verarb.Datum plus 1 Ka 007530- "lendermonat". 007540 05 FILLER PIC X(72) VALUE 007550 "DBME041 ZEITRAUM-BEGINN bei geringfügig Beschäftigten vor de 007560- "m 01.04.1999". 007561 05 FILLER PIC X(72) VALUE 007562 "DBME042 ZEITRAUM-BEGINN größer/gleich Verarb.Datum plus 2 Ka 007563- "lenderjahre". 007564 05 FILLER PIC X(72) VALUE 007565 "DBME043 ZEITRAUM-BEGINN nach dem 31.12.1999, KENNZUE = A". 007570 05 FILLER PIC X(72) VALUE 007580 "DBME044 ZEITRAUM-BEGINN nicht erster Tag des Monats". 007600 05 FILLER PIC X(72) VALUE 007610 "DBME045 ZEITRAUM-BEGINN bei vermuteter Beschäftigung vor dem 007611- " 01.01.1999". 007612 05 FILLER PIC X(72) VALUE 007613 "DBME046 ZEITRAUM-BEGINN vor dem 01.04.1995 (Pflegeperson)". 007620 05 FILLER PIC X(72) VALUE 007630 "DBME047 ZEITRAUM-BEGINN bei Wehr/Zivildienst vor dem 17. Leb 007640- "ensjahr". 007650 05 FILLER PIC X(72) VALUE 007660 "DBME048 ZRBG vor 01.01.1997 oder nach 31.03.2003 (Haushaltss 007670- "check)". 007680 05 FILLER PIC X(72) VALUE 007690 "DBME049 ZRBG vor 01.04.2003, GD = 40 und VSNR = Grundstellun 007700- "g". 007710 05 FILLER PIC X(72) VALUE 007720 "DBME050 ZEITRAUM-ENDE nicht numerisch". 007721 05 FILLER PIC X(72) VALUE 007722 "DBME051 ZEITRAUM-BEGINN bei frw. / ökol. Jahr vor dem 01.08. 007723- "2002". 007730 05 FILLER PIC X(72) VALUE 007740 "DBME052 ZEITRAUM-ENDE logisch falsch". 007741 05 FILLER PIC X(72) VALUE 007742 "DBME053 ZRBG vor dem 01.01.1989; Meldung für Seeleute in Alt 007743- "ersteilzeit". 007750 05 FILLER PIC X(72) VALUE 007760 "DBME054 ZEITRAUM-ENDE ungleich Grundstellung bei Anmeldung". 007761 05 FILLER PIC X(72) VALUE 007762 "DBME055 ZRBG vor 55. Lebensjahr; Meldung für Seeleute in Alt 007763- "ersteilzeit". 007770 05 FILLER PIC X(72) VALUE 007780 "DBME056 ZEITRAUM-ENDE kleiner ZEITRAUM-BEGINN". 007790 05 FILLER PIC X(72) VALUE 007800 "DBME057 ZEITRAUM-ENDE (Jahr) ungleich ZEITRAUM-BEGINN (Jahr) 007810- "". 007820 05 FILLER PIC X(72) VALUE 007830 "DBME058 ZREN größer Ende Verarb. Datum (Jahr) plus 2 Kalende 007840- "rjahre". 007850 05 FILLER PIC X(72) VALUE 007860 "DBME059 ZREN größer Ende Verarb. Datum (Monat) plus 1 Kalend 007870- "ermonat". 007880 05 FILLER PIC X(72) VALUE 007890 "DBME060 ZEITRAUM-ENDE größer/gleich Verarb. Datum (Meldung w 007900- "egen Tod) ". 007910 05 FILLER PIC X(72) VALUE 007920 "DBME061 ZEITRAUM-ENDE ungleich 31.12. eines Jahres (Jahresme 007930- "ldung) ". 007940 05 FILLER PIC X(72) VALUE 007950 "DBME062 ZREN (Monat) ungleich ZRBG (Monat) (Einmalzahlung od 007951- "er Störfall)". 007960 05 FILLER PIC X(72) VALUE 007970 "DBME063 ZREN (Tag) ungleich letzter Tag des Monats (Einmalza 007980- "hlung)". 007981 05 FILLER PIC X(72) VALUE 007982 "DBME064 ZREN nach dem 31.12.2004 bei Meldungen mit Personeng 007983- "ruppe 304". 007984 05 FILLER PIC X(72) VALUE 007985 "DBME065 GD = 50 - 54 für kurzfristig Beschäftigte unzulässig 007986- "". 007990 05 FILLER PIC X(72) VALUE 007991 "DBME068 ZEITRAUM-ENDE nach dem 31.12.1999; KENNZUE = A". 007992 05 FILLER PIC X(72) VALUE 007993 "DBME069 ZREN vor dem 01.04.2003; Meldung mit Gleitzonenregel 007994- "ung". 008020 05 FILLER PIC X(72) VALUE 008030 "DBME070 ZAHL-TAGE nicht numerisch". 008040 05 FILLER PIC X(72) VALUE 008050 "DBME072 ZAHL-TAGE ungl. Grundstellung (ungl. kurzfristig Bes 008060- "chäftigte)". 008070 05 FILLER PIC X(72) VALUE 008080 "DBME074 ZAHL-TAGE ungleich 01 bis 06 (kurzfristig Beschäftig 008090- "te)". 008100 05 FILLER PIC X(72) VALUE 008110 "DBME082 WAEHRUNGS-KENNZ unzulässig". 008120 05 FILLER PIC X(72) VALUE 008130 "DBME084 WAEHRUNGS-KENNZ gleich E für Zeiten vor dem 01.01.19 008140- "99". 008150 05 FILLER PIC X(72) VALUE 008160 "DBME086 WAEHRUNGS-KENNZ gleich D für Zeiten nach dem 31.12.2 008170- "001". 008180 05 FILLER PIC X(72) VALUE 008190 "DBME090 ENTGELT nicht numerisch". 008200 05 FILLER PIC X(72) VALUE 008210 "DBME091 Meldung mit Entgelt für Wehrübungsleistende vor 1990 008220- " unzulässig". 008221 05 FILLER PIC X(72) VALUE 008222 "DBME092 ENTGELT enthält unzulässigerweise keine Grundstellun 008223- "g". 008224 05 FILLER PIC X(72) VALUE 008225 "DBME093 ENTGELT Nullen, GD ungl. 51-53 oder ZRBE/Monat ungl. 008226- "ZREN/Monat". 008230 05 FILLER PIC X(72) VALUE 008240 "DBME094 ENTGELT Grundstellung (Nullen) unzulässig". 008250 05 FILLER PIC X(72) VALUE 008260 "DBME095 ENTGELT ungleich Grundstellung, WAEHRUNGS-KENNZ Grun 008270- "dstellung". 008280 05 FILLER PIC X(72) VALUE 008290 "DBME096 ENTGELT überschreitet die BBG". 008291 05 FILLER PIC X(72) VALUE 008292 "DBME097 ENTGELT enthält den Wert 000001". 008300 05 FILLER PIC X(72) VALUE 008310 "DBME098 ENTGELT überschreitet 80 % der Bezugsgröße (Pflegepe 008320- "rson)". 008330 05 FILLER PIC X(72) VALUE 008340 "DBME100 ENTGELT überschreitet den Höchstwert (Haushaltsschec 008350- "kverfahren)". 008351 05 FILLER PIC X(72) VALUE 008352 "DBME105 ENTGELT überschreitet den Höchstwert (geringfügig Be 008353- "schäftigte)". 008354 05 FILLER PIC X(72) VALUE 008355 "DBME106 BEITRAGSGRUPPE (RV) 2, 4, 6 für Zeiten ab 01.01.2005 008356- " unzulässig". 008360 05 FILLER PIC X(72) VALUE 008370 "DBME107 BEITRAGSGRUPPE 0000 unzulässig". 008371 05 FILLER PIC X(72) VALUE 008372 "DBME108 BEITRAGSGRUPPE in Verbindung mit Personengruppe unzu 008373- "lässig". 008374 05 FILLER PIC X(72) VALUE 008375 "DBME109 BEITRAGSGRUPPE gleich 5 oder 6, KENNZGLE gleich 1 od 008376- "er 2". 008377 05 FILLER PIC X(72) VALUE 008378 "DBME110 BEITRAGSGRUPPE nicht numerisch". 008380 05 FILLER PIC X(72) VALUE 008390 "DBME111 BEITRAGSGRUPPE unzulässiger Inhalt". 008400 05 FILLER PIC X(72) VALUE 008410 "DBME112 BEITRAGSGRUPPE (ALV/PV) = 9, GD nicht zul., KENNZUE 008420- "ungleich A". 008430 05 FILLER PIC X(72) VALUE 008440 "DBME113 BEITRAGSGRUPPE (RV) = 9, keine Anmeldung mit KENNZUE 008450- " A". 008460 05 FILLER PIC X(72) VALUE 008470 "DBME114 BYGR ungleich 0000 bei Meldung mit unzulässiger Pers 008471- "onengruppe". 008480 05 FILLER PIC X(72) VALUE 008481 "DBME115 BYGR-RV = 5 oder 6, kein geringfügig Beschäftigter". 008490 05 FILLER PIC X(72) VALUE 008500 "DBME116 BEITRAGSGRUPPE unzulässig (Bezieher von Vorruhestand 008510- "sgeld)". 008511 05 FILLER PIC X(72) VALUE 008512 "DBME117 BEITRAGSGRUPPE 0100 für Zeiten ab 01.01.2007 unzuläs 008513- "sig". 008520 05 FILLER PIC X(72) VALUE 008530 "DBME118 BEITRAGSGRUPPE unzul.(Bezieher von Ausgleichsgeld na 008540- "ch d. FELEG)". 008541 05 FILLER PIC X(72) VALUE 008542 "DBME119 BYGR-ALV ungleich 0, 1 und 2 bei geringfügig Beschäf 008543- "tigten". 008550 05 FILLER PIC X(72) VALUE 008560 "DBME120 BEITRAGSGRUPPE-RV ungl. 3,4,9 bei halbem RV-Anteil". 008570 05 FILLER PIC X(72) VALUE 008571 "DBME121 BEITRAGSGRUPPE 0110 für Zeiten vor 01.02.2006 unzulä 008572- "ssig". 008580 05 FILLER PIC X(72) VALUE 008590 "DBME122 BEITRAGSGRUPPE-KV = 5, ZRBG vor dem 01.01.1995". 008610 05 FILLER PIC X(72) VALUE 008620 "DBME124 BEITRAGSGRUPPE-PV ungl. 0 und 9; ZRBG vor dem 01.01. 008630- "1995". 008640 05 FILLER PIC X(72) VALUE 008650 "DBME126 BEITRAGSGRUPPE-ALV = 1, Versicherte(r) älter als 65 008660- "Jahre)". 008670 05 FILLER PIC X(72) VALUE 008680 "DBME128 BYGR-ALV = 2, Vers. jünger als 55 Jahre, keine Storn 008690- "ierung". 008700 05 FILLER PIC X(72) VALUE 008710 "DBME130 BEITRAGSGRUPPE-RV ungleich 0,1,3,5,9 bei ArV-VSTR". 008730 05 FILLER PIC X(72) VALUE 008740 "DBME132 BEITRAGSGRUPPE-RV ungleich 2,4,6,9 bei AnV-VSTR". 008760 05 FILLER PIC X(72) VALUE 008770 "DBME133 ZRBG/ZREN ab 01.04.2003, Meldung geringf. Besch. nic 008780- "ht an BKn". 008781 05 FILLER PIC X(72) VALUE 008782 "DBME134 BEITRAGSGRUPPE-RV ungl. 0,1,2,9 bei unst. Besch.". 008783 05 FILLER PIC X(72) VALUE 008784 "DBME135 BYGR ungleich 0100, 0110 oder 0200 (Wehr-/Zivildiens 008785- "t/Wehrübung)". 008790 05 FILLER PIC X(72) VALUE 008800 "DBME136 BYGR ungl. 0200 bei Künstlern/Publizisten an RV vor 008810- "01.01.2005". 008820 05 FILLER PIC X(72) VALUE 008830 "DBME137 BEITRAGSGRUPPE ungl.100x/200x/300x bei Künstler/Publ 008840- "izist an KV". 008850 05 FILLER PIC X(72) VALUE 008860 "DBME138 BYGR ungl. 0100/0200 der privaten Pflegekassen". 008871 05 FILLER PIC X(72) VALUE 008872 "DBME139 BYGR ungl. 0100 bei Künstlern/Publizisten an RV ab 0 008873- "1.01.2005". 008880 05 FILLER PIC X(72) VALUE 008890 "DBME140 TT-SC ungl. Grundstellung". 008910 05 FILLER PIC X(72) VALUE 008920 "DBME141 TAETIGKEITS-SC = 996/999, nicht vom AG, KENNZUE ungl 008930- "eich A". 008970 05 FILLER PIC X(72) VALUE 008980 "DBME143 TT-SC ungleich 99147, Meldung von der Künstlersozial 008990- "kasse". 009000 05 FILLER PIC X(72) VALUE 009010 "DBME146 TT-SC unzulässig (Schlüssel A der Anl. 5 Gem. Rundsc 009020- "hreiben)". 009030 05 FILLER PIC X(72) VALUE 009040 "DBME148 TT-SC unzulässig (Schlüssel B1 der Anl. 5 Gem. Runds 009050- "chreiben)". 009060 05 FILLER PIC X(72) VALUE 009070 "DBME150 TT-SC unzulässig (Schlüssel B2 der Anl. 5 Gem. Runds 009080- "chreiben)". 009090 05 FILLER PIC X(72) VALUE 009100 "DBME152 TAETIGKEITS-SC (Stellen 6-9) ungl. Grundstellung (Le 009110- "erzeichen)". 009120 05 FILLER PIC X(72) VALUE 009130 "DBME160 KENNZ-RECHTSKREIS unzulässiges Zeichen". 009140 05 FILLER PIC X(72) VALUE 009150 "DBME161 KENNZ-RECHTSKREIS = 9 nicht vom AG KENNZUE ungleich 009160- "A". 009170 05 FILLER PIC X(72) VALUE 009180 "DBME162 KENNZ-RECHTSKREIS gleich W, BBNRVU im DSME 010-099 o 009190- "der 987". 009191 05 FILLER PIC X(72) VALUE 009192 "DBME163 KENNZ-RECHTSKREIS = Grundstellung, nicht PERSGR = 30 009193- "4". 009200 05 FILLER PIC X(72) VALUE 009210 "DBME164 KENNZ-RECHTSKREIS = O; BBNRVU im DSME ungleich 010-0 009220- "99 und 987". 009221 05 FILLER PIC X(72) VALUE 009222 "DBME165 KENNZ-RECHTSKREIS ungleich Grundstellung, PERSGR = 3 009223- "04". 009224 05 FILLER PIC X(72) VALUE 009225 "DBME167 KENNZRK gleich Ost für Wehr-/Zivildienstzeiten vor 0 009226- "3.10.1990". 009230 05 FILLER PIC X(72) VALUE 009240 "DBME170 KENNZ-MEHRFACH unzulässiges Zeichen". 009250 05 FILLER PIC X(72) VALUE 009260 "DBME172 KENNZ-MEHRFACH ungleich N von Wehr- oder Zivildienst 009270- "verwaltung". 009310 05 FILLER PIC X(72) VALUE 009320 "DBMEH10 ZRBG liegt mehr als 5 Jahre zurück, Sachbearbeitung 009330- "prüfe". 009340 05 FILLER PIC X(72) VALUE 009350 "DBME910 Länge DBME falsch, Abbruch". 009360 05 FILLER PIC X(72) VALUE 009370 "DBNA001 KENNUNG ungleich DBNA". 009380 05 FILLER PIC X(72) VALUE 009390 "DBNA005 FMNA fehlt". 009391 05 FILLER PIC X(72) VALUE 009392 "DBNA007 FMNA besteht nicht aus mindestens 2 Buchstaben". 009400 05 FILLER PIC X(72) VALUE 009410 "DBNA010 FMNA enthält mehrf. aufeinanderfolgende Sonder- und 009420- "Leerzeichen". 009421 05 FILLER PIC X(72) VALUE 009422 "DBNA011 FMNA beginnt mit mindestens 3 gleichen Buchstaben". 009430 05 FILLER PIC X(72) VALUE 009440 "DBNA012 FMNA enthält vor oder nach Bindestrichen Leerzeichen 009450- "". 009460 05 FILLER PIC X(72) VALUE 009470 "DBNA014 FMNA unzulässiges Zeichen". 009480 05 FILLER PIC X(72) VALUE 009490 "DBNA015 FMNA mehr als 2 Ziff. / 2 Ziff. nicht unmittelbar hi 009500- "ntereinander". 009510 05 FILLER PIC X(72) VALUE 009520 "DBNA016 FMNA enthält einen unzulässigen Punkt". 009540 05 FILLER PIC X(72) VALUE 009550 "DBNA018 FMNA enthält vor einer Ziffer kein Leerzeichen". 009560 05 FILLER PIC X(72) VALUE 009570 "DBNA020 FMNA beginnt nicht mit einem Buchstaben ungleich ß". 009580 05 FILLER PIC X(72) VALUE 009590 "DBNA022 FMNA endet nicht mit Buchstaben, Ziffer oder Punkt". 009600 05 FILLER PIC X(72) VALUE 009610 "DBNA028 VONA fehlt". 009611 05 FILLER PIC X(72) VALUE 009612 "DBNA029 VONA besteht nicht aus mindestens 2 Buchstaben". 009620 05 FILLER PIC X(72) VALUE 009630 "DBNA030 VONA enthält mehrf. aufeinanderfolgende Sonder- und 009640- "Leerzeichen". 009641 05 FILLER PIC X(72) VALUE 009642 "DBNA031 VONA beginnt mit mindestens 3 gleichen Buchstaben". 009650 05 FILLER PIC X(72) VALUE 009660 "DBNA032 VONA enthält vor oder nach Bindestrichen Leerzeichen 009670- "". 009680 05 FILLER PIC X(72) VALUE 009690 "DBNA034 VONA unzulässiges Zeichen". 009691 05 FILLER PIC X(72) VALUE 009692 "DBNA035 VONA enthält fiktiven Vornamen". 009700 05 FILLER PIC X(72) VALUE 009710 "DBNA036 VONA enthält auf erster/letzter Stelle keinen Buchst 009720- "aben bzw. ß". 009721 05 FILLER PIC X(72) VALUE 009722 "DBNA038 VONA und FMNA enthalten unzulässige Angaben". 009730 05 FILLER PIC X(72) VALUE 009740 "DBNA040 VOSA enthält mehrf. aufeinanderfolgende Sonder- und 009750- "Leerzeichen". 009760 05 FILLER PIC X(72) VALUE 009770 "DBNA042 VOSA enthält vor oder nach Bindestrichen Leerzeichen 009780- "". 009790 05 FILLER PIC X(72) VALUE 009800 "DBNA044 VOSA unzulässiges Zeichen". 009810 05 FILLER PIC X(72) VALUE 009820 "DBNA046 VOSA beginnt nicht mit einem Buchstaben". 009830 05 FILLER PIC X(72) VALUE 009840 "DBNA048 VOSA enthält Punkt; davor keinen Buchstaben". 009850 05 FILLER PIC X(72) VALUE 009860 "DBNA050 VOSA nicht in Tabelle (Anlage 6 Gemeinsames Rundschr 009870- "eiben)". 009880 05 FILLER PIC X(72) VALUE 009890 "DBNA060 NAZU enthält mehrf. aufeinanderfolgende Sonder- und 009900- "Leerzeichen". 009910 05 FILLER PIC X(72) VALUE 009920 "DBNA062 NAZU enthält vor oder nach Bindestrichen Leerzeichen 009930- "". 009940 05 FILLER PIC X(72) VALUE 009950 "DBNA064 NAZU unzulässiges Zeichen". 009960 05 FILLER PIC X(72) VALUE 009970 "DBNA066 NAZU beginnt nicht mit einem Buchstaben". 009980 05 FILLER PIC X(72) VALUE 009990 "DBNA068 NAZU enthält Punkt; davor keinen Buchstaben". 010000 05 FILLER PIC X(72) VALUE 010010 "DBNA070 NAZU nicht in Tabelle (Anlage 7 Gemeinsames Rundschr 010020- "eiben)". 010030 05 FILLER PIC X(72) VALUE 010040 "DBNA080 TITEL enthält mehrf. aufeinanderfolgende Sonder- und 010050- " Leerzeichen". 010051 05 FILLER PIC X(72) VALUE 010052 "DBNA081 TITEL beginnt mit mindestens 3 gleichen Buchstaben". 010060 05 FILLER PIC X(72) VALUE 010070 "DBNA082 TITEL enthält vor oder nach Bindestrichen Leerzeiche 010080- "n". 010090 05 FILLER PIC X(72) VALUE 010100 "DBNA084 TITEL unzulässiges Zeichen". 010110 05 FILLER PIC X(72) VALUE 010120 "DBNA086 TITEL beginnt nicht mit einem Buchstaben". 010130 05 FILLER PIC X(72) VALUE 010140 "DBNA088 TITEL enthält Punkt; davor keinen Buchstaben". 010150 05 FILLER PIC X(72) VALUE 010160 "DBNA089 TITEL endet nicht mit Buchstabe, Punkt oder rechter 010170- "Klammer". 010180 05 FILLER PIC X(72) VALUE 010190 "DBNA090 KENNZAB unzulässiges Zeichen". 010191 05 FILLER PIC X(72) VALUE 010192 "DBNA092 KENNZAB unzulässig". 010200 05 FILLER PIC X(72) VALUE 010210 "DBNA910 Länge DBNA falsch, Abbruch". 010220 05 FILLER PIC X(72) VALUE 010230 "DBGB001 KENNUNG ungleich DBGB". 010231 05 FILLER PIC X(72) VALUE 010232 "DBGB007 GBNA besteht nicht aus mindestens 2 Buchstaben". 010240 05 FILLER PIC X(72) VALUE 010250 "DBGB010 GBNA enthält mehrf. aufeinanderfolgende Sonder- und 010260- "Leerzeichen". 010261 05 FILLER PIC X(72) VALUE 010262 "DBGB011 GBNA beginnt mit mindestens 3 gleichen Buchstaben". 010270 05 FILLER PIC X(72) VALUE 010280 "DBGB012 GBNA enthält vor oder nach Bindestrichen Leerzeichen 010290- "". 010300 05 FILLER PIC X(72) VALUE 010310 "DBGB014 GBNA unzulässiges Zeichen". 010320 05 FILLER PIC X(72) VALUE 010330 "DBGB015 GBNA mehr als 2 Ziff. / 2 Ziff. nicht unmittelbar hi 010340- "ntereinander". 010350 05 FILLER PIC X(72) VALUE 010360 "DBGB016 GBNA enthält unzulässigen Punkt". 010380 05 FILLER PIC X(72) VALUE 010390 "DBGB018 GBNA enthält vor einer Ziffer kein Leerzeichen". 010400 05 FILLER PIC X(72) VALUE 010410 "DBGB020 GBNA beginnt nicht mit einem Buchstaben ungleich ß". 010420 05 FILLER PIC X(72) VALUE 010430 "DBGB022 GBNA endet nicht mit Buchstaben, Ziffer oder Punkt". 010440 05 FILLER PIC X(72) VALUE 010450 "DBGB040 GBVOSA enth. mehrf. aufeinanderfolgende Sonder- und 010460- "Leerzeichen". 010470 05 FILLER PIC X(72) VALUE 010480 "DBGB042 GBVOSA enthält vor oder nach Bindestrichen Leerzeich 010490- "en". 010500 05 FILLER PIC X(72) VALUE 010510 "DBGB044 GBVOSA unzulässiges Zeichen". 010520 05 FILLER PIC X(72) VALUE 010530 "DBGB046 GBVOSA beginnt nicht mit einem Buchstaben". 010540 05 FILLER PIC X(72) VALUE 010550 "DBGB048 GBVOSA enthält Punkt; davor keinen Buchstaben". 010560 05 FILLER PIC X(72) VALUE 010570 "DBGB050 GBVOSA nicht in Tabelle (Anlage 6 Gemeinsames Rundsc 010580- "hreiben)". 010590 05 FILLER PIC X(72) VALUE 010600 "DBGB060 GBNAZU enth. mehrf. aufeinanderfolgende Sonder- und 010610- "Leerzeichen". 010620 05 FILLER PIC X(72) VALUE 010630 "DBGB062 GBNAZU enthält vor oder nach Bindestrichen Leerzeich 010640- "en". 010650 05 FILLER PIC X(72) VALUE 010660 "DBGB064 GBNAZU unzulässiges Zeichen". 010670 05 FILLER PIC X(72) VALUE 010680 "DBGB066 GBNAZU beginnt nicht mit einem Buchstaben". 010690 05 FILLER PIC X(72) VALUE 010700 "DBGB068 GBNAZU enthält Punkt; davor keinen Buchstaben". 010710 05 FILLER PIC X(72) VALUE 010720 "DBGB070 GBNAZU nicht in Tabelle (Anlage 7 Gemeinsames Rundsc 010730- "hreiben)". 010740 05 FILLER PIC X(72) VALUE 010750 "DBGB100 GBDT nicht numerisch". 010760 05 FILLER PIC X(72) VALUE 010770 "DBGB102 GBDT (Monat) für Ausländer = 00, GBDT (Tag) ungl. 00 010780- "". 010790 05 FILLER PIC X(72) VALUE 010800 "DBGB104 GBDT logisch falsch". 010810 05 FILLER PIC X(72) VALUE 010820 "DBGB106 GBDT kleiner Verarbeitungsdatum minus 150 Jahre". 010830 05 FILLER PIC X(72) VALUE 010831 "DBGB107 GBDT größer Verarbeitungsdatum". 010840 05 FILLER PIC X(72) VALUE 010850 "DBGB108 GBDT kleiner Verarbeitungsdatum minus 90 Kalenderjah 010860- "re". 010870 05 FILLER PIC X(72) VALUE 010880 "DBGB110 GBDT ungleich Angaben in der Interimsversicherungsnu 010890- "mmer". 010900 05 FILLER PIC X(72) VALUE 010910 "DBGB120 GESCHLECHT unzulässiges Zeichen". 010920 05 FILLER PIC X(72) VALUE 010930 "DBGB122 GESCHLECHT gleich männlich, Seriennummer kleiner 50 010940- "". 010950 05 FILLER PIC X(72) VALUE 010960 "DBGB124 GESCHLECHT gleich weiblich, Seriennummer größer 49". 010970 05 FILLER PIC X(72) VALUE 010980 "DBGB128 GB-ORT fehlt". 010990 05 FILLER PIC X(72) VALUE 011000 "DBGB130 GB-ORT enth. mehrf. aufeinanderfolgende Sonder- und 011010- "Leerzeichen". 011011 05 FILLER PIC X(72) VALUE 011012 "DBGB131 GB-ORT beginnt mit mindestens 3 gleichen Buchstaben 011013- "". 011020 05 FILLER PIC X(72) VALUE 011030 "DBGB134 GB-ORT unzulässiges Zeichen". 011040 05 FILLER PIC X(72) VALUE 011050 "DBGB136 GB-ORT beginnt nicht mit einem Buchstaben". 011060 05 FILLER PIC X(72) VALUE 011070 "DBGB138 GB-ORT besteht nicht mindestens aus 2 Zeichen". 011080 05 FILLER PIC X(72) VALUE 011090 "DBGB140 GB-ORT enthält fiktiven Geburtsort". 011100 05 FILLER PIC X(72) VALUE 011110 "DBGB142 GB-ORT endet nicht mit Buchstabe, Punkt oder rechter 011120- " Klammer". 011130 05 FILLER PIC X(72) VALUE 011140 "DBGB910 Länge DBGB falsch, Abbruch". 011150 05 FILLER PIC X(72) VALUE 011160 "DBAN001 KENNUNG ungleich DBAN". 011170 05 FILLER PIC X(72) VALUE 011180 "DBAN012 LAENDER-KENNZ unzul. Angaben (ungl. Anlage 8 Gem. Ru 011190- "ndschreiben)". 011191 05 FILLER PIC X(72) VALUE 011192 "DBAN013 LAENDER-KENNZ = YU oder SCG unzulässig". 011193 05 FILLER PIC X(72) VALUE 011194 "DBAN014 LAENDER-KENNZ = OFW unzulässig". 011195 05 FILLER PIC X(72) VALUE 011196 "DBAN018 PLZ = Leerzeichen unzulässig". 011200 05 FILLER PIC X(72) VALUE 011210 "DBAN020 PLZ (Inland) nur 01000 bis 99999 zulässig". 011220 05 FILLER PIC X(72) VALUE 011230 "DBAN022 PLZ (Ausland) unzulässige Zeichen". 011240 05 FILLER PIC X(72) VALUE 011250 "DBAN024 PLZ enthält mehrfach aufeinanderfolgende Bindestrich 011260- "e". 011261 05 FILLER PIC X(72) VALUE 011262 "DBAN026 PLZ enthält unzulässigen Aufbau". 011270 05 FILLER PIC X(72) VALUE 011280 "DBAN118 ORT = Leerzeichen unzulässig". 011290 05 FILLER PIC X(72) VALUE 011300 "DBAN120 ORT enthält mehrf. aufeinanderfolgende Sonder- und L 011310- "eerzeichen". 011311 05 FILLER PIC X(72) VALUE 011312 "DBAN121 ORT beginnt mit mindestens 3 gleichen Buchstaben". 011320 05 FILLER PIC X(72) VALUE 011330 "DBAN124 WOHNORT erste Stelle kein Buchstabe". 011340 05 FILLER PIC X(72) VALUE 011350 "DBAN126 WOHNORT (Inland) unzulässige Zeichen". 011360 05 FILLER PIC X(72) VALUE 011370 "DBAN128 WOHNORT (Inland) enthält Punkt, davor keinen Buchsta 011380- "ben". 011390 05 FILLER PIC X(72) VALUE 011400 "DBAN130 WOHNORT besteht nicht aus mindestens 2 Buchstaben". 011410 05 FILLER PIC X(72) VALUE 011420 "DBAN132 WOHNORT (Inland) letzt.Zeichen ungl.Buchst./rechte K 011430- "lammer/Punkt". 011440 05 FILLER PIC X(72) VALUE 011450 "DBAN140 WOHNORT (Ausland) unzulässige Zeichen". 011460 05 FILLER PIC X(72) VALUE 011470 "DBAN144 ORT (Ausland) letztes Zeichen unzulässig". 011480 05 FILLER PIC X(72) VALUE 011490 "DBAN150 STR enthält mehrf. aufeinanderfolgende Sonder- und L 011500- "eerzeichen". 011501 05 FILLER PIC X(72) VALUE 011502 "DBAN151 STRASSE beginnt mit mindestens 3 gleichen Buchstaben 011503- " ungl. III.". 011510 05 FILLER PIC X(72) VALUE 011520 "DBAN154 STRASSE (Ausland) nicht vorhanden". 011530 05 FILLER PIC X(72) VALUE 011540 "DBAN156 STRASSE unzulässiges Zeichen". 011550 05 FILLER PIC X(72) VALUE 011560 "DBAN158 STRASSE nicht mindestens 2 Zeichen oder ein Großbuch 011561- "stabe". 011570 05 FILLER PIC X(72) VALUE 011580 "DBAN160 STRASSE beginnt nicht mit einem zulässigen Zeichen". 011600 05 FILLER PIC X(72) VALUE 011610 "DBAN162 STRASSE beginnt mit einer Ziffer, Folgezeichen unzul 011620- "ässig". 011630 05 FILLER PIC X(72) VALUE 011640 "DBAN164 STRASSE enth. vor 1. Ziffer kein Buchst., Leerz. ode 011650- "r Punkt". 011660 05 FILLER PIC X(72) VALUE 011670 "DBAN166 STRASSE enthält Punkt, davor keinen Buchstaben oder 011680- "Ziffer". 011690 05 FILLER PIC X(72) VALUE 011700 "DBAN168 STRASSE endet mit unzulässigem Zeichen". 011710 05 FILLER PIC X(72) VALUE 011720 "DBAN170 NR enthält mehrfach aufeinanderfolgende Sonder- und 011730- "Leerzeichen". 011740 05 FILLER PIC X(72) VALUE 011750 "DBAN174 NR unzulässiges Zeichen". 011760 05 FILLER PIC X(72) VALUE 011770 "DBAN176 NR beginnt bzw. endet nicht mit Buchstaben oder Ziff 011780- "er". 011790 05 FILLER PIC X(72) VALUE 011800 "DBAN180 ADRZU enthält mehrf. aufeinanderfolgende Sonder- und 011810- " Leerzeichen". 011811 05 FILLER PIC X(72) VALUE 011812 "DBAN181 ADRZU beginnt mit mindestens 3 gleichen Buchstaben u 011813- "ngl. III.". 011820 05 FILLER PIC X(72) VALUE 011830 "DBAN184 ADRZU unzulässiges Zeichen". 011831 05 FILLER PIC X(72) VALUE 011832 "DBAN185 ADRZU beginnt nicht mit Buchstabe oder Ziffer". 011860 05 FILLER PIC X(72) VALUE 011870 "DBAN188 ADRZU enthält Punkte, davor keinen Buchstaben oder Z 011880- "iffer". 011890 05 FILLER PIC X(72) VALUE 011900 "DBAN910 Länge DBAN falsch, Abbruch". 011930 05 FILLER PIC X(72) VALUE 011940 "DBEU001 KENNUNG ungleich DBEU". 011950 05 FILLER PIC X(72) VALUE 011960 "DBEU010 GB-LAND nicht numerisch". 011970 05 FILLER PIC X(72) VALUE 011980 "DBEU012 GB-LAND unzulässige Schlüsselzahl". 011990 05 FILLER PIC X(72) VALUE 012000 "DBEU910 Laenge DBEU falsch, Abbruch". 012200 05 FILLER PIC X(72) VALUE 012210 "DBKS001 KENNUNG ungleich DBKS". 012220 05 FILLER PIC X(72) VALUE 012230 "DBKS010 KENNZ-KNV-SEE unzulässiges Zeichen". 012231 05 FILLER PIC X(72) VALUE 012232 "DBKS200 VKNR ungleich 36, 38, 96 und 98 unzulässig". 012233 05 FILLER PIC X(72) VALUE 012234 "DBKS210 VKNR 36 und 38 i.V.m. PERSGR oder Zeitraum unzulässi 012235- "g". 012236 05 FILLER PIC X(72) VALUE 012237 "DBKS220 VKNR 96 und 98 i.V.m. PERSGR unzulässig". 012240 05 FILLER PIC X(72) VALUE 012250 "DBKS910 Länge DBKS falsch, Abbruch". 012260 05 FILLER PIC X(72) VALUE 012270 "DBSV001 KENNUNG ungleich DBSV". 012280 05 FILLER PIC X(72) VALUE 012290 "DBSV010 KENNZ-SVA unzulässiges Zeichen". 012300 05 FILLER PIC X(72) VALUE 012310 "DBSV910 Länge DBSV falsch, Abbruch". 012320 05 FILLER PIC X(72) VALUE 012330 "DBVR001 KENNUNG ungleich DBVR". 012340 05 FILLER PIC X(72) VALUE 012350 "DBVR010 ABGABEGRUND nicht numerisch". 012360 05 FILLER PIC X(72) VALUE 012370 "DBVR012 ABGABEGRUND unzulässige Zeichen". 012410 05 FILLER PIC X(72) VALUE 012420 "DBVR014 ABGABEGRUND ungleich 01, 04, 80 oder 99 bei Meldunge 012430- "n zur RV". 012440 05 FILLER PIC X(72) VALUE 012450 "DBVR016 ABGABEGRUND ungleich 01 oder 99 bei Meldungen zur RV 012460- "". 012470 05 FILLER PIC X(72) VALUE 012480 "DBVR020 ABGABEGRUND gleich 01,02,04,05,99 aber keine ITVSNR 012490- "verwendet". 012491 05 FILLER PIC X(72) VALUE 012492 "DBVR022 GB-ORT fehlt". 012493 05 FILLER PIC X(72) VALUE 012494 "DBVR025 Vergaben von VSNR an Personen unter 14 Jahren sind u 012495- "nzulässig". 012500 05 FILLER PIC X(72) VALUE 012510 "DBVR030 BEREICHS-NR-VA nicht numerisch". 012520 05 FILLER PIC X(72) VALUE 012530 "DBVR032 BEREICHS-NR-VA unzulässige Zeichen". 012531 05 FILLER PIC X(72) VALUE 012532 "DBVR034 BEREICHS-NR-VA gleich 40; Meldung nicht von der ZfA 012533- "". 012540 05 FILLER PIC X(72) VALUE 012550 "DBVR080 VSNR-VERGABE ungl. Grundstellung bei GDMQ = 01, 04, 012560- "80 oder 99". 012570 05 FILLER PIC X(72) VALUE 012580 "DBVR082 GDMQ 02 oder 03, VSNR-VERGABE enthält unzulässige Ze 012581- "ichen". 012582 05 FILLER PIC X(72) VALUE 012583 "DBVR083 GDMQ = 05, VSNR-VERGABE enth. keine Grundstellung/un 012584- "zul. Zeichen". 012590 05 FILLER PIC X(72) VALUE 012600 "DBVR084 VSNR-VERGABE enthält unzulässige Bereichsnummer". 012610 05 FILLER PIC X(72) VALUE 012620 "DBVR086 VSNR-VERGABE (Geburtsdatum) unzulässig". 012630 05 FILLER PIC X(72) VALUE 012640 "DBVR088 VSNR-VERGABE (Prüfziffer) falsch". 012650 05 FILLER PIC X(72) VALUE 012660 "DBVR910 Länge DBVR falsch, Abbruch". 012670 05 FILLER PIC X(72) VALUE 012680 "DBRG001 KENNUNG ungleich DBRG". 012681 05 FILLER PIC X(72) VALUE 012682 "DBRG300 ZAEHLER nicht numerisch". 012683 05 FILLER PIC X(72) VALUE 012684 "DBRG310 ZAEHLER ungleich 01 - 46". 012690 05 FILLER PIC X(72) VALUE 012700 "DSAE004 KENNUNG für diesen Absender (VFMM im VOSZ) unzulässi 012710- "g". 012740 05 FILLER PIC X(72) VALUE 012750 "DSAE020 BBNRAB fehlerhaft (Ziffer 1.3.2.2 Gem. Rundschreiben 012760- ")". 012770 05 FILLER PIC X(72) VALUE 012780 "DSAE022 BBNRAB bei sonst. Stellen unzulässig i. V. m. VFMM i 012790- "m VOSZ". 012800 05 FILLER PIC X(72) VALUE 012810 "DSAE030 BBNREP fehlerhaft (Ziffer 1.3.2.2 Gem. Rundschreiben 012820- ")". 012830 05 FILLER PIC X(72) VALUE 012840 "DSAE032 BBNREP unzul. bei Meldungen an RV oder RV an BA oder 012841- " Kommunen". 012842 05 FILLER PIC X(72) VALUE 012843 "DSAE040 VERSIONS-NR nicht numerisch". 012850 05 FILLER PIC X(72) VALUE 012860 "DSAE042 VERSIONS-NR nicht zugelassen". 012870 05 FILLER PIC X(72) VALUE 012880 "DSAE050 DATUM-ERSTELLUNG nicht numerisch". 012890 05 FILLER PIC X(72) VALUE 012900 "DSAE052 DATUM-ERSTELLUNG logisch falsch". 012910 05 FILLER PIC X(72) VALUE 012920 "DSAE054 DATUM-ERSTELLUNG größer Verarbeitungsdatum". 012930 05 FILLER PIC X(72) VALUE 012940 "DSAE056 DATUM-ERSTELLUNG (Uhrzeit) logisch falsch". 012950 05 FILLER PIC X(72) VALUE 012960 "DSAE058 DATUM-ERSTELLUNG (Uhrzeit) größer/gleich Verarbeitun 012970- "gszeitpunkt". 012980 05 FILLER PIC X(72) VALUE 012990 "DSAE060 FEHLER-KZ nicht numerisch". 013000 05 FILLER PIC X(72) VALUE 013010 "DSAE062 FEHLER-KZ ungleich 0 - 2". 013050 05 FILLER PIC X(72) VALUE 013060 "DSAE070 FEHLER-ANZAHL nicht numerisch". 013070 05 FILLER PIC X(72) VALUE 013080 "DSAE072 FEHLER-ANZAHL ungleich 0, FEHLER-KZ gleich 0". 013090 05 FILLER PIC X(72) VALUE 013100 "DSAE082 VSNR enthält unzulässige Zeichen". 013110 05 FILLER PIC X(72) VALUE 013120 "DSAE084 VSNR enthält unzulässige Bereichsnummer". 013130 05 FILLER PIC X(72) VALUE 013140 "DSAE086 VSNR (Geburtsdatum) unzulässig". 013150 05 FILLER PIC X(72) VALUE 013160 "DSAE088 VSNR (Prüfziffer) falsch". 013161 05 FILLER PIC X(72) VALUE 013162 "DSAE089 Die Verwendung der angegebenen VSNR ist unzulässig". 013170 05 FILLER PIC X(72) VALUE 013180 "DSAE120 VSTR unzulässige Zeichen". 013190 05 FILLER PIC X(72) VALUE 013200 "DSAE124 VSTR ungleich 0A, 0B, 0C oder 0G". 013210 05 FILLER PIC X(72) VALUE 013220 "DSAE130 VSTR ungleich 0A, 0C, 0G, AB, AC oder AG von DRV-Bun 013221- "d". 013230 05 FILLER PIC X(72) VALUE 013240 "DSAE132 VSTR ungleich 0B, BA, BB, BC oder BG von Datenstelle 013250- "". 013251 05 FILLER PIC X(72) VALUE 013252 "DSAE141 Die Verwendung der angegebenen BBNRVU ist unzulässig 013253- "". 013260 05 FILLER PIC X(72) VALUE 013270 "DSAE142 BBNR-VU fehlerhaft (Ziffer 1.3.2.2 Gem. Rundschreibe 013280- "n)". 013310 05 FILLER PIC X(72) VALUE 013320 "DSAE158 BBNR-VU für Meldungen von Ü-Geld nicht 98503184 oder 013330- " 98702232". 013340 05 FILLER PIC X(72) VALUE 013350 "DSAE160 AZ-VU von BA, Kundennummer enthält unzulässige Zeich 013360- "en". 013361 05 FILLER PIC X(72) VALUE 013362 "DSAE360 KENNZ-UEBERGANG nicht Grundstellung (Leerzeichen) od 013363- "er 1 - 9". 013364 05 FILLER PIC X(72) VALUE 013365 "DSAE362 KENNZ-UEBERGANG = 1-7 oder 9, Meldung nicht von der 013366- "BA an die RV". 013367 05 FILLER PIC X(72) VALUE 013368 "DSAE365 KENNZ-UEBERGANG ungleich 8, Meldung nicht von einer 013369- "Kommune". 013370 05 FILLER PIC X(72) VALUE 013371 "DSAE390 Reserve (Stellen 113-170) ist nicht Grundstellung". 013372 05 FILLER PIC X(72) VALUE 013380 "DSAE400 MM-ANRECHNUNGSZEITEN ungleich N oder J". 013390 05 FILLER PIC X(72) VALUE 013400 "DSAE402 MM-ANRECHNUNGSZEITEN ist J, MMEZ ungleich N". 013430 05 FILLER PIC X(72) VALUE 013440 "DSAE406 MM-ANRECHNUNGSZEITEN = J". 013450 05 FILLER PIC X(72) VALUE 013460 "DSAE410 MM-ENTGELTERSATZLEISTUNGSZEITEN ungleich N oder J". 013470 05 FILLER PIC X(72) VALUE 013480 "DSAE412 MM-ENTGELTERSATZLEISTUNGSZEITEN = N, MMAZ ungleich J 013490- "". 013520 05 FILLER PIC X(72) VALUE 013530 "DSAE416 MM-ENTGELTERSATZLEISTUNGSZEITEN = N". 013540 05 FILLER PIC X(72) VALUE 013550 "DSAE420 Reserve (Stellen 173-180 im DSAE) ist nicht Grundste 013560- "llung". 013561 05 FILLER PIC X(72) VALUE 013562 "DSAE430 Reserve (Stellen 182-190 im DSAE) ist nicht Grundste 013563- "llung". 013564 05 FILLER PIC X(72) VALUE 013565 "DSAE910 Gesamtlänge DSAE einschließl. der angeh. Datenbauste 013566- "ine falsch". 013570 05 FILLER PIC X(72) VALUE 013580 "DSAE920 Datensatz enthält mehr als 8 Fehler, Prüfung abgebro 013590- "chen". 013591 05 FILLER PIC X(72) VALUE 013592 "DSAE922 Datensatz enthält mehr als 9 Hinweise, Prüfung abgeb 013593- "rochen". 013600 05 FILLER PIC X(72) VALUE 013610 "DSAE930 DBAZ fehlt oder an falscher Stelle". 013620 05 FILLER PIC X(72) VALUE 013630 "DSAE931 DBEZ fehlt oder an falscher Stelle". 013800 05 FILLER PIC X(72) VALUE 013810 "DBAZ001 KENNUNG ungleich DBAZ". 013820 05 FILLER PIC X(72) VALUE 013830 "DBAZ010 KENNZ-STORNO unzulässiges Zeichen". 013840 05 FILLER PIC X(72) VALUE 013850 "DBAZ020 LEAT nicht numerisch". 013860 05 FILLER PIC X(72) VALUE 013870 "DBAZ022 LEAT unzulässiges Zeichen". 013880 05 FILLER PIC X(72) VALUE 013890 "DBAZ024 LEAT gleich 52 nur für weibliche Personen zulässig". 013900 05 FILLER PIC X(72) VALUE 013910 "DBAZ026 LEAT ungleich 40 - 44 bei Meldungen der BA". 013920 05 FILLER PIC X(72) VALUE 013930 "DBAZ028 LEAT ungleich 51, 52 und 54 bei Meldungen der KK". 013960 05 FILLER PIC X(72) VALUE 013970 "DBAZ030 ZEITRAUM-BEGINN nicht numerisch". 013980 05 FILLER PIC X(72) VALUE 013990 "DBAZ032 ZEITRAUM-BEGINN logisch falsch". 013991 05 FILLER PIC X(72) VALUE 013992 "DBAZ033 ZEITRAUM-BEGINN bei LEAT 42 vor dem 01.05.2003". 014000 05 FILLER PIC X(72) VALUE 014010 "DBAZ034 ZRBG vor Vollendung des 17. Lj. bei LEAT 44 oder 54 014020- "". 014021 05 FILLER PIC X(72) VALUE 014022 "DBAZ035 ZRBG vor dem 01.10.2000 bei LEAT 43". 014023 05 FILLER PIC X(72) VALUE 014024 "DBAZ036 ZRBG vor Vollendung des 58. Lj. bei LEAT 42". 014025 05 FILLER PIC X(72) VALUE 014026 "DBAZ037 ZRBG vor dem 14. Lebensjahr bei LEAT 43". 014027 05 FILLER PIC X(72) VALUE 014028 "DBAZ038 VSTR für Zeiten ab 01.01.2005 unzulässig". 014030 05 FILLER PIC X(72) VALUE 014040 "DBAZ040 ZEITRAUM-ENDE nicht numerisch". 014050 05 FILLER PIC X(72) VALUE 014060 "DBAZ042 ZEITRAUM-ENDE logisch falsch". 014070 05 FILLER PIC X(72) VALUE 014080 "DBAZ044 ZEITRAUM-ENDE kleiner ZEITRAUM-BEGINN". 014090 05 FILLER PIC X(72) VALUE 014100 "DBAZ046 ZREN (Jahr) ungl. ZRBG (Jahr)". 014110 05 FILLER PIC X(72) VALUE 014120 "DBAZ048 ZEITRAUM-ENDE größer Monat Verarbeitung plus 3 Kalen 014130- "dermonate". 014140 05 FILLER PIC X(72) VALUE 014150 "DBAZ910 Länge DBAZ falsch, Abbruch". 014190 05 FILLER PIC X(72) VALUE 014200 "DBEZ001 KENNUNG ungleich DBEZ". 014210 05 FILLER PIC X(72) VALUE 014220 "DBEZ010 KENNZ-STORNO unzulässiges Zeichen". 014230 05 FILLER PIC X(72) VALUE 014240 "DBEZ020 LEAT unzulässiges Zeichen". 014250 05 FILLER PIC X(72) VALUE 014260 "DBEZ022 LEAT ungleich 00, 01, 04 und 07 bei Meldungen der Kr 014270- "ankenkasse". 014280 05 FILLER PIC X(72) VALUE 014290 "DBEZ024 LEAT ungleich 21-23,25,27-33,40-44 und 50 bei Meldun 014300- "gen der BA". 014301 05 FILLER PIC X(72) VALUE 014302 "DBEZ025 LEAT ungleich 43/44 bei Meldungen der Kommunen". 014340 05 FILLER PIC X(72) VALUE 014350 "DBEZ028 LEAT ungl. 26 bei Meld. der Sonderversorgungsträger 014360- "an DRV-Bund". 014370 05 FILLER PIC X(72) VALUE 014380 "DBEZ029 LEAT ungl. 03, 06 und 09 bei Meld. von Übergangsgeld 014390- " an DRV-Bund". 014400 05 FILLER PIC X(72) VALUE 014410 "DBEZ030 ABGABEGRUND nicht numerisch". 014420 05 FILLER PIC X(72) VALUE 014430 "DBEZ032 ABGABEGRUND unzulässiges Zeichen". 014440 05 FILLER PIC X(72) VALUE 014450 "DBEZ040 ZEITRAUM-BEGINN nicht numerisch". 014460 05 FILLER PIC X(72) VALUE 014470 "DBEZ042 ZEITRAUM-BEGINN logisch falsch". 014471 05 FILLER PIC X(72) VALUE 014472 "DBEZ043 VSTR für Zeiten ab 01.01.2005 unzulässig". 014480 05 FILLER PIC X(72) VALUE 014490 "DBEZ044 ZEITRAUM-BEGINN vor dem 01.05.1996 bei LEAT = 27 ode 014500- "r 28". 014501 05 FILLER PIC X(72) VALUE 014502 "DBEZ045 ZEITRAUM-BEGINN vor Vollendung des 15. Lebensj. bei 014503- "LEAT 43/44". 014510 05 FILLER PIC X(72) VALUE 014520 "DBEZ046 ZEITRAUM-BEGINN vor dem 01.01.1998 bei LEAT = 30 bis 014521- " 33 oder 42". 014522 05 FILLER PIC X(72) VALUE 014523 "DBEZ047 ZEITRAUM-BEGINN vor dem 01.01.2005 bei LEAT = 43 ode 014524- "r 44". 014530 05 FILLER PIC X(72) VALUE 014540 "DBEZ048 ZEITRAUM-BEGINN vor dem 01.01.2003 bei LEAT 50". 014541 05 FILLER PIC X(72) VALUE 014542 "DBEZ049 ZEITRAUM-BEGINN vor Vollendung des 50. Lj bei LEAT = 014543- " 50". 014544 05 FILLER PIC X(72) VALUE 014545 "DBEZ050 ZEITRAUM-ENDE nicht numerisch". 014550 05 FILLER PIC X(72) VALUE 014560 "DBEZ052 ZEITRAUM-ENDE logisch falsch". 014570 05 FILLER PIC X(72) VALUE 014580 "DBEZ054 ZEITRAUM-ENDE kleiner ZEITRAUM-BEGINN". 014590 05 FILLER PIC X(72) VALUE 014600 "DBEZ056 ZEITRAUM-ENDE (Jahr) ungleich ZEITRAUM-BEGINN (Jahr) 014610- "". 014620 05 FILLER PIC X(72) VALUE 014630 "DBEZ058 ZEITRAUM-ENDE größer Monat der Verarbeitung plus 1 K 014640- "alendermonat". 014641 05 FILLER PIC X(72) VALUE 014642 "DBEZ060 ZEITRAUM-ENDE größer 30.03.2003 bei Anschlussunterha 014643- "ltsgeld". 014644 05 FILLER PIC X(72) VALUE 014645 "DBEZ061 ZEITRAUM-ENDE größer 31.12.2004 bei LEAT = 23 oder 4 014646- "1". 014647 05 FILLER PIC X(72) VALUE 014648 "DBEZ062 ZEITRAUM-ENDE nach dem 31.08.2008 bei LEAT = 50". 014649 05 FILLER PIC X(72) VALUE 014650 "DBEZ064 ZEITRAUM-BEGINN nach Vollendung des 65. Lebensj. bei 014651- " LEAT 43/44". 014652 05 FILLER PIC X(72) VALUE 014660 "DBEZ082 WAEHRUNGS-KENNZ unzulässig". 014670 05 FILLER PIC X(72) VALUE 014680 "DBEZ084 WAEHRUNGS-KENNZ gleich E für Zeiten vor dem 01.01.20 014690- "02". 014700 05 FILLER PIC X(72) VALUE 014710 "DBEZ086 WAEHRUNGS-KENNZ gleich D für Zeiten nach dem 31.12.2 014720- "001". 014730 05 FILLER PIC X(72) VALUE 014740 "DBEZ090 ENTGELT nicht numerisch". 014750 05 FILLER PIC X(72) VALUE 014760 "DBEZ094 ENTGELT gleich Grundstellung (Nullen) ab 01.01.1992 014770- "". 014780 05 FILLER PIC X(72) VALUE 014790 "DBEZ095 ENTGELT ungleich Grundstellung, WAEHRUNGS-KENNZ Grun 014800- "dstellung". 014810 05 FILLER PIC X(72) VALUE 014820 "DBEZ096 ENTGELT überschreitet die BBG". 014821 05 FILLER PIC X(72) VALUE 014822 "DBEZ097 ENTGELT überschreitet 400 Euro monatlich bei LEAT 43 014823- "/44". 014824 05 FILLER PIC X(72) VALUE 014825 "DBEZ098 ENTGELT überschreitet 205 Euro monatlich bei LEAT 43 014826- "/44". 014830 05 FILLER PIC X(72) VALUE 014840 "DBEZ100 BEITRAGSANTEIL nicht numerisch". 014850 05 FILLER PIC X(72) VALUE 014860 "DBEZ102 BEITRAGSANTEIL ungleich Grundstellung". 014870 05 FILLER PIC X(72) VALUE 014880 "DBEZ104 BEITRAGSANTEIL überschreitet den Grenzwert". 014890 05 FILLER PIC X(72) VALUE 014900 "DBEZ106 BEITRAGSANTEIL ungl. Grundstellung,WAEHRUNGS-KENNZ G 014910- "rundstellung". 014920 05 FILLER PIC X(72) VALUE 014930 "DBEZ160 KENNZ-RECHTSKREIS unzulässiges Zeichen". 014931 05 FILLER PIC X(72) VALUE 014932 "DBEZ164 KENNZ-RECHTSKREIS ungleich O bei LEAT 25 oder 26". 014933 05 FILLER PIC X(72) VALUE 014934 "DBEZ166 KENNZ-RECHTSKREIS ungleich W bei LEAT 23, 43 und 44 014935- "". 014940 05 FILLER PIC X(72) VALUE 014950 "DBEZ180 KENNZ-WIEDEREINGLIEDERUNG unzulässiges Zeichen". 014960 05 FILLER PIC X(72) VALUE 014970 "DBEZ910 Länge DBEZ falsch, Abbruch". 015270 05 FILLER PIC X(72) VALUE ALL "X". 015280 01 FEHLERKTLG. 015290 05 FEHLERELEM OCCURS 999. 015300 10 FEHLERNR PIC X(7). 015310 10 FEHLERMELD PIC X(65). 003605*COPY DDSME230. 015180**---------------------------------------------------------------- 015190** COPY-MEMBER : DDSME230 015200** PROGRAMMIERER : WERNER KRAUS 015210** ERSTELLUNGSDATUM : 20.03.1998 015220** VERSION : 001 (PGM-NEUERSTELLUNG) 015230** FUNKTION : MöGLICHE KOMBI ABGABEGRUND MIT DATENB. 015240**---------------------------------------------------------------- 015241** PROGRAMMIERER : GERTRAUD SCHUHMACHER 015242** ÄNDERUNG : 001 VOM 15.11.2000 015243**---------------------------------------------------------------- 015244** PROGRAMMIERER : GERTRAUD SCHUHMACHER 015245** ÄNDERUNG : 002 VOM 16.05.2001 015246**---------------------------------------------------------------- 015247** PROGRAMMIERER : MICHAEL KLEMKE 015248** ÄNDERUNG : 003 VOM 08.08.2002 015249** : NEUE ABGABEGRUENDE 86 - 88 015250**---------------------------------------------------------------- 015251** PROGRAMMIERER : MICHAEL KLEMKE 015252** ÄNDERUNG : 004 VOM 05.11.2002 (VERSION 29) 015253** : NEUE ABGABEGRUENDE 94 - 95 015254**---------------------------------------------------------------- 015255** PROGRAMMIERER : MICHAEL KLEMKE 015256** ÄNDERUNG : 005 VOM 13.05.2003 (VERSION 33) 015257** : NEUE ABGABEGRUENDE 80, ANDERE GELÖSCHT 015258**---------------------------------------------------------------- 015259** PROGRAMMIERER : MICHAEL KLEMKE 015260** ÄNDERUNG : 006 VOM 25.04.2005 (VERSION 45) 015262**---------------------------------------------------------------- 015263** PROGRAMMIERER : MICHAEL KLEMKE 015264** ÄNDERUNG : 007 VOM 28.02.2007 (VERSION 60) 015265**---------------------------------------------------------------- 015266** PROGRAMMIERER : MICHAEL KLEMKE 015267** ÄNDERUNG : 008 VOM 30.04.2007 (VERSION 62) 015268**---------------------------------------------------------------- 015269 01 GD-KOMBI-TAB PIC X(14). 015270 88 GD-KOMBI-OK VALUE 015271** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG 015280 "00 JJJNJN NNNN", 015281 "00 JJJNJN JNNN", 015282 "10 JJJNJN NNNN", 015290 "10 JJJNJN JNNN", 015300** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG OHNE VSNR MIT DBEU 015310 "10XJJJJJJ NNNN", 015320 "10XJJJJJJ JNNN", 015330** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG OHNE VSNR OHNE DBEU 015340 "10XJJJJJN NNNN", 015350 "10XJJJJJN JNNN", 015360** ANMELD. WEGEN KK-WECHSEL MIT VSNR 015370 "11 JJJNJN NNNN", 015380 "11 JJJNJN JNNN", 015390** ANMELD. WEGEN KK-WECHSEL OHNE VSNR MIT DBEU 015400 "11XJJJJJJ NNNN", 015410 "11XJJJJJJ JNNN", 015420** ANMELD. WEGEN KK-WECHSEL OHNE VSNR OHNE DBEU 015430 "11XJJJJJN NNNN", 015440 "11XJJJJJN JNNN", 015450** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 015460 "12 JJJNJN NNNN", 015470 "12 JJJNJN JNNN", 015480** ANMELD. WEGEN BEITRAGSGRP-WECHSEL OHNE VSNR MIT DBEU 015490 "12XJJJJJJ NNNN", 015500 "12XJJJJJJ JNNN", 015510** ANMELD. WEGEN BEITRAGSGRP-WECHSEL OHNE VSNR OHNE DBEU 015520 "12XJJJJJN NNNN", 015530 "12XJJJJJN JNNN", 015540** ANMELD WEGEN SONSTIGER GRUENDE MIT VSNR 015550 "01 JJJNJN NNNN", 015551 "01 JJJNJN JNNN", 015552 "13 JJJNJN NNNN", 015560 "13 JJJNJN JNNN", 015570** ANMELD WEGEN SONSTIGER GRUENDE OHNE VSNR MIT DBEU 015580 "13XJJJJJJ NNNN", 015590 "13XJJJJJJ JNNN", 015600** ANMELD WEGEN SONSTIGER GRUENDE OHNE VSNR OHNE DBEU 015610 "13XJJJJJN NNNN", 015620 "13XJJJJJN JNNN", 015630** ABMELD WEGEN ENDE BESCHäFTIGUNG 015640 "02 JJNNNN NNNN", 015650 "02 JJJNJN NNNN", 015660 "02 JJJNNN NNNN", 015670 "02 JJNNJN NNNN", 015680 "02 JJNNNN JNNN", 015690 "02 JJJNJN JNNN", 015700 "02 JJJNNN JNNN", 015710 "02 JJNNJN JNNN", 015711 "30 JJNNNN NNNN", 015712 "30 JJJNJN NNNN", 015713 "30 JJJNNN NNNN", 015714 "30 JJNNJN NNNN", 015715 "30 JJNNNN JNNN", 015716 "30 JJJNJN JNNN", 015717 "30 JJJNNN JNNN", 015718 "30 JJNNJN JNNN", 015720** ABMELD WEGEN KRANKENKASSENWECHSEL 015730 "31 JJNNNN NNNN", 015740 "31 JJJNJN NNNN", 015750 "31 JJJNNN NNNN", 015760 "31 JJNNJN NNNN", 015770 "31 JJNNNN JNNN", 015780 "31 JJJNJN JNNN", 015790 "31 JJJNNN JNNN", 015800 "31 JJNNJN JNNN", 015810** ABMELD WEGEN BEITRAGSGRUPPENWECHSEL 015820 "32 JJNNNN NNNN", 015830 "32 JJJNNN NNNN", 015840 "32 JJJNJN NNNN", 015850 "32 JJNNJN NNNN", 015860 "32 JJNNNN JNNN", 015870 "32 JJJNJN JNNN", 015880 "32 JJJNNN JNNN", 015890 "32 JJNNJN JNNN", 015900** ABMELD WEGEN SONSTIGER GRüNDE 015910 "04 JJNNNN NNNN", 015920 "04 JJJNJN NNNN", 015930 "04 JJJNNN NNNN", 015940 "04 JJNNJN NNNN", 015950 "04 JJNNNN JNNN", 015960 "04 JJJNJN JNNN", 015970 "04 JJJNNN JNNN", 015980 "04 JJNNJN JNNN", 015981 "33 JJNNNN NNNN", 015982 "33 JJJNJN NNNN", 015983 "33 JJJNNN NNNN", 015984 "33 JJNNJN NNNN", 015985 "33 JJNNNN JNNN", 015986 "33 JJJNJN JNNN", 015987 "33 JJJNNN JNNN", 015988 "33 JJNNJN JNNN", 015990** ABMELD WEGEN ENDE SOZIALVERS. BESCHäFTIGUNG 016000 "34 JJNNNN NNNN", 016010 "34 JJJNJN NNNN", 016020 "34 JJJNNN NNNN", 016030 "34 JJNNJN NNNN", 016040 "34 JJNNNN JNNN", 016050 "34 JJJNJN JNNN", 016060 "34 JJJNNN JNNN", 016070 "34 JJNNJN JNNN", 016080** ABMELD WEGEN ARBEITSKAMPF 016090 "35 JJNNNN NNNN", 016100 "35 JJJNJN NNNN", 016110 "35 JJJNNN NNNN", 016120 "35 JJNNJN NNNN", 016130 "35 JJNNNN JNNN", 016140 "35 JJJNJN JNNN", 016150 "35 JJJNNN JNNN", 016160 "35 JJNNJN JNNN", 016170** ABMELD WEGEN WECHSEL ENTGELDABRECHNUNGSSYSTEM 016180 "36 JJNNNN NNNN", 016190 "36 JJJNJN NNNN", 016200 "36 JJJNNN NNNN", 016210 "36 JJNNJN NNNN", 016220 "36 JJNNNN JNNN", 016230 "36 JJJNJN JNNN", 016240 "36 JJJNNN JNNN", 016250 "36 JJNNJN JNNN", 016260** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 016262 "40 JJJNJN NNNN", 016266 "40 JJJNJN JNNN", 016290** 016292 "40XJJJJJJ JNNN", 016293 "40XJJJJJN JNNN", 016294 "40XJJJJJJ NNNN", 016297 "40XJJJJJN NNNN", 016299** ABMELDUNG WEGEN TOD 016300 "09 JJNNNN NNNN", 016310 "09 JJJNJN NNNN", 016320 "09 JJJNNN NNNN", 016330 "09 JJNNJN NNNN", 016340 "09 JJNNNN JNNN", 016350 "09 JJJNJN JNNN", 016360 "09 JJJNNN JNNN", 016370 "09 JJNNJN JNNN", 016371 "49 JJNNNN NNNN", 016372 "49 JJJNJN NNNN", 016373 "49 JJJNNN NNNN", 016374 "49 JJNNJN NNNN", 016375 "49 JJNNNN JNNN", 016376 "49 JJJNJN JNNN", 016377 "49 JJJNNN JNNN", 016378 "49 JJNNJN JNNN", 016380** JAHRESMELDUNG 016390 "03 JJNNNN NNNN", 016400 "03 JJJNJN NNNN", 016410 "03 JJJNNN NNNN", 016420 "03 JJNNJN NNNN", 016430 "03 JJNNNN JNNN", 016440 "03 JJJNJN JNNN", 016450 "03 JJJNNN JNNN", 016460 "03 JJNNJN JNNN", 016461 "50 JJNNNN NNNN", 016462 "50 JJJNJN NNNN", 016463 "50 JJJNNN NNNN", 016464 "50 JJNNJN NNNN", 016465 "50 JJNNNN JNNN", 016466 "50 JJJNJN JNNN", 016467 "50 JJJNNN JNNN", 016468 "50 JJNNJN JNNN", 016469** ---------------------------------------------------------- 016470** VERSION-33 13.05.2003 016471** ---------------------------------------------------------- 016472 "80 JNNNNN NNNJ", 016473** ---------------------------------------------------------- 016474** VERSION-29 05.11.2002 016475** ---------------------------------------------------------- 016476 "94 JJNNNN NNNN", 016477 "94 JJJNJN NNNN", 016478 "94 JJJNNN NNNN", 016479 "94 JJNNJN NNNN", 016480 "94 JJNNNN JNNN", 016481 "94 JJJNJN JNNN", 016482 "94 JJJNNN JNNN", 016483 "94 JJNNJN JNNN", 016484** --------- ---------------------- 016485 "95 JJNNNN NNNN", 016486 "95 JJJNJN NNNN", 016487 "95 JJJNNN NNNN", 016488 "95 JJNNJN NNNN", 016489 "95 JJNNNN JNNN", 016490 "95 JJJNJN JNNN", 016491 "95 JJJNNN JNNN", 016492 "95 JJNNJN JNNN", 016493** ---------------------------------------------------------- 016494** UNTERBRECHUNGSMELD WEGEN ENTGELDERSATZLEISTUNG 016495 "51 JJNNNN NNNN", 016496 "51 JJJNJN NNNN", 016500 "51 JJJNNN NNNN", 016510 "51 JJNNJN NNNN", 016520 "51 JJNNNN JNNN", 016530 "51 JJJNJN JNNN", 016540 "51 JJJNNN JNNN", 016550 "51 JJNNJN JNNN", 016560** UNTERBRECHUNGSMELD WEGEN ERZIEHUNGSURLAUB 016570 "52 JJNNNN NNNN", 016580 "52 JJJNJN NNNN", 016590 "52 JJJNNN NNNN", 016600 "52 JJNNJN NNNN", 016610 "52 JJNNNN JNNN", 016620 "52 JJJNJN JNNN", 016630 "52 JJJNNN JNNN", 016640 "52 JJNNJN JNNN", 016650** UNTERBRECHUNGSMELD WEGEN GESTZL. DIENSTPFLICHT 016660 "53 JJNNNN NNNN", 016670 "53 JJJNJN NNNN", 016680 "53 JJJNNN NNNN", 016690 "53 JJNNJN NNNN", 016700 "53 JJNNNN JNNN", 016710 "53 JJJNJN JNNN", 016720 "53 JJJNNN JNNN", 016730 "53 JJNNJN JNNN", 016740** MELDUNG EINMALIG GEZAHLTES ENTGELD 016750 "05 JJNNNN NNNN", 016760 "05 JJJNJN NNNN", 016770 "05 JJJNNN NNNN", 016780 "05 JJNNJN NNNN", 016790 "05 JJNNNN JNNN", 016800 "05 JJJNJN JNNN", 016810 "05 JJJNNN JNNN", 016820 "05 JJNNJN JNNN", 016821 "54 JJNNNN NNNN", 016822 "54 JJJNJN NNNN", 016823 "54 JJJNNN NNNN", 016824 "54 JJNNJN NNNN", 016825 "54 JJNNNN JNNN", 016826 "54 JJJNJN JNNN", 016827 "54 JJJNNN JNNN", 016828 "54 JJNNJN JNNN", 016829** MELDUNG VON NICHT VEREINBARUNGSGEM. VERWENDETEM 016830** WERTGUTHABEN (STOERFALL) 016831 "55 JJNNNN NNNN", 016832 "55 JJJNJN NNNN", 016833 "55 JJJNNN NNNN", 016834 "55 JJNNJN NNNN", 016835 "55 JJNNNN JNNN", 016836 "55 JJJNJN JNNN", 016837 "55 JJJNNN JNNN", 016838 "55 JJNNJN JNNN", 016839** MELDUNG UNTERSCHIEDSBETRAG BEI ENTGELTERSATZLEISTUNGEN 016840** WAEHREND ALTERSTEILZEIT 016841 "56 JJNNNN NNNN", 016842 "56 JJJNJN NNNN", 016843 "56 JJJNNN NNNN", 016844 "56 JJNNJN NNNN", 016845 "56 JJNNNN JNNN", 016846 "56 JJJNJN JNNN", 016847 "56 JJJNNN JNNN", 016848 "56 JJNNJN JNNN", 016849** MELDUNG KRANKENKASSE FüR UNSTäNDIG BESCHäFTIGTE 016850 "59 JJNNNN NNNN", 016851 "59 JJNNNN JNNN", 016860** äNDERUNG NAME 016870 "60 JNJNJN NNNN", 016880 "60 JNJNNN NNNN", 016890 "60 JNJNJN JNNN", 016900 "60 JNJNNN JNNN", 016910** äNDERUNG ANSCHRIFT 016920 "61 JNNNJN NNNN", 016930 "61 JNNNJN JNNN", 016940** äNDERUNG AKTENZEICHEN/PERSONALNUMMER D. BESCHäFTIGTEN 016950 "62 JNNNNN NNNN", 016960 "62 JNNNNN JNNN", 016970** äNDERUNG STAATSANGEHöRIGKEIT 016980 "63 JNNNNN NNNN", 016990 "63 JNNNNN JNNN", 017000** JAHRESMELDUNG F. FREIGESTELLTE ARBEITNEHMER 017010 "70 JJNNNN NNNN", 017020 "70 JJJNJN NNNN", 017030 "70 JJJNNN NNNN", 017040 "70 JJNNJN NNNN", 017050 "70 JJNNNN JNNN", 017060 "70 JJJNJN JNNN", 017070 "70 JJJNNN JNNN", 017080 "70 JJNNJN JNNN", 017090** MELDUNG DES VORLAGES DER INSOLVENZ/DER FREISTELLUNG 017100 "07 JJNNNN NNNN", 017110 "07 JJJNJN NNNN", 017120 "07 JJJNNN NNNN", 017130 "07 JJNNJN NNNN", 017140 "07 JJNNNN JNNN", 017150 "07 JJJNJN JNNN", 017160 "07 JJJNNN JNNN", 017170 "07 JJNNJN JNNN", 017171 "71 JJNNNN NNNN", 017172 "71 JJJNJN NNNN", 017173 "71 JJJNNN NNNN", 017174 "71 JJNNJN NNNN", 017175 "71 JJNNNN JNNN", 017176 "71 JJJNJN JNNN", 017177 "71 JJJNNN JNNN", 017178 "71 JJNNJN JNNN", 017180** ENTGELDMELDUNG ZUM RECHTLICHEN ENDE DER BESCHäFTIGUNG 017190 "08 JJNNNN NNNN", 017200 "08 JJJNJN NNNN", 017210 "08 JJJNNN NNNN", 017220 "08 JJNNJN NNNN", 017230 "08 JJNNNN JNNN", 017240 "08 JJJNJN JNNN", 017250 "08 JJJNNN JNNN", 017260 "08 JJNNJN JNNN", 017261 "72 JJNNNN NNNN", 017262 "72 JJJNJN NNNN", 017263 "72 JJJNNN NNNN", 017264 "72 JJNNJN NNNN", 017265 "72 JJNNNN JNNN", 017266 "72 JJJNJN JNNN", 017267 "72 JJJNNN JNNN", 017268 "72 JJNNJN JNNN", 017270** ---------------------------------------------------------- 017271** VERSION-28 08.08.2002 017272** ---------------------------------------------------------- 017286** RÜCKMELDUNG GERINGFÜGIG BESCHÄFTIGTER 017287** "89 JNNNNN NNNJ", 017290** "89 JNNNNN JNNJ", 017300** ANFORDERUNG EINES SV-AUSWEISES 017310 "90 JNJNJN NJNN", 017320 "90 JNJNJN JJNN", 017390** ANTRAG AUF VERGABE VSNR 017391** (DBNA=K, DBAN=K, DBVR=J) 017400 "99 JNNNNN NNJN", 017410 "99 JNJNNN NNJN", 017420 "99 JNNNJN NNJN", 017430 "99 JNJNJN NNJN". 017431 017432 017433 017434 01 GD-KOMBIKNA-TAB PIC X(14). 017435 88 GD-KOMBIKNA-OK VALUE 017436** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG 017437 "00 JJJJJN NNNN", 017438 "00 JJJJJN JNNN", 017439** ANMELD WEGEN SONSTIGER GRUENDE MIT VSNR 017440 "01 JJJJJN NNNN", 017441 "01 JJJJJN JNNN", 017443** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017444 "10 JJJJJN NNNN", 017445 "10 JJJJJN JNNN", 017449** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017450 "11 JJJJJN NNNN", 017451 "11 JJJJJN JNNN", 017459** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017460 "12 JJJJJN NNNN", 017470 "12 JJJJJN JNNN", 017471** ANMELD WEGEN SONSTIGER GRUENDE 017472 "13 JJJJJN NNNN", 017473 "13 JJJJJN JNNN", 017553** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 017554 "40 JJJJJN NNNN", 017555 "40 JJJJJN JNNN", 017563** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017564 "10XJJJJJN NNNN", 017565 "10XJJJJJN JNNN", 017566** ANMELD. WEGEN KK-WECHSEL O. VSNR 017567 "11XJJJJJN NNNN", 017568 "11XJJJJJN JNNN", 017569** ANMELD. WEGEN BEITRAGSGRP-WECHSEL O. VSNR 017570 "12XJJJJJN NNNN", 017571 "12XJJJJJN JNNN", 017572** ANMELD WEGEN SONSTIGER GRUENDE 017573 "13XDJJJJN NNNN", 017574 "13XJJJJJN JNNN", 017575** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 017576 "40XJJJJJN NNNN", 017577 "40XJJJJJN JNNN". 017578** 017579 01 GD-KOMBIKNA-DBKSN-TAB PIC X(14). 017580 88 GD-KOMBIKNA-DBKSN-OK VALUE 017581** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG 017582 "00 JJJJJN NNNN", 017583** ANMELD WEGEN SONSTIGER GRUENDE MIT VSNR 017584 "01 JJJJJN NNNN", 017585** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017586 "10 JJJJJN NNNN", 017587** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017588 "11 JJJJJN NNNN", 017589** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017590 "12 JJJJJN NNNN", 017591** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017592 "13 JJJJJN NNNN", 017593** ANMELD WEGEN SONSTIGER GRUENDE 017594 "40 JJJJJN NNNN", 017595** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017596 "10XJJJJJN NNNN", 017597** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017598 "11XJJJJJN NNNN", 017599** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017600 "12XJJJJJN NNNN", 017601** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017602 "13XJJJJJN NNNN", 017603** ANMELD WEGEN SONSTIGER GRUENDE 017604 "40XJJJJJN NNNN". 017605** 017606 01 GD-KOMBIKNA-DBKSJ-TAB PIC X(14). 017607 88 GD-KOMBIKNA-DBKSJ-OK VALUE 017608** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG 017609 "00 JJJJJN JNNN", 017610** ANMELD WEGEN SONSTIGER GRUENDE MIT VSNR 017611 "01 JJJJJN JNNN", 017612** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017613 "10 JJJJJN JNNN", 017614** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017615 "11 JJJJJN JNNN", 017616** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017617 "12 JJJJJN JNNN", 017618** ANMELD WEGEN SONSTIGER GRUENDE 017619 "13 JJJJJN JNNN", 017620** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 017621 "40 JJJJJN JNNN", 017622** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017623 "10XJJJJJN JNNN", 017624** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017625 "11XJJJJJN JNNN", 017626** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017627 "12XJJJJJN JNNN", 017628** ANMELD WEGEN SONSTIGER GRUENDE 017629 "13XJJJJJN JNNN", 017630** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 017631 "40XJJJJJN JNNN". 017632** 017633 01 GD-KOMBI140KNA-TAB PIC X(14). 017634 88 GD-KOMBI140KNA-OK VALUE 017635** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG 017636 "00 JJJJJN JNNN", 017637 "00 JJJJJN NNNN", 017638** ANMELD WEGEN SONSTIGER GRUENDE MIT VSNR 017639 "01 JJJJJN NNNN", 017640 "01 JJJJJN JNNN", 017700** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017710 "10 JJJJJN NNNN", 017720 "10 JJJJJN JNNN", 017730** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017740 "11 JJJJJN NNNN", 017750 "11 JJJJJN JNNN", 017751** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017752 "12 JJJJJN NNNN", 017753 "12 JJJJJN JNNN", 017754** ANMELD WEGEN SONSTIGER GRUENDE 017755 "13 JJJJJN NNNN", 017756 "13 JJJJJN JNNN", 017757** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 017758 "40 JJJJJN NNNN", 017759 "40 JJJJJN JNNN", 017760** ANMELD WEGEN BEGINN EINER BESCHAEFTIGUNG 017761 "10XJJJJJN NNNN", 017762 "10XJJJJJN JNNN", 017763** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017764 "11XJJJJJN NNNN", 017765 "11XJJJJJN JNNN", 017766** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017767 "12XJJJJJN NNNN", 017768 "12XJJJJJN JNNN", 017769** ANMELD WEGEN SONSTIGER GRUENDE 017770 "13XJJJJJN NNNN", 017771 "13XJJJJJN JNNN", 017772** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 017773 "40XJJJJJN NNNN", 017774 "40XJJJJJN JNNN". 017775** 017776 017777 017778 017779 01 GD-KOMBI140-TAB PIC X(14). 017780 88 GD-KOMBI140-OK VALUE 017781** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG 017782 "00 JJJNJN JNNN", 017783 "10 JJJNJN JNNN", 017784** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG OHNE VSNR MIT DBEU 017785 "10XJJJJJJ JNNN", 017786** ANMELDUNG WEGEN BEGINN BESCHäFTIGUNG OHNE VSNR OHNE DBEU 017787 "10XJJJJJN JNNN", 017788** ANMELD. WEGEN KK-WECHSEL MIT VSNR 017789 "11 JJJNJN JNNN", 017790** ANMELD. WEGEN KK-WECHSEL OHNE VSNR MIT DBEU 017791 "11XJJJJJJ JNNN", 017792** ANMELD. WEGEN KK-WECHSEL OHNE VSNR OHNE DBEU 017793 "11XJJJJJN JNNN", 017794** ANMELD. WEGEN BEITRAGSGRP-WECHSEL MIT VSNR 017795 "12 JJJNJN JNNN", 017796** ANMELD. WEGEN BEITRAGSGRP-WECHSEL OHNE VSNR MIT DBEU 017797 "12XJJJJJJ JNNN", 017798** ANMELD. WEGEN BEITRAGSGRP-WECHSEL OHNE VSNR OHNE DBEU 017799 "12XJJJJJN JNNN", 017800** ANMELD WEGEN SONSTIGER GRUENDE MIT VSNR 017801 "01 JJJNJN JNNN", 017802 "13 JJJNJN JNNN", 017803** ANMELD WEGEN SONSTIGER GRUENDE OHNE VSNR MIT DBEU 017804 "13XJJJJJJ JNNN", 017805** ANMELD WEGEN SONSTIGER GRUENDE OHNE VSNR OHNE DBEU 017806 "13XJJJJJN JNNN", 017807** ABMELD WEGEN ENDE BESCHäFTIGUNG 017808 "02 JJNNNN JNNN", 017809 "02 JJJNJN JNNN", 017810 "02 JJJNNN JNNN", 017811 "02 JJNNJN JNNN", 017812 "30 JJNNNN JNNN", 017813 "30 JJJNJN JNNN", 017814 "30 JJJNNN JNNN", 017815 "30 JJNNJN JNNN", 017816** ABMELD WEGEN KRANKENKASSENWECHSEL 017817 "31 JJNNNN JNNN", 017818 "31 JJJNJN JNNN", 017819 "31 JJJNNN JNNN", 017820 "31 JJNNJN JNNN", 017821** ABMELD WEGEN BEITRAGSGRUPPENWECHSEL 017822 "32 JJNNNN JNNN", 017823 "32 JJJNJN JNNN", 017830 "32 JJJNNN JNNN", 017840 "32 JJNNJN JNNN", 017850** ABMELD WEGEN SONSTIGER GRüNDE 017860 "04 JJNNNN JNNN", 017870 "04 JJJNJN JNNN", 017880 "04 JJJNNN JNNN", 017890 "04 JJNNJN JNNN", 017891 "33 JJNNNN JNNN", 017892 "33 JJJNJN JNNN", 017893 "33 JJJNNN JNNN", 017894 "33 JJNNJN JNNN", 017900** ABMELD WEGEN ENDE SOZIALVERS. BESCHäFTIGUNG 017910 "34 JJNNNN JNNN", 017920 "34 JJJNJN JNNN", 017930 "34 JJJNNN JNNN", 017940 "34 JJNNJN JNNN", 017950** ABMELD WEGEN ARBEITSKAMPF 017960 "35 JJNNNN JNNN", 017970 "35 JJJNJN JNNN", 017980 "35 JJJNNN JNNN", 017990 "35 JJNNJN JNNN", 018000** ABMELD WEGEN WECHSEL ENTGELDABRECHNUNGSSYSTEM 018010 "36 JJNNNN JNNN", 018020 "36 JJJNJN JNNN", 018030 "36 JJJNNN JNNN", 018040 "36 JJNNJN JNNN", 018050** GLEICHZEITIGE AN-ABMELDUNG WEGEN ENDE BESCHäFTIGUNG 018052 "40 JJJNJN JNNN", 018055 018056 "40XJJJJJJ JNNN", 018057 "40XJJJJJN JNNN", 018070** ABMELDUNG WEGEN TOD 018080 "09 JJNNNN JNNN", 018090 "09 JJJNJN JNNN", 018100 "09 JJJNNN JNNN", 018110 "09 JJNNJN JNNN", 018111 "49 JJNNNN JNNN", 018112 "49 JJJNJN JNNN", 018113 "49 JJJNNN JNNN", 018114 "49 JJNNJN JNNN", 018120** JAHRESMELDUNG 018130 "03 JJNNNN JNNN", 018140 "03 JJJNJN JNNN", 018150 "03 JJJNNN JNNN", 018160 "03 JJNNJN JNNN", 018161 "50 JJNNNN JNNN", 018162 "50 JJJNJN JNNN", 018163 "50 JJJNNN JNNN", 018164 "50 JJNNJN JNNN", 018165** ---------------------------------------------------------- 018166** VERSION-29 05.11.2002 018167** ---------------------------------------------------------- 018168 "94 JJNNNN JNNN", 018169 "94 JJJNJN JNNN", 018170 "94 JJJNNN JNNN", 018171 "94 JJNNJN JNNN", 018172** --------- ---------------------- 018173 "95 JJNNNN JNNN", 018174 "95 JJJNJN JNNN", 018175 "95 JJJNNN JNNN", 018176 "95 JJNNJN JNNN", 018177** ---------------------------------------------------------- 018178** UNTERBRECHUNGSMELD WEGEN ENTGELDERSATZLEISTUNG 018180 "51 JJNNNN JNNN", 018190 "51 JJJNJN JNNN", 018200 "51 JJJNNN JNNN", 018210 "51 JJNNJN JNNN", 018220** UNTERBRECHUNGSMELD WEGEN ERZIEHUNGSURLAUB 018230 "52 JJNNNN JNNN", 018240 "52 JJJNJN JNNN", 018250 "52 JJJNNN JNNN", 018260 "52 JJNNJN JNNN", 018270** UNTERBRECHUNGSMELD WEGEN GESTZL. DIENSTPFLICHT 018280 "53 JJNNNN JNNN", 018290 "53 JJJNJN JNNN", 018300 "53 JJJNNN JNNN", 018310 "53 JJNNJN JNNN", 018320** MELDUNG EINMALIG GEZAHLTES ENTGELD 018330 "05 JJNNNN JNNN", 018340 "05 JJJNJN JNNN", 018350 "05 JJJNNN JNNN", 018360 "05 JJNNJN JNNN", 018361 "54 JJNNNN JNNN", 018362 "54 JJJNJN JNNN", 018363 "54 JJJNNN JNNN", 018364 "54 JJNNJN JNNN", 018365** MELDUNG VON NICHT VEREINBARUNGSGEM. VERWENDETEM 018366** WERTGUTHABEN (STOERFALL) 018367 "55 JJNNNN JNNN", 018368 "55 JJJNJN JNNN", 018369 "55 JJJNNN JNNN", 018370 "55 JJNNJN JNNN", 018371** MELDUNG UNTERSCHIEDSBETRAG BEI ENTGELTERSATZLEISTUNGEN 018372** WAEHREND ALTERSTEILZEIT 018373 "56 JJNNNN JNNN", 018374 "56 JJJNJN JNNN", 018375 "56 JJJNNN JNNN", 018376 "56 JJNNJN JNNN", 018377** MELDUNG KRANKENKASSE FüR UNSTäNDIG BESCHäFTIGTE 018380 "59 JJNNNN NNNN", 018390** äNDERUNG NAME 018400 "60 JNJNJN NNNN", 018410 "60 JNJNNN NNNN", 018420** äNDERUNG ANSCHRIFT 018430 "61 JNNNJN NNNN", 018440** äNDERUNG AKTENZEICHEN/PERSONALNUMMER D. BESCHäFTIGTEN 018450 "62 JNNNNN NNNN", 018460** äNDERUNG STAATSANGEHöRIGKEIT 018470 "63 JNNNNN NNNN", 018480** JAHRESMELDUNG F. FREIGESTELLTE ARBEITNEHMER 018490 "70 JJNNNN JNNN", 018500 "70 JJJNJN JNNN", 018510 "70 JJJNNN JNNN", 018520 "70 JJNNJN JNNN", 018530** MELDUNG DES VORLAGES DER INSOLVENZ/DER FREISTELLUNG 018540 "07 JJNNNN JNNN", 018550 "07 JJJNJN JNNN", 018560 "07 JJJNNN JNNN", 018570 "07 JJNNJN JNNN", 018571 "71 JJNNNN JNNN", 018572 "71 JJJNJN JNNN", 018573 "71 JJJNNN JNNN", 018574 "71 JJNNJN JNNN", 018580** ENTGELDMELDUNG ZUM RECHTLICHEN ENDE DER BESCHäFTIGUNG 018590 "08 JJNNNN JNNN", 018600 "08 JJJNJN JNNN", 018610 "08 JJJNNN JNNN", 018620 "08 JJNNJN JNNN", 018621 "72 JJNNNN JNNN", 018622 "72 JJJNJN JNNN", 018623 "72 JJJNNN JNNN", 018624 "72 JJNNJN JNNN", 018634** ---------------------------------------------------------- 018635** RüCKMELDUNG GERINGFüGIG BESCHäFTIGTER 018640** "89 JNNNNN NNNJ", 018650** ANFORDERUNG EINES SV-AUSWEISES 018660 "90 JNJNJN NJNN", 018710** ANTRAG AUF VERGABE VSNR (FüR PERSGR='140' - '143') 018711** (DBNA=K, DBEU=K, DBVR=J) 018720 "99 JNNNNN NNJN", 018730 "99 JNJNNN NNJN", 018740 "99 JNNNNJ NNJN", 018750 "99 JNJNNJ NNJN". 018751** ANTRAG AUF VERGABE VSNR (FüR GDMQ='01' ODER '99') 018752** (DBNA=J, DBGB=J, DBAN=J, DBEU=K, DBVR=J) 018760 01 GD-KOMBI9901-TAB PIC X(14). 018770 88 GD-KOMBI9901-OK VALUE 018780 "99 JNJJJJ NNJN", 018790 "99 JNJJJN NNJN". 018791** ANFRAGE NACH EINER VSNR (FüR GDMQ='04') 018792** (DBNA=J, DBGB=J, DBAN=J, DBEU=K, DBVR=J) 018793 01 GD-KOMBI9904-TAB PIC X(14). 018794 88 GD-KOMBI9904-OK VALUE 018795 "99 JNJNJN NNJN", 018796 "99 JNJNJJ NNJN", 018797 "99 JNJJJN NNJN", 018798 "99 JNJJJJ NNJN". 018799** ANFRAGE, OB DIE PERSÖNLICHEN DATEN DES/DER VERSICHERTEN 018800** MIT DEN DATEN DER RENTENVERSICHERUNG ÜBEREINSTIMMEN 018801** UND RÜECKMELDUNG DAZU (GDMQ = 80 - 85) 018802** (DBNA=J, DBGB=J, DBAN=J, DBEU=K, DBVR=J) 018803 01 GD-KOMBI9980-TAB PIC X(14). 018804 88 GD-KOMBI9980-OK VALUE 018807 "99 JNJJJN NNJN", 018808 "99 JNJJJJ NNJN". 018809** ---------------------------------------------- 018811** ÄNDERUNG VOM 26.04.2005 018812** ---------------------------------------------- 018813** ANFRAGE NACH EINER VSNR AUS DEM KVNR-VERFAHREN 018814** (GDMQ = 04) 018815** (DBNA=J, DBGB=J, DBAN=J, DBEU=K, DBVR=J) 018816** ---------------------------------------------- 018817 01 GD-KOMBI9904-KVNR PIC X(14). 018818 88 GD-KOMBI9904-KVNR-OK VALUE 018819 "99 JNJJJN NNJN", 018820 "99 JNJJJJ NNJN". 018821 018822 018823 01 HFELD-KOMB. 018824 05 HFELD-KOMBGD PIC X(02). 018825 05 HFELD-KOMB-VSNR PIC X. 018830 05 FILLER PIC X(01) VALUE "J". 018840 05 HFELD-KOMBDB PIC X(10). 003606*COPY DDSME250. 018860**---------------------------------------------------------------- 018870** WICHTIG !!!! : WENN ÄNDERUNG DURCHGEFüHRT WIRD IST DAS 018871** : PROGRAMM QV277S ZU SICHERN 018872**---------------------------------------------------------------- 018873** COPY-MEMBER : DDSME250 018880** PROGRAMMIERER : WERNER KRAUS 018890** ERSTELLUNGSDATUM : 23.03.1998 018900** VERSION : 001 (PGM-NEUERSTELLUNG) 018910** FUNKTION : DATENDEFINITIONEN FüR CDSME250 018920**---------------------------------------------------------------- 018921** PROGRAMMIERER : WERNER KRAUS 018922** ERSTELLUNGSDATUM : 26.10.2003 018923** VERSION : 002 018925**---------------------------------------------------------------- 018926** PROGRAMMIERER : MICHAEL KLEMKE 018927** ERSTELLUNGSDATUM : 03.11.2006 018928** VERSION : 003 018929**---------------------------------------------------------------- 018930**GüLTIGE SCHLüSSEL FüR STAATSANGEHöRIGKEIT 018940 01 SA-TAB PIC X(3). 018950 88 SA-OK VALUES "287", "274", "225", "423", "121", "221", 018960 "368", "123", "223", "320", "323", "422", "425", "523", 018970 "324", "424", "460", "322", "124", "330", "229", "426", 018980 "326", "122", "227", "327", "168", "429", "125", "258", 018990 "291", "332", "465", "479", "334", "126", "525", "469", 019000 "000", "333", "335", "230", "336", "224", "127", "526", 019010 "128", "129", "236", "237", "430", "238", "340", "134", 019020 "345", "259", "261", "328", "346", "347", "436", "437", 019030 "438", "439", "135", "136", "441", "137", "231", "355", 019040 "442", "421", "445", "138", "446", "262", "348", "242", 019050 "444", "447", "243", "450", "530", "349", "244", "245", 019060 "434", "467", "130", "351", "448", "449", "226", "139", 019070 "451", "247", "248", "141", "142", "366", "143", "249", 019080 "144", "256", "482", "454", "251", "145", "252", "544", 019090 "239", "253", "353", "545", "146", "147", "457", "254", 019100 "427", "267", "531", "458", "536", "354", "148", "232", 019110 "255", "149", "151", "456", "461", "537", "357", "538", 019120 "359", "361", "462", "152", "153", "265", "154", "160", 019130 "524", "337", "257", "543", "156", "268", "472", "157", 019140 "158", "269", "271", "272", "233", "474", "155", "131", 019150 "273", "161", "431", "263", "276", "364", "281", "475", 019160 "470", "282", "476", "283", "541", "284", "164", "285", 019170 "163", "471", "540", "286", "166", "165", "998", "365", 019180 "477", "532", "167", "367", "432", "369", "527", "533", 019190 "370", "371", "169", "246", "289", "181", "195", "199", 019200 "295", "299", "395", "399", "495", "499", "595", "599", 019210 "996", "997", "998", "999", "483", "132", "133", "140". 003607*COPY DDBEU010. 019230**---------------------------------------------------------------- 019240** COPY-MEMBER : DDBEU010 019250** PROGRAMMIERER : WERNER KRAUS 019260** ERSTELLUNGSDATUM : 24.03.1998 019270** VERSION : 001 (PGM-NEUERSTELLUNG) 019280** FUNKTION : DATENDEF. FüR CDBEU010 019290**---------------------------------------------------------------- 019300**---------------------------------------------------------------- 019310** GüLTIGE GEBURTSLäNDER 019320**---------------------------------------------------------------- 019330 01 GBLD-TAB PIC 9(03). 019340 88 GBLD-OK VALUES 124, 126, 128, 129, 134 THRU 137, 019350 141, 143, 148, 149, 151, 153, 157, 019360 161, 168. 003608*COPY DBBGPRUE. 019380**---------------------------------------------------------------- 019390** COPY-MEMBER : DBBGPRUE 019400** PROGRAMMIERER : WERNER KRAUS 019410** ERSTELLUNGSDATUM : 07.05.1998 019420** VERSION : 001 (PGM-NEUERSTELLUNG) 019430** FUNKTION : DEFINITIONEN FüR BBG-PRüFUNG 019440**---------------------------------------------------------------- 019441** PROGRAMMIERER : MICHAEL KLEMKE 019442** VERSION : 002 019443** ERSTELLUNGSDATUM : 15.10.2001 019444** FUNKTION : NEUE BBG FUER 2002 - 2004 019450**--------------------------------------------------------------- 019451** PROGRAMMIERER : MICHAEL KLEMKE 019452** VERSION : 003 019453** ERSTELLUNGSDATUM : 05.11.2002 019454** FUNKTION : NEUE BBG FUER 2003 - 2005 019455**--------------------------------------------------------------- 019456** PROGRAMMIERER : MICHAEL KLEMKE 019457** VERSION : 004 019458** ERSTELLUNGSDATUM : 26.10.2003 019459** FUNKTION : NEUE BBG FUER 2004 - 2006 019460**--------------------------------------------------------------- 019461** PROGRAMMIERER : MICHAEL KLEMKE 019462** VERSION : 005 019463** ERSTELLUNGSDATUM : 14.10.2004 019464** FUNKTION : NEUE BBG FUER 2005 - 2007 019465**--------------------------------------------------------------- 019466** PROGRAMMIERER : MICHAEL KLEMKE 019467** VERSION : 006 019468** ERSTELLUNGSDATUM : 31.10.2005 019469** FUNKTION : NEUE BBG FUER 2006 - 2008 019470**--------------------------------------------------------------- 019471** TABELLE FüR PERSGR-PRUEF FüR BBG 019472**--------------------------------------------------------------- 019480 01 BBG-PERSGR-TAB PIC 9(3). 019490 88 BBG-PERSGR-OK VALUE 201, 207, 208, 301, 302, 019491** ------------------------------- 019492** 15-10-2001 Version 25 / 01 019493** ------------------------------- 019500 109, 209, 210, 019501** ------------------------------- 019502 303. 019504** 019510**--------------------------------------------------------------- 019520** MONATS-TABELLE 019530**--------------------------------------------------------------- 019540 01 TB-JAHR. 019550 02 FILLER PIC 9(4) VALUE 0131. 019560 02 TB-FEBRUAR PIC 9(4) VALUE 0228. 019570 02 FILLER PIC 9(4) VALUE 0331. 019580 02 FILLER PIC 9(4) VALUE 0430. 019590 02 FILLER PIC 9(4) VALUE 0531. 019600 02 FILLER PIC 9(4) VALUE 0630. 019610 02 FILLER PIC 9(4) VALUE 0731. 019620 02 FILLER PIC 9(4) VALUE 0831. 019630 02 FILLER PIC 9(4) VALUE 0930. 019640 02 FILLER PIC 9(4) VALUE 1031. 019650 02 FILLER PIC 9(4) VALUE 1130. 019660 02 FILLER PIC 9(4) VALUE 1231. 019670**--------------------------------------------------------------- 019680 01 TB-MONAT REDEFINES TB-JAHR. 019690 02 TB-MOTG OCCURS 12. 019700 03 TB-MO PIC 9(02). 019710 03 TB-TG PIC 9(02). 019720**--------------------------------------------------------------- 019730** BEITRAGSBEMESSUNGSGRENZE 019740**--------------------------------------------------------------- 019750** 03 1. ZEILE = VSTR/RECHTSKREIS 019760** AVW = AV/ArV West 019770** AVO = AV/ArV Ost 019780** KNW = KnV West 019790** KNO = KnV Ost 019800** 03 2. ZEILE = ZEITRAUM 019810** 03 3. ZEILE = BMG JÄHRLICH 9 STELLEN(7,2) 019811**--------------------------------------------------------------- 019820 01 TABELLE-ENTGELT. 019830 02 FILLER. 019840 03 FILLER PIC X(03) VALUE "AVW". 019850 03 FILLER PIC 9(04) VALUE 1973. 019860 03 FILLER PIC 9(09) VALUE 002760000. 019870 02 FILLER. 019880 03 FILLER PIC X(03) VALUE "AVW". 019890 03 FILLER PIC 9(04) VALUE 1974. 019900 03 FILLER PIC 9(09) VALUE 003000000. 019910 02 FILLER. 019920 03 FILLER PIC X(03) VALUE "AVW". 019930 03 FILLER PIC 9(04) VALUE 1975. 019940 03 FILLER PIC 9(09) VALUE 003360000. 019950 02 FILLER. 019960 03 FILLER PIC X(03) VALUE "AVW". 019970 03 FILLER PIC 9(04) VALUE 1976. 019980 03 FILLER PIC 9(09) VALUE 003720000. 019990 02 FILLER. 020000 03 FILLER PIC X(03) VALUE "AVW". 020010 03 FILLER PIC 9(04) VALUE 1977. 020020 03 FILLER PIC 9(09) VALUE 004080000. 020030 02 FILLER. 020040 03 FILLER PIC X(03) VALUE "AVW". 020050 03 FILLER PIC 9(04) VALUE 1978. 020060 03 FILLER PIC 9(09) VALUE 004440000. 020070 02 FILLER. 020080 03 FILLER PIC X(03) VALUE "AVW". 020090 03 FILLER PIC 9(04) VALUE 1979. 020100 03 FILLER PIC 9(09) VALUE 004800000. 020110 02 FILLER. 020120 03 FILLER PIC X(03) VALUE "AVW". 020130 03 FILLER PIC 9(04) VALUE 1980. 020140 03 FILLER PIC 9(09) VALUE 005040000. 020150 02 FILLER. 020160 03 FILLER PIC X(03) VALUE "AVW". 020170 03 FILLER PIC 9(04) VALUE 1981. 020180 03 FILLER PIC 9(09) VALUE 005280000. 020190 02 FILLER. 020200 03 FILLER PIC X(03) VALUE "AVW". 020210 03 FILLER PIC 9(04) VALUE 1982. 020220 03 FILLER PIC 9(09) VALUE 005640000. 020230 02 FILLER. 020240 03 FILLER PIC X(03) VALUE "AVW". 020250 03 FILLER PIC 9(04) VALUE 1983. 020260 03 FILLER PIC 9(09) VALUE 006000000. 020270 02 FILLER. 020280 03 FILLER PIC X(03) VALUE "AVW". 020290 03 FILLER PIC 9(04) VALUE 1984. 020300 03 FILLER PIC 9(09) VALUE 006240000. 020310 02 FILLER. 020320 03 FILLER PIC X(03) VALUE "AVW". 020330 03 FILLER PIC 9(04) VALUE 1985. 020340 03 FILLER PIC 9(09) VALUE 006480000. 020350 02 FILLER. 020360 03 FILLER PIC X(03) VALUE "AVW". 020370 03 FILLER PIC 9(04) VALUE 1986. 020380 03 FILLER PIC 9(09) VALUE 006720000. 020390 02 FILLER. 020400 03 FILLER PIC X(03) VALUE "AVW". 020410 03 FILLER PIC 9(04) VALUE 1987. 020420 03 FILLER PIC 9(09) VALUE 006840000. 020430 02 FILLER. 020440 03 FILLER PIC X(03) VALUE "AVW". 020450 03 FILLER PIC 9(04) VALUE 1988. 020460 03 FILLER PIC 9(09) VALUE 007200000. 020470 02 FILLER. 020480 03 FILLER PIC X(03) VALUE "AVW". 020490 03 FILLER PIC 9(04) VALUE 1989. 020500 03 FILLER PIC 9(09) VALUE 007320000. 020510 02 FILLER. 020520 03 FILLER PIC X(03) VALUE "AVW". 020530 03 FILLER PIC 9(04) VALUE 1990. 020540 03 FILLER PIC 9(09) VALUE 007560000. 020550 02 FILLER. 020560 03 FILLER PIC X(03) VALUE "AVW". 020570 03 FILLER PIC 9(04) VALUE 1991. 020580 03 FILLER PIC 9(09) VALUE 007800000. 020590 02 FILLER. 020600 03 FILLER PIC X(03) VALUE "AVW". 020610 03 FILLER PIC 9(04) VALUE 1992. 020620 03 FILLER PIC 9(09) VALUE 008160000. 020630 02 FILLER. 020640 03 FILLER PIC X(03) VALUE "AVW". 020650 03 FILLER PIC 9(04) VALUE 1993. 020660 03 FILLER PIC 9(09) VALUE 008640000. 020670 02 FILLER. 020680 03 FILLER PIC X(03) VALUE "AVW". 020690 03 FILLER PIC 9(04) VALUE 1994. 020700 03 FILLER PIC 9(09) VALUE 009120000. 020710 02 FILLER. 020720 03 FILLER PIC X(03) VALUE "AVW". 020730 03 FILLER PIC 9(04) VALUE 1995. 020740 03 FILLER PIC 9(09) VALUE 009360000. 020750 02 FILLER. 020760 03 FILLER PIC X(03) VALUE "AVW". 020770 03 FILLER PIC 9(04) VALUE 1996. 020780 03 FILLER PIC 9(09) VALUE 009600000. 020790 02 FILLER. 020800 03 FILLER PIC X(03) VALUE "AVW". 020810 03 FILLER PIC 9(04) VALUE 1997. 020820 03 FILLER PIC 9(09) VALUE 009840000. 020830 02 FILLER. 020840 03 FILLER PIC X(03) VALUE "AVW". 020850 03 FILLER PIC 9(04) VALUE 1998. 020860 03 FILLER PIC 9(09) VALUE 010080000. 020870 02 FILLER. 020880 03 FILLER PIC X(03) VALUE "AVW". 020890 03 FILLER PIC 9(04) VALUE 1999. 020900 03 FILLER PIC 9(09) VALUE 010200000. 020910 02 FILLER. 020920 03 FILLER PIC X(03) VALUE "AVW". 020930 03 FILLER PIC 9(04) VALUE 2000. 020940 03 FILLER PIC 9(09) VALUE 010320000. 020950 02 FILLER. 020960 03 FILLER PIC X(03) VALUE "AVW". 020970 03 FILLER PIC 9(04) VALUE 2001. 020980 03 FILLER PIC 9(09) VALUE 010440000. 020981 02 FILLER. 020982 03 FILLER PIC X(03) VALUE "AVW". 020983 03 FILLER PIC 9(04) VALUE 2002. 020984 03 FILLER PIC 9(09) VALUE 010440000. 020985 02 FILLER. 020986 03 FILLER PIC X(03) VALUE "AVW". 020987 03 FILLER PIC 9(04) VALUE 2003. 020988 03 FILLER PIC 9(09) VALUE 010440000. 020990 02 FILLER. 021000 03 FILLER PIC X(03) VALUE "AVO". 021010 03 FILLER PIC 9(04) VALUE 1990. 021020 03 FILLER PIC 9(09) VALUE 003240000. 021030 02 FILLER. 021040 03 FILLER PIC X(03) VALUE "AVO". 021050 03 FILLER PIC 9(04) VALUE 1991. 021060 03 FILLER PIC 9(09) VALUE 004080000. 021070 02 FILLER. 021080 03 FILLER PIC X(03) VALUE "AVO". 021090 03 FILLER PIC 9(04) VALUE 1992. 021100 03 FILLER PIC 9(09) VALUE 005760000. 021110 02 FILLER. 021120 03 FILLER PIC X(03) VALUE "AVO". 021130 03 FILLER PIC 9(04) VALUE 1993. 021140 03 FILLER PIC 9(09) VALUE 006360000. 021150 02 FILLER. 021160 03 FILLER PIC X(03) VALUE "AVO". 021170 03 FILLER PIC 9(04) VALUE 1994. 021180 03 FILLER PIC 9(09) VALUE 007080000. 021190 02 FILLER. 021200 03 FILLER PIC X(03) VALUE "AVO". 021210 03 FILLER PIC 9(04) VALUE 1995. 021220 03 FILLER PIC 9(09) VALUE 007680000. 021230 02 FILLER. 021240 03 FILLER PIC X(03) VALUE "AVO". 021250 03 FILLER PIC 9(04) VALUE 1996. 021260 03 FILLER PIC 9(09) VALUE 008160000. 021270 02 FILLER. 021280 03 FILLER PIC X(03) VALUE "AVO". 021290 03 FILLER PIC 9(04) VALUE 1997. 021300 03 FILLER PIC 9(09) VALUE 008520000. 021310 02 FILLER. 021320 03 FILLER PIC X(03) VALUE "AVO". 021330 03 FILLER PIC 9(04) VALUE 1998. 021340 03 FILLER PIC 9(09) VALUE 008400000. 021350 02 FILLER. 021360 03 FILLER PIC X(03) VALUE "AVO". 021370 03 FILLER PIC 9(04) VALUE 1999. 021380 03 FILLER PIC 9(09) VALUE 008640000. 021390 02 FILLER. 021400 03 FILLER PIC X(03) VALUE "AVO". 021410 03 FILLER PIC 9(04) VALUE 2000. 021420 03 FILLER PIC 9(09) VALUE 008520000. 021430 02 FILLER. 021440 03 FILLER PIC X(03) VALUE "AVO". 021450 03 FILLER PIC 9(04) VALUE 2001. 021460 03 FILLER PIC 9(09) VALUE 008760000. 021461 02 FILLER. 021462 03 FILLER PIC X(03) VALUE "AVO". 021463 03 FILLER PIC 9(04) VALUE 2002. 021464 03 FILLER PIC 9(09) VALUE 008760000. 021465 02 FILLER. 021466 03 FILLER PIC X(03) VALUE "AVO". 021467 03 FILLER PIC 9(04) VALUE 2003. 021468 03 FILLER PIC 9(09) VALUE 008760000. 021470 02 FILLER. 021480 03 FILLER PIC X(03) VALUE "KNW". 021490 03 FILLER PIC 9(04) VALUE 1973. 021500 03 FILLER PIC 9(09) VALUE 003360000. 021510 02 FILLER. 021520 03 FILLER PIC X(03) VALUE "KNW". 021530 03 FILLER PIC 9(04) VALUE 1974. 021540 03 FILLER PIC 9(09) VALUE 003720000. 021550 02 FILLER. 021560 03 FILLER PIC X(03) VALUE "KNW". 021570 03 FILLER PIC 9(04) VALUE 1975. 021580 03 FILLER PIC 9(09) VALUE 004030000. 021590 02 FILLER. 021600 03 FILLER PIC X(03) VALUE "KNW". 021610 03 FILLER PIC 9(04) VALUE 1976. 021620 03 FILLER PIC 9(09) VALUE 004560000. 021630 02 FILLER. 021640 03 FILLER PIC X(03) VALUE "KNW". 021650 03 FILLER PIC 9(04) VALUE 1977. 021660 03 FILLER PIC 9(09) VALUE 005040000. 021670 02 FILLER. 021680 03 FILLER PIC X(03) VALUE "KNW". 021690 03 FILLER PIC 9(04) VALUE 1978. 021700 03 FILLER PIC 9(09) VALUE 005520000. 021710 02 FILLER. 021720 03 FILLER PIC X(03) VALUE "KNW". 021730 03 FILLER PIC 9(04) VALUE 1979. 021740 03 FILLER PIC 9(09) VALUE 005760000. 021750 02 FILLER. 021760 03 FILLER PIC X(03) VALUE "KNW". 021770 03 FILLER PIC 9(04) VALUE 1980. 021780 03 FILLER PIC 9(09) VALUE 006120000. 021790 02 FILLER. 021800 03 FILLER PIC X(03) VALUE "KNW". 021810 03 FILLER PIC 9(04) VALUE 1981. 021820 03 FILLER PIC 9(09) VALUE 006480000. 021830 02 FILLER. 021840 03 FILLER PIC X(03) VALUE "KNW". 021850 03 FILLER PIC 9(04) VALUE 1982. 021860 03 FILLER PIC 9(09) VALUE 006960000. 021870 02 FILLER. 021880 03 FILLER PIC X(03) VALUE "KNW". 021890 03 FILLER PIC 9(04) VALUE 1983. 021900 03 FILLER PIC 9(09) VALUE 007320000. 021910 02 FILLER. 021920 03 FILLER PIC X(03) VALUE "KNW". 021930 03 FILLER PIC 9(04) VALUE 1984. 021940 03 FILLER PIC 9(09) VALUE 007680000. 021950 02 FILLER. 021960 03 FILLER PIC X(03) VALUE "KNW". 021970 03 FILLER PIC 9(04) VALUE 1985. 021980 03 FILLER PIC 9(09) VALUE 008040000. 021990 02 FILLER. 022000 03 FILLER PIC X(03) VALUE "KNW". 022010 03 FILLER PIC 9(04) VALUE 1986. 022020 03 FILLER PIC 9(09) VALUE 008280000. 022030 02 FILLER. 022040 03 FILLER PIC X(03) VALUE "KNW". 022050 03 FILLER PIC 9(04) VALUE 1987. 022060 03 FILLER PIC 9(09) VALUE 008520000. 022070 02 FILLER. 022080 03 FILLER PIC X(03) VALUE "KNW". 022090 03 FILLER PIC 9(04) VALUE 1988. 022100 03 FILLER PIC 9(09) VALUE 008760000. 022110 02 FILLER. 022120 03 FILLER PIC X(03) VALUE "KNW". 022130 03 FILLER PIC 9(04) VALUE 1989. 022140 03 FILLER PIC 9(09) VALUE 009000000. 022150 02 FILLER. 022160 03 FILLER PIC X(03) VALUE "KNW". 022170 03 FILLER PIC 9(04) VALUE 1990. 022180 03 FILLER PIC 9(09) VALUE 009360000. 022190 02 FILLER. 022200 03 FILLER PIC X(03) VALUE "KNW". 022210 03 FILLER PIC 9(04) VALUE 1991. 022220 03 FILLER PIC 9(09) VALUE 009600000. 022230 02 FILLER. 022240 03 FILLER PIC X(03) VALUE "KNW". 022250 03 FILLER PIC 9(04) VALUE 1992. 022260 03 FILLER PIC 9(09) VALUE 010080000. 022270 02 FILLER. 022280 03 FILLER PIC X(03) VALUE "KNW". 022290 03 FILLER PIC 9(04) VALUE 1993. 022300 03 FILLER PIC 9(09) VALUE 010680000. 022310 02 FILLER. 022320 03 FILLER PIC X(03) VALUE "KNW". 022330 03 FILLER PIC 9(04) VALUE 1994. 022340 03 FILLER PIC 9(09) VALUE 011280000. 022350 02 FILLER. 022360 03 FILLER PIC X(03) VALUE "KNW". 022370 03 FILLER PIC 9(04) VALUE 1995. 022380 03 FILLER PIC 9(09) VALUE 011520000. 022390 02 FILLER. 022400 03 FILLER PIC X(03) VALUE "KNW". 022410 03 FILLER PIC 9(04) VALUE 1996. 022420 03 FILLER PIC 9(09) VALUE 011760000. 022430 02 FILLER. 022440 03 FILLER PIC X(03) VALUE "KNW". 022450 03 FILLER PIC 9(04) VALUE 1997. 022460 03 FILLER PIC 9(09) VALUE 012120000. 022470 02 FILLER. 022480 03 FILLER PIC X(03) VALUE "KNW". 022490 03 FILLER PIC 9(04) VALUE 1998. 022500 03 FILLER PIC 9(09) VALUE 012360000. 022510 02 FILLER. 022520 03 FILLER PIC X(03) VALUE "KNW". 022530 03 FILLER PIC 9(04) VALUE 1999. 022540 03 FILLER PIC 9(09) VALUE 012480000. 022550 02 FILLER. 022560 03 FILLER PIC X(03) VALUE "KNW". 022570 03 FILLER PIC 9(04) VALUE 2000. 022580 03 FILLER PIC 9(09) VALUE 012720000. 022590 02 FILLER. 022600 03 FILLER PIC X(03) VALUE "KNW". 022610 03 FILLER PIC 9(04) VALUE 2001. 022620 03 FILLER PIC 9(09) VALUE 012840000. 022621 02 FILLER. 022622 03 FILLER PIC X(03) VALUE "KNW". 022623 03 FILLER PIC 9(04) VALUE 2002. 022624 03 FILLER PIC 9(09) VALUE 012840000. 022625 02 FILLER. 022626 03 FILLER PIC X(03) VALUE "KNW". 022627 03 FILLER PIC 9(04) VALUE 2003. 022628 03 FILLER PIC 9(09) VALUE 012840000. 022630 02 FILLER. 022640 03 FILLER PIC X(03) VALUE "KNO". 022650 03 FILLER PIC 9(04) VALUE 1990. 022660 03 FILLER PIC 9(09) VALUE 003240000. 022670 02 FILLER. 022680 03 FILLER PIC X(03) VALUE "KNO". 022690 03 FILLER PIC 9(04) VALUE 1991. 022700 03 FILLER PIC 9(09) VALUE 004080000. 022710 02 FILLER. 022720 03 FILLER PIC X(03) VALUE "KNO". 022730 03 FILLER PIC 9(04) VALUE 1992. 022740 03 FILLER PIC 9(09) VALUE 007080000. 022750 02 FILLER. 022760 03 FILLER PIC X(03) VALUE "KNO". 022770 03 FILLER PIC 9(04) VALUE 1993. 022780 03 FILLER PIC 9(09) VALUE 007800000. 022790 02 FILLER. 022800 03 FILLER PIC X(03) VALUE "KNO". 022810 03 FILLER PIC 9(04) VALUE 1994. 022820 03 FILLER PIC 9(09) VALUE 008760000. 022830 02 FILLER. 022840 03 FILLER PIC X(03) VALUE "KNO". 022850 03 FILLER PIC 9(04) VALUE 1995. 022860 03 FILLER PIC 9(09) VALUE 009360000. 022870 02 FILLER. 022880 03 FILLER PIC X(03) VALUE "KNO". 022890 03 FILLER PIC 9(04) VALUE 1996. 022900 03 FILLER PIC 9(09) VALUE 010080000. 022910 02 FILLER. 022920 03 FILLER PIC X(03) VALUE "KNO". 022930 03 FILLER PIC 9(04) VALUE 1997. 022940 03 FILLER PIC 9(09) VALUE 010440000. 022950 02 FILLER. 022960 03 FILLER PIC X(03) VALUE "KNO". 022970 03 FILLER PIC 9(04) VALUE 1998. 022980 03 FILLER PIC 9(09) VALUE 010320000. 022990 02 FILLER. 023000 03 FILLER PIC X(03) VALUE "KNO". 023010 03 FILLER PIC 9(04) VALUE 1999. 023020 03 FILLER PIC 9(09) VALUE 010560000. 023030 02 FILLER. 023040 03 FILLER PIC X(03) VALUE "KNO". 023050 03 FILLER PIC 9(04) VALUE 2000. 023060 03 FILLER PIC 9(09) VALUE 010440000. 023070 02 FILLER. 023080 03 FILLER PIC X(03) VALUE "KNO". 023090 03 FILLER PIC 9(04) VALUE 2001. 023100 03 FILLER PIC 9(09) VALUE 010800000. 023101 02 FILLER. 023102 03 FILLER PIC X(03) VALUE "KNO". 023103 03 FILLER PIC 9(04) VALUE 2002. 023104 03 FILLER PIC 9(09) VALUE 010800000. 023105 02 FILLER. 023106 03 FILLER PIC X(03) VALUE "KNO". 023107 03 FILLER PIC 9(04) VALUE 2003. 023108 03 FILLER PIC 9(09) VALUE 010800000. 023110 02 FILLER PIC X(37) VALUE HIGH-VALUE. 023120**----------------------------------------- 023130 01 TB-ENTGELT. 023140 02 TB-ELEM OCCURS 299. 023150 03 FILLER. 023160 05 TB-KENN PIC X(03). 023170 05 TB-EG-JAHR PIC 9(04). 023180 05 TB-BBGGRENZE PIC 9(07)V99. 023190 01 H-TB-KENN PIC X(03). 023191 023192 023193 023200**--------ENTGELT-TABELLE FüR EURO--------- 023210 01 TABELLE-ENTGELT-E. 023220 02 FILLER. 023230 03 FILLER PIC X(03) VALUE "AVW". 023240 03 FILLER PIC 9(04) VALUE 1999. 023250 03 FILLER PIC 9(09) VALUE 005215177. 023260 02 FILLER. 023270 03 FILLER PIC X(03) VALUE "AVW". 023280 03 FILLER PIC 9(04) VALUE 2000. 023290 03 FILLER PIC 9(09) VALUE 005276532. 023300 02 FILLER. 023310 03 FILLER PIC X(03) VALUE "AVW". 023320 03 FILLER PIC 9(04) VALUE 2001. 023330 03 FILLER PIC 9(09) VALUE 005337887. 023331** --------------------------------------------------------- 023332** 15-10-2001 Version 25 / 01 023333** --------------------------------------------------------- 023334 02 FILLER. 023335 03 FILLER PIC X(03) VALUE "AVW". 023336 03 FILLER PIC 9(04) VALUE 2002. 023337 03 FILLER PIC 9(09) VALUE 005400000. 023338** --------------------------------------------------------- 023339** 05-11-2002 Version 29 023340** --------------------------------------------------------- 023341 02 FILLER. 023342 03 FILLER PIC X(03) VALUE "AVW". 023343 03 FILLER PIC 9(04) VALUE 2003. 023344 03 FILLER PIC 9(09) VALUE 006120000. 023345 02 FILLER. 023346 03 FILLER PIC X(03) VALUE "AVW". 023347 03 FILLER PIC 9(04) VALUE 2004. 023348 03 FILLER PIC 9(09) VALUE 006180000. 023349 02 FILLER. 023350 03 FILLER PIC X(03) VALUE "AVW". 023351 03 FILLER PIC 9(04) VALUE 2005. 023352 03 FILLER PIC 9(09) VALUE 006240000. 023353 02 FILLER. 023354 03 FILLER PIC X(03) VALUE "AVW". 023355 03 FILLER PIC 9(04) VALUE 2006. 023356 03 FILLER PIC 9(09) VALUE 006300000. 023357 02 FILLER. 023358 03 FILLER PIC X(03) VALUE "AVW". 023359 03 FILLER PIC 9(04) VALUE 2007. 023360 03 FILLER PIC 9(09) VALUE 006300000. 023361 02 FILLER. 023362 03 FILLER PIC X(03) VALUE "AVW". 023363 03 FILLER PIC 9(04) VALUE 2008. 023364 03 FILLER PIC 9(09) VALUE 006300000. 023365 02 FILLER. 023366 03 FILLER PIC X(03) VALUE "AVW". 023367 03 FILLER PIC 9(04) VALUE 2009. 023368 03 FILLER PIC 9(09) VALUE 006300000. 023369 023370 023371 023372 02 FILLER. 023373 03 FILLER PIC X(03) VALUE "AVO". 023374 03 FILLER PIC 9(04) VALUE 1999. 023375 03 FILLER PIC 9(09) VALUE 004417562. 023380 02 FILLER. 023390 03 FILLER PIC X(03) VALUE "AVO". 023400 03 FILLER PIC 9(04) VALUE 2000. 023410 03 FILLER PIC 9(09) VALUE 004356207. 023420 02 FILLER. 023430 03 FILLER PIC X(03) VALUE "AVO". 023440 03 FILLER PIC 9(04) VALUE 2001. 023450 03 FILLER PIC 9(09) VALUE 004478917. 023451** --------------------------------------------------------- 023452** 15-10-2001 Version 25 / 01 023453** --------------------------------------------------------- 023454 02 FILLER. 023455 03 FILLER PIC X(03) VALUE "AVO". 023456 03 FILLER PIC 9(04) VALUE 2002. 023457 03 FILLER PIC 9(09) VALUE 004500000. 023458** --------------------------------------------------------- 023459** 05-11-2002 Version 29 023460** --------------------------------------------------------- 023461 02 FILLER. 023462 03 FILLER PIC X(03) VALUE "AVO". 023463 03 FILLER PIC 9(04) VALUE 2003. 023464 03 FILLER PIC 9(09) VALUE 005100000. 023465 02 FILLER. 023466 03 FILLER PIC X(03) VALUE "AVO". 023467 03 FILLER PIC 9(04) VALUE 2004. 023468 03 FILLER PIC 9(09) VALUE 005220000. 023469 02 FILLER. 023470 03 FILLER PIC X(03) VALUE "AVO". 023471 03 FILLER PIC 9(04) VALUE 2005. 023472 03 FILLER PIC 9(09) VALUE 005280000. 023473 02 FILLER. 023474 03 FILLER PIC X(03) VALUE "AVO". 023475 03 FILLER PIC 9(04) VALUE 2006. 023476 03 FILLER PIC 9(09) VALUE 005280000. 023477 02 FILLER. 023478 03 FILLER PIC X(03) VALUE "AVO". 023479 03 FILLER PIC 9(04) VALUE 2007. 023480 03 FILLER PIC 9(09) VALUE 005460000. 023481 02 FILLER. 023482 03 FILLER PIC X(03) VALUE "AVO". 023483 03 FILLER PIC 9(04) VALUE 2008. 023484 03 FILLER PIC 9(09) VALUE 005460000. 023485 02 FILLER. 023486 03 FILLER PIC X(03) VALUE "AVO". 023487 03 FILLER PIC 9(04) VALUE 2009. 023488 03 FILLER PIC 9(09) VALUE 005460000. 023489 023490 023491 02 FILLER. 023492 03 FILLER PIC X(03) VALUE "KNW". 023493 03 FILLER PIC 9(04) VALUE 1999. 023494 03 FILLER PIC 9(09) VALUE 006380923. 023500 02 FILLER. 023510 03 FILLER PIC X(03) VALUE "KNW". 023520 03 FILLER PIC 9(04) VALUE 2000. 023530 03 FILLER PIC 9(09) VALUE 006503633. 023540 02 FILLER. 023550 03 FILLER PIC X(03) VALUE "KNW". 023560 03 FILLER PIC 9(04) VALUE 2001. 023570 03 FILLER PIC 9(09) VALUE 006564988. 023571** --------------------------------------------------------- 023572** 15-10-2001 Version 25 / 01 023573** --------------------------------------------------------- 023574 02 FILLER. 023575 03 FILLER PIC X(03) VALUE "KNW". 023576 03 FILLER PIC 9(04) VALUE 2002. 023577 03 FILLER PIC 9(09) VALUE 006660000. 023578** --------------------------------------------------------- 023579** 05-11-2002 Version 29 023580** --------------------------------------------------------- 023581 02 FILLER. 023582 03 FILLER PIC X(03) VALUE "KNW". 023583 03 FILLER PIC 9(04) VALUE 2003. 023584 03 FILLER PIC 9(09) VALUE 007500000. 023585 02 FILLER. 023586 03 FILLER PIC X(03) VALUE "KNW". 023587 03 FILLER PIC 9(04) VALUE 2004. 023588 03 FILLER PIC 9(09) VALUE 007620000. 023589 02 FILLER. 023590 03 FILLER PIC X(03) VALUE "KNW". 023591 03 FILLER PIC 9(04) VALUE 2005. 023592 03 FILLER PIC 9(09) VALUE 007680000. 023593 02 FILLER. 023594 03 FILLER PIC X(03) VALUE "KNW". 023595 03 FILLER PIC 9(04) VALUE 2006. 023596 03 FILLER PIC 9(09) VALUE 007740000. 023597 02 FILLER. 023598 03 FILLER PIC X(03) VALUE "KNW". 023599 03 FILLER PIC 9(04) VALUE 2007. 023600 03 FILLER PIC 9(09) VALUE 007740000. 023601 02 FILLER. 023602 03 FILLER PIC X(03) VALUE "KNW". 023603 03 FILLER PIC 9(04) VALUE 2008. 023604 03 FILLER PIC 9(09) VALUE 007740000. 023605 02 FILLER. 023606 03 FILLER PIC X(03) VALUE "KNW". 023607 03 FILLER PIC 9(04) VALUE 2009. 023608 03 FILLER PIC 9(09) VALUE 007740000. 023609 023610 023611 02 FILLER. 023612 03 FILLER PIC X(03) VALUE "KNO". 023613 03 FILLER PIC 9(04) VALUE 1999. 023614 03 FILLER PIC 9(09) VALUE 005399242. 023620 02 FILLER. 023630 03 FILLER PIC X(03) VALUE "KNO". 023640 03 FILLER PIC 9(04) VALUE 2000. 023650 03 FILLER PIC 9(09) VALUE 005337887. 023660 02 FILLER. 023670 03 FILLER PIC X(03) VALUE "KNO". 023680 03 FILLER PIC 9(04) VALUE 2001. 023690 03 FILLER PIC 9(09) VALUE 005521952. 023691** --------------------------------------------------------- 023692** 15-10-2001 Version 25 / 01 023693** --------------------------------------------------------- 023694 02 FILLER. 023695 03 FILLER PIC X(03) VALUE "KNO". 023696 03 FILLER PIC 9(04) VALUE 2002. 023697 03 FILLER PIC 9(09) VALUE 005580000. 023698** --------------------------------------------------------- 023699** 05-11-2002 Version 29 023700** --------------------------------------------------------- 023701 02 FILLER. 023702 03 FILLER PIC X(03) VALUE "KNO". 023703 03 FILLER PIC 9(04) VALUE 2003. 023704 03 FILLER PIC 9(09) VALUE 006300000. 023705 02 FILLER. 023706 03 FILLER PIC X(03) VALUE "KNO". 023707 03 FILLER PIC 9(04) VALUE 2004. 023708 03 FILLER PIC 9(09) VALUE 006420000. 023709 02 FILLER. 023710 03 FILLER PIC X(03) VALUE "KNO". 023711 03 FILLER PIC 9(04) VALUE 2005. 023712 03 FILLER PIC 9(09) VALUE 006480000. 023713 02 FILLER. 023714 03 FILLER PIC X(03) VALUE "KNO". 023715 03 FILLER PIC 9(04) VALUE 2006. 023716 03 FILLER PIC 9(09) VALUE 006480000. 023717 02 FILLER. 023718 03 FILLER PIC X(03) VALUE "KNO". 023719 03 FILLER PIC 9(04) VALUE 2007. 023720 03 FILLER PIC 9(09) VALUE 006660000. 023721 02 FILLER. 023722 03 FILLER PIC X(03) VALUE "KNO". 023723 03 FILLER PIC 9(04) VALUE 2008. 023724 03 FILLER PIC 9(09) VALUE 006660000. 023725 02 FILLER. 023726 03 FILLER PIC X(03) VALUE "KNO". 023727 03 FILLER PIC 9(04) VALUE 2009. 023728 03 FILLER PIC 9(09) VALUE 006660000. 023729 023730 023731 02 FILLER PIC X(37) VALUE HIGH-VALUE. 023732**----------------------------------------- 023733 01 TB-ENTGELT-E. 023734 02 TB-ELEM-E OCCURS 299. 023740 03 FILLER. 023750 05 TB-KENN-E PIC X(03). 023760 05 TB-EG-JAHR-E PIC 9(04). 023770 05 TB-BBGGRENZE-E PIC 9(07)V99. 023771 023772 023773 023780** -------------------------------------- 023790 01 TABELLE-BEZUGSGROESSE. 023791** -------------------------------------- 023800 02 FILLER. 023810 03 FILLER PIC X(03) VALUE "AVW". 023820 03 FILLER PIC 9(04) VALUE 1995. 023830 03 FILLER PIC 9(09) VALUE 004872000. 023840 02 FILLER. 023850 03 FILLER PIC X(03) VALUE "AVW". 023860 03 FILLER PIC 9(04) VALUE 1996. 023870 03 FILLER PIC 9(09) VALUE 004956000. 023880 02 FILLER. 023890 03 FILLER PIC X(03) VALUE "AVW". 023900 03 FILLER PIC 9(04) VALUE 1997. 023910 03 FILLER PIC 9(09) VALUE 005124000. 023920 02 FILLER. 023930 03 FILLER PIC X(03) VALUE "AVW". 023940 03 FILLER PIC 9(04) VALUE 1998. 023950 03 FILLER PIC 9(09) VALUE 005208000. 023960 02 FILLER. 023970 03 FILLER PIC X(03) VALUE "AVW". 023980 03 FILLER PIC 9(04) VALUE 1999. 023990 03 FILLER PIC 9(09) VALUE 005292000. 024000 02 FILLER. 024010 03 FILLER PIC X(03) VALUE "AVW". 024020 03 FILLER PIC 9(04) VALUE 2000. 024030 03 FILLER PIC 9(09) VALUE 005376000. 024040 02 FILLER. 024050 03 FILLER PIC X(03) VALUE "AVW". 024060 03 FILLER PIC 9(04) VALUE 2001. 024070 03 FILLER PIC 9(09) VALUE 005376000. 024071 02 FILLER. 024072 03 FILLER PIC X(03) VALUE "AVW". 024073 03 FILLER PIC 9(04) VALUE 2002. 024074 03 FILLER PIC 9(09) VALUE 005376000. 024075 02 FILLER. 024076 03 FILLER PIC X(03) VALUE "AVW". 024077 03 FILLER PIC 9(04) VALUE 2003. 024078 03 FILLER PIC 9(09) VALUE 005376000. 024080 02 FILLER. 024090 03 FILLER PIC X(03) VALUE "AVO". 024100 03 FILLER PIC 9(04) VALUE 1995. 024110 03 FILLER PIC 9(09) VALUE 003948000. 024120 02 FILLER. 024130 03 FILLER PIC X(03) VALUE "AVO". 024140 03 FILLER PIC 9(04) VALUE 1996. 024150 03 FILLER PIC 9(09) VALUE 004200000. 024160 02 FILLER. 024170 03 FILLER PIC X(03) VALUE "AVO". 024180 03 FILLER PIC 9(04) VALUE 1997. 024190 03 FILLER PIC 9(09) VALUE 004368000. 024200 02 FILLER. 024210 03 FILLER PIC X(03) VALUE "AVO". 024220 03 FILLER PIC 9(04) VALUE 1998. 024230 03 FILLER PIC 9(09) VALUE 004368000. 024240 02 FILLER. 024250 03 FILLER PIC X(03) VALUE "AVO". 024260 03 FILLER PIC 9(04) VALUE 1999. 024270 03 FILLER PIC 9(09) VALUE 004452000. 024280 02 FILLER. 024290 03 FILLER PIC X(03) VALUE "AVO". 024300 03 FILLER PIC 9(04) VALUE 2000. 024310 03 FILLER PIC 9(09) VALUE 004368000. 024320 02 FILLER. 024330 03 FILLER PIC X(03) VALUE "AVO". 024340 03 FILLER PIC 9(04) VALUE 2001. 024350 03 FILLER PIC 9(09) VALUE 004536000. 024351 02 FILLER. 024352 03 FILLER PIC X(03) VALUE "AVO". 024353 03 FILLER PIC 9(04) VALUE 2002. 024354 03 FILLER PIC 9(09) VALUE 004536000. 024355 02 FILLER. 024356 03 FILLER PIC X(03) VALUE "AVO". 024357 03 FILLER PIC 9(04) VALUE 2003. 024358 03 FILLER PIC 9(09) VALUE 004536000. 024360 02 FILLER PIC X(16) VALUE HIGH-VALUE. 024361 024362 024363 024370 01 TB-BEZGR. 024380 02 TB-BZ-ELEM OCCURS 30. 024390 03 FILLER. 024400 05 TB-BZ-KENN PIC X(03). 024410 05 TB-BZ-JAHR PIC 9(04). 024420 05 TB-BZ-GR PIC 9(7)V99. 024421 024422 024423 024424** -------------------------------------- 024430 01 TABELLE-BEZUGSGROESSE-E. 024431** -------------------------------------- 024440 02 FILLER. 024450 03 FILLER PIC X(03) VALUE "AVW". 024460 03 FILLER PIC 9(04) VALUE 1999. 024470 03 FILLER PIC 9(09) VALUE 002705757. 024480 02 FILLER. 024490 03 FILLER PIC X(03) VALUE "AVW". 024500 03 FILLER PIC 9(04) VALUE 2000. 024510 03 FILLER PIC 9(09) VALUE 002748705. 024520 02 FILLER. 024530 03 FILLER PIC X(03) VALUE "AVW". 024540 03 FILLER PIC 9(04) VALUE 2001. 024550 03 FILLER PIC 9(09) VALUE 002748705. 024551** --------------------------------------------------------- 024552** 15-10-2001 Version 25 / 01 024553** --------------------------------------------------------- 024554 02 FILLER. 024555 03 FILLER PIC X(03) VALUE "AVW". 024556 03 FILLER PIC 9(04) VALUE 2002. 024557 03 FILLER PIC 9(09) VALUE 002814000. 024558** --------------------------------------------------------- 024559** 05-11-2002 Version 29 024560** --------------------------------------------------------- 024561 02 FILLER. 024562 03 FILLER PIC X(03) VALUE "AVW". 024563 03 FILLER PIC 9(04) VALUE 2003. 024564 03 FILLER PIC 9(09) VALUE 002856000. 024565 02 FILLER. 024566 03 FILLER PIC X(03) VALUE "AVW". 024567 03 FILLER PIC 9(04) VALUE 2004. 024568 03 FILLER PIC 9(09) VALUE 002898000. 024569 02 FILLER. 024570 03 FILLER PIC X(03) VALUE "AVW". 024571 03 FILLER PIC 9(04) VALUE 2005. 024572 03 FILLER PIC 9(09) VALUE 002898000. 024573 02 FILLER. 024574 03 FILLER PIC X(03) VALUE "AVW". 024575 03 FILLER PIC 9(04) VALUE 2006. 024576 03 FILLER PIC 9(09) VALUE 002940000. 024577 02 FILLER. 024578 03 FILLER PIC X(03) VALUE "AVW". 024579 03 FILLER PIC 9(04) VALUE 2007. 024580 03 FILLER PIC 9(09) VALUE 002940000. 024581 02 FILLER. 024582 03 FILLER PIC X(03) VALUE "AVW". 024583 03 FILLER PIC 9(04) VALUE 2008. 024584 03 FILLER PIC 9(09) VALUE 002940000. 024585 02 FILLER. 024586 03 FILLER PIC X(03) VALUE "AVW". 024587 03 FILLER PIC 9(04) VALUE 2009. 024588 03 FILLER PIC 9(09) VALUE 002940000. 024589 024590 024591 02 FILLER. 024592 03 FILLER PIC X(03) VALUE "AVO". 024593 03 FILLER PIC 9(04) VALUE 1999. 024594 03 FILLER PIC 9(09) VALUE 002276271. 024600 02 FILLER. 024610 03 FILLER PIC X(03) VALUE "AVO". 024620 03 FILLER PIC 9(04) VALUE 2000. 024630 03 FILLER PIC 9(09) VALUE 002233323. 024640 02 FILLER. 024650 03 FILLER PIC X(03) VALUE "AVO". 024660 03 FILLER PIC 9(04) VALUE 2001. 024670 03 FILLER PIC 9(09) VALUE 002319220. 024671** --------------------------------------------------------- 024672** 15-10-2001 Version 25 / 01 024673** --------------------------------------------------------- 024674 02 FILLER. 024675 03 FILLER PIC X(03) VALUE "AVO". 024676 03 FILLER PIC 9(04) VALUE 2002. 024677 03 FILLER PIC 9(09) VALUE 002352000. 024678** --------------------------------------------------------- 024679** 05-11-2002 Version 29 024680** --------------------------------------------------------- 024681 02 FILLER. 024682 03 FILLER PIC X(03) VALUE "AVO". 024683 03 FILLER PIC 9(04) VALUE 2003. 024684 03 FILLER PIC 9(09) VALUE 002394000. 024685 02 FILLER. 024686 03 FILLER PIC X(03) VALUE "AVO". 024687 03 FILLER PIC 9(04) VALUE 2004. 024688 03 FILLER PIC 9(09) VALUE 002436000. 024689 02 FILLER. 024690 03 FILLER PIC X(03) VALUE "AVO". 024691 03 FILLER PIC 9(04) VALUE 2005. 024692 03 FILLER PIC 9(09) VALUE 002436000. 024693 02 FILLER. 024694 03 FILLER PIC X(03) VALUE "AVO". 024695 03 FILLER PIC 9(04) VALUE 2006. 024696 03 FILLER PIC 9(09) VALUE 002478000. 024697 02 FILLER. 024698 03 FILLER PIC X(03) VALUE "AVO". 024699 03 FILLER PIC 9(04) VALUE 2007. 024700 03 FILLER PIC 9(09) VALUE 002520000. 024701 02 FILLER. 024702 03 FILLER PIC X(03) VALUE "AVO". 024703 03 FILLER PIC 9(04) VALUE 2008. 024704 03 FILLER PIC 9(09) VALUE 002520000. 024705 02 FILLER. 024706 03 FILLER PIC X(03) VALUE "AVO". 024707 03 FILLER PIC 9(04) VALUE 2009. 024708 03 FILLER PIC 9(09) VALUE 002520000. 024709 024710 024711 02 FILLER PIC X(16) VALUE HIGH-VALUE. 024712 024713 024714 024715 01 TB-BEZGR-E. 024716 02 TB-BZ-ELEM-E OCCURS 30. 024717 03 FILLER. 024718 05 TB-BZ-KENN-E PIC X(03). 024720 05 TB-BZ-JAHR-E PIC 9(04). 024730 05 TB-BZ-GR-E PIC 9(7)V99. 024731 024732 024733 024740** -------------------------------------- 024750 01 TABELLE-BEITRAGSSATZ. 024751** -------------------------------------- 024760 02 FILLER. 024770 03 FILLER PIC 9(04) VALUE 1992. 024780 03 FILLER PIC 9(05) VALUE 01770. 024790 02 FILLER. 024800 03 FILLER PIC 9(04) VALUE 1993. 024810 03 FILLER PIC 9(05) VALUE 01750. 024820 02 FILLER. 024830 03 FILLER PIC 9(04) VALUE 1994. 024840 03 FILLER PIC 9(05) VALUE 01920. 024850 02 FILLER. 024860 03 FILLER PIC 9(04) VALUE 1995. 024870 03 FILLER PIC 9(05) VALUE 01860. 024880 02 FILLER. 024890 03 FILLER PIC 9(04) VALUE 1996. 024900 03 FILLER PIC 9(05) VALUE 01920. 024910 02 FILLER. 024920 03 FILLER PIC 9(04) VALUE 1997. 024930 03 FILLER PIC 9(05) VALUE 02030. 024940 02 FILLER. 024950 03 FILLER PIC 9(04) VALUE 1998. 024960 03 FILLER PIC 9(05) VALUE 02030. 024970 02 FILLER. 024980 03 FILLER PIC 9(04) VALUE 1999. 024990 03 FILLER PIC 9(05) VALUE 02030. 025000 02 FILLER. 025010 03 FILLER PIC 9(04) VALUE 2000. 025020 03 FILLER PIC 9(05) VALUE 01930. 025021 02 FILLER. 025022 03 FILLER PIC 9(04) VALUE 2001. 025023 03 FILLER PIC 9(05) VALUE 01910. 025024 02 FILLER. 025025 03 FILLER PIC 9(04) VALUE 2002. 025026 03 FILLER PIC 9(05) VALUE 01910. 025027** --------------------------------------------------------- 025028** 15-10-2001 Version 25 / 01 025029** --------------------------------------------------------- 025030 02 FILLER. 025031 03 FILLER PIC 9(04) VALUE 2003. 025032 03 FILLER PIC 9(05) VALUE 01950. 025033** --------------------------------------------------------- 025034** 05-11-2002 Version 29 025035** --------------------------------------------------------- 025036 02 FILLER. 025037 03 FILLER PIC 9(04) VALUE 2004. 025038 03 FILLER PIC 9(05) VALUE 01950. 025039 02 FILLER. 025040 03 FILLER PIC 9(04) VALUE 2005. 025041 03 FILLER PIC 9(05) VALUE 01950. 025042 02 FILLER. 025043 03 FILLER PIC 9(04) VALUE 2006. 025044 03 FILLER PIC 9(05) VALUE 01950. 025045 02 FILLER. 025046 03 FILLER PIC 9(04) VALUE 2007. 025047 03 FILLER PIC 9(05) VALUE 01990. 025048 02 FILLER PIC X(09) VALUE HIGH-VALUE. 025049 025050 025051 025052 01 TB-BEITS. 025053 02 TB-BEITS-ELEM OCCURS 20. 025060 03 FILLER. 025070 05 TB-BTS-JAHR PIC 9(04). 025080 05 TB-BTS-BEITS PIC 9(05). 003609*COPY DDBVR030. 025100**---------------------------------------------------------------- 025110** COPY-MEMBER : DDBVR030 025120** PROGRAMMIERER : WERNER KRAUS 025130** ERSTELLUNGSDATUM : 24.03.1998 025140** VERSION : 001 (PGM-NEUERSTELLUNG) 025150** FUNKTION : DATENDEF. FüR CDBVR030 025160**---------------------------------------------------------------- 025161** PROGRAMMIERER : MICHAEL KLEMKE 025162** ERSTELLUNGSDATUM : 24.10.2003 025163** VERSION : 002 025165**---------------------------------------------------------------- 025166** PROGRAMMIERER : MICHAEL KLEMKE 025167** ERSTELLUNGSDATUM : 13.10.2004 025168** VERSION : 003 / 41 025169**---------------------------------------------------------------- 025170** ZULäSSIGE BEREICHSNUMMERN 025180 01 BRNR-TAB PIC 99. 025190 88 BRNR-OK VALUES 02 THRU 04, 08 THRU 21, 23 THRU 26, 025200 28, 29, 38, 39, 42 THRU 44, 48 THRU 61, 025201** -------------------------------------------- 025202** ÄNDERUNG VOM 24.10.2003 / VERSION 36 025203** -------------------------------------------- 025204 40, 025205** -------------------------------------------- 025206** ÄNDERUNG VOM 13.10.2004 / VERSION 41 025207** -------------------------------------------- 025208 00, 025209** -------------------------------------------- 025210 63 THRU 66, 68, 69, 78 THRU 82, 89. 003610*COPY DDBEZ020. 025230**---------------------------------------------------------------- 025240** COPY-MEMBER : DDBEZ020 025250** PROGRAMMIERER : WERNER KRAUS 025260** ERSTELLUNGSDATUM : 07.04.1998 025270** VERSION : 001 (PGM-NEUERSTELLUNG) 025280** FUNKTION : DATENDEFINITIONEN FüR DBEZ020 025290**---------------------------------------------------------------- 025292** PROGRAMMIERER : GERTRAUD SCHUHMACHER 025293** ÄNDERUNG : 002 VOM 10.01.2001 VERSION 22 025300**---------------------------------------------------------------- 025301** PROGRAMMIERER : MICHAEL KLEMKE 025302** ÄNDERUNG : 003 VOM 04.11.2002 VERSION 29 025303**---------------------------------------------------------------- 025304** PROGRAMMIERER : MICHAEL KLEMKE 025305** ÄNDERUNG : 004 VOM 24.02.2003 VERSION 31 025306**---------------------------------------------------------------- 025307** PROGRAMMIERER : MICHAEL KLEMKE 025308** ÄNDERUNG : 005 VOM 13.10.2004 VERSION 41 025309**---------------------------------------------------------------- 025310** HILFSTAB ZUR PRüFUNG LEISTUNGSART 025320**---------------------------------------------------------------- 025330 01 LEAT-TAB PIC 9(2). 025340 88 LEAT-OK VALUES 00 THRU 04, 06, 07, 09, 025350 21 THRU 23, 25 THRU 33, 025351 40 THRU 44, 025352 50. 025360**---------------------------------------------------------------- 025370** HILFSTAB ZUR PRüFUNG LEISTUNGSART KRANKENKASSEN 025380**---------------------------------------------------------------- 025390 01 LEATKK-TAB PIC 9(2). 025400 88 LEATKK-OK VALUES 00, 01, 04, 07. 025410**---------------------------------------------------------------- 025420** HILFSTAB ZUR PRüFUNG LEISTUNGSART BA 025430**---------------------------------------------------------------- 025440 01 LEATBA-TAB PIC 9(2). 025450 88 LEATBA-OK VALUES 21 THRU 23, 025460 25, 025470 27 THRU 33, 025480 40 THRU 44, 025490 50. 003611*COPY DDBNA040. 025470**---------------------------------------------------------------- 025480** COPY-MEMBER : DDBNA040 025490** PROGRAMMIERER : WERNER KRAUS 025500** ERSTELLUNGSDATUM : 05.05.1998 025510** VERSION : 001 (PGM-NEUERSTELLUNG) 025520** FUNKTION : ALLGEMEINE DATENDEFINITIONEN FüR VORSATZ- 025530** WöRTER 025540**---------------------------------------------------------------- 025541** PROGRAMMIERER : GERTRAUD SCHUHMACHER 025542** ÄNDERUNG : 001 VOM 15.11.2000 025543** NEU : AUFM 025544**---------------------------------------------------------------- 025545** PROGRAMMIERER : MICHAEL KLEMKE 025546** ÄNDERUNG : 002 VOM 03.11.2005 / VERSION 50 025548**---------------------------------------------------------------- 025549** PROGRAMMIERER : MICHAEL KLEMKE 025550** ÄNDERUNG : 003 VOM 23.04.2007 / VERSION 62 025551**---------------------------------------------------------------- 025560** HILFSTAB ZUR PRüFUNG VORSATZWöRTER 025570**---------------------------------------------------------------- 025580 01 VOSA-TAB PIC X(20). 025590 88 VOSA-OK VALUES "A", "AAN DE", "AAN DEN", "AL", "AM", "AUFF", 025600 "AAN", "AN", "AN DER", "AUF", "AUF DEM", 025610 "AUF DER", "AUF M", "AUFF M", "AUS DEM", 025620 "AUFM", "AUS" "AUS DEN", "AUS DER", 025621 "B", "BE", "BEI", 025630 "BEI DER", "BEIM", "BEN", "BEY", "BEY DER", 025640 "CHE", "CID", "D", "D.", "D'", "DA", 025650 "DA COSTA", "DA LAS", "DA SILVA", "DAL", 025660 "DALL", "DALL'", "DALLA", "DALLE", "DALLO", 025670 "DAS", "DE", "DEGLI", "DEI", "DEN", "DE L'", 025680 "DE LA", "DE LAS", "DE LE", "DEL", "DEL COZ", 025690 "DELI", "DELL", "DELLA", "DELLE", "DELLI", 025700 "DELLO", "DER", "DES", "DI", "DIT", "DO", 025710 "DO CEU", "DON", "DOS", "DOS SANTOS", "DU", 025720 "DY", "EL", "G", "GEN", "GIL", "GLI", 025730 "GROSSE", 025740 "GROßE", "I", "IM", "IN", "IN DE", "IN DEN", 025750 "IN DER", "IN HET", "IN'T", "KL", "KLEINE", 025760 "L", "L.", "L'", "LA", "LE", "LEE", "LI", 025770 "LO", "M", "MC", "MAC", "N", "O", "O'", 025780 "OP", "OP TE", 025790 "OP DE", "OP DEN", "OP GEN", "OP HET", 025800 "OP TEN", "PLA", "PRO", "S", "ST.", "T", 025810 "TE", "ST", 025820 "TEN", "TER", "THI", "THO", "THOM", "THOR", 025830 "THUM", "TO", "TOM", "TOR", "TU", "TUM", 025840 "UNTEN", "UNTER", "UNTERM", "V.", "V.D.", 025850 "V.DEM", "V.DEN", "V.DER", "V.D", "V.DEM", 025860 "V.DEN", "V.DER", "VAN", "VAN DE", "VAN DEM", 025870 "VAN DEN", "VAN DER", "VANDE", "VANDEM", 025880 "VANDEN", "VANDER", "VAN GEN", "VAN HET", 025890 "VAN T", "VEN", "VO", "VOM", "VOM UND ZU", 025900 "VON", "VON UND ZU", "VON UND ZU DER", 025910 "VON UND ZUR", "VON DE", "VON DEM", "V", 025920 "VON DER", "VON LA", "VON ZU", "VON ZUM", 025930 "VON ZUR", "VONDE", "VONDEN", "VONDEM", 025940 "VONDER", "VON DEN", "VEN DER", "VER", 025950 "VON EINEM", "VON MAST", "VOR", "VOR DEM", 025960 "VOR DEN", "VOR DER", "VORM", "VORN", "Y", 025970 "Y DEL", "ZU", "ZUM", "ZUR", "DON LE" 025980** -------------------------------------- 025990** AENDERUNG VOM 23.04.2007 026000** -------------------------------------- 026100 "OUDE". 003612*COPY DDBNA060. 025990**---------------------------------------------------------------- 026000** COPY-MEMBER : DDBNA060 026010** PROGRAMMIERER : WERNER KRAUS 026020** ERSTELLUNGSDATUM : 05.05.1998 026030** VERSION : 001 (PGM-NEUERSTELLUNG) 026040** FUNKTION : ALLGEMEINE DATENDEFINITIONEN FüR Vorsatz- 026050** wörter 026060**---------------------------------------------------------------- 026061** PROGRAMMIERER : MICHAEL KLEMKE 026062** ERSTELLUNGSDATUM : 05.11.2002 026063** VERSION : 002 (VERSION 29) 026070**---------------------------------------------------------------- 026071** PROGRAMMIERER : MICHAEL KLEMKE 026072** ERSTELLUNGSDATUM : 03.11.2005 026073** VERSION : 003 (VERSION 50) 026074**---------------------------------------------------------------- 026075** PROGRAMMIERER : MICHAEL KLEMKE 026076** ERSTELLUNGSDATUM : 16.10.2006 026077** VERSION : 004 (VERSION 56) 026078**---------------------------------------------------------------- 026079** PROGRAMMIERER : MICHAEL KLEMKE 026080** ERSTELLUNGSDATUM : 23.04.2007 026081** VERSION : 005 (VERSION 62) 026082**---------------------------------------------------------------- 026083** HILFSTAB ZUR PRüFUNG vorsatzwörter 026090**---------------------------------------------------------------- 026100 01 NAZU-TAB PIC X(20). 026110 88 NAZU-OK VALUES "BAR", "BARON", "BARONESSE", "BARONIN", 026120 "BARONESS", "BURGGRAF", 026121 "BURGGRÄFIN", "FREIFRÄULEIN", 026122 "BRAND", "CONDESA", "EARL", "EDLE", 026130 "EDLER", "ERBGRAF", "ERBPRINZ", "FFR", 026140 "FREIFR", "FREIH", "FREIHERR", "FREIIN", 026150 "FRF", "FRF.", "FRFR", "FRFR.", "FRH", 026160 "FRH.", "FRHR", "FRHR.", "FST", "FST.", 026170 "FSTN", "FSTN.", "FÜRST", "FÜRSTIN", "GR", 026171 "FUERST", "FUERSTIN", "GRAEFIN", 026180 "GRAF", "GRÄFIN", "GRF", "GRFN", 026190 "GROSSHERZOG", "GROSSHERZOGIN", "HERZOG", 026200 "HERZOGIN", "JHR", "JHR.", "JONKHEER", 026210 "JUNKER", "LANDGRAF", "LANDGRÄFIN", 026211 "LANDGRAEFIN", 026220 "MARQUES", "MARQUIS", "MARSCHALL", "OSTOJA", 026230 "PRINZ", "PRINZESSIN", "PRZIN", "RABE", 026240 "REICHSGRAF", "REICHSGRÄFIN", "RITTER", "RR", 026250 "TRUCHSESS", "FREIFRAU", "REICHSGRAEFIN", 026260 "TRUCHSEß", "GROßHERZOG", "GROßHERZOGIN", 026270 "ERBGRÄFIN", "ERBPRINZESSIN", 026280 "MARKGRAF", "MARKGRÄFIN" 026290** --------------------------------------------- 026300** AENDERUNG VOM 23.04.2007 026400** --------------------------------------------- 026500 "BURGGRAEFIN", "ERBGRAEFIN", 026600 "FREIFRAEULEIN", "MARKGRAEFIN". 003613*COPY DDBGB140. 026270**---------------------------------------------------------------- 026280** COPY-MEMBER : DCDBNA140 026290** PROGRAMMIERER : WERNER KRAUS 026300** ERSTELLUNGSDATUM : 05.05.1998 026310** VERSION : 001 (PGM-NEUERSTELLUNG) 026320** FUNKTION : ALLGEMEINE DATENDEFINITIONEN FüR Vorsatz- 026330** wörter 026340**---------------------------------------------------------------- 026350**---------------------------------------------------------------- 026360** RECHENFELDER ZUR PRüFFZIFFERBERECHNUNG 026370**---------------------------------------------------------------- 026380**---------------------------------------------------------------- 026390** HILFSTAB ZUR PRüFUNG vorsatzwörter 026400**---------------------------------------------------------------- 026410 01 GBOT-TAB PIC X(20). 026420 88 GBOT-NOT-OK VALUES "OHNE", "UNBEKANNT", "RENTE", 026430 "BEITRAG", "GESUNDHEIT", "HANDWERKER", 026440 "RTZE-VSNR", "FEHLT", "XXX", "DDD", 026450 "OHNE ANGABE", "OHNE ANGABEN". 003690** -------------------------------------------------------------- 003691** SCHALTER FÜR PGM-VERSION AUSGEBEN 003692** -------------------------------------------------------------- 003693 01 WEICHE PIC X VALUE SPACE. 003700** 003710** ------------------------------------------------------------- 003720** RECHENFELDER 003730** ------------------------------------------------------------- 003740 01 FILLER. 003750 05 LAENGE PIC 9(05). 003760 05 LAE-DB PIC 9(05). 003790 05 VON PIC 9(05). 003791 05 IX PIC 9(05). 003792 05 L PIC 9(05). 003793 05 M PIC 9(05). 003794 05 HF-MERKMALE PIC X(11) VALUE "J ". 003795 003796** ------------------------------------------------------------- 003797** TABELLE DER DATENBAUSTEINE MIT LAENGENANGABE FÜR DSME 003798** ACHTUNG: DBRG-SATZ = 29987 DTSZ-LÄNGE 003799** ------------------------------------------------------------- 003800 01 TABINHALTDSME. 003801 05 FILLER PIC X(10) VALUE "DSME 00190". 003802 05 FILLER PIC X(10) VALUE "DBME 00046". 003803 05 FILLER PIC X(10) VALUE "DBNA 00125". 003804 05 FILLER PIC X(10) VALUE "DBGB 00117". 003805 05 FILLER PIC X(10) VALUE "DBAN 00133". 003806 05 FILLER PIC X(10) VALUE "DBEU 00027". 003807 05 FILLER PIC X(10) VALUE "DBSO 00015". 003808 05 FILLER PIC X(10) VALUE "DBKS 00220". 003809 05 FILLER PIC X(10) VALUE "DBSV 00005". 003810 05 FILLER PIC X(10) VALUE "DBVR 00020". 003811 05 FILLER PIC X(10) VALUE "DBRG 00208". 003812 003813 01 FILLER REDEFINES TABINHALTDSME. 003814 05 FILLER OCCURS 11 TIMES. 003815 10 DSME-DBNAME PIC X(04). 003816 10 FILLER PIC X(01). 003817 10 DSME-DBLG PIC 9(05). 003818 003819** ------------------------------------------------------------- 003820** TABELLE DER DATENBAUSTEINE MIT LAENGENANGABE FÜR DSAE 003821** ------------------------------------------------------------- 003822 01 TABINHALTDSAE. 003823 05 FILLER PIC X(10) VALUE "DSAE 00190". 003824 05 FILLER PIC X(10) VALUE "DBAZ 00023". 003825 05 FILLER PIC X(10) VALUE "DBEZ 00041". 003826 003827 01 FILLER REDEFINES TABINHALTDSAE. 003828 05 FILLER OCCURS 3 TIMES. 003829 10 DSAE-DBNAME PIC X(04). 003830 10 FILLER PIC X(01). 003831 10 DSAE-DBLG PIC 9(05). 003834 003835 003836 003850****************************************************************** 003900** HILFSFELDER 004000****************************************************************** 004100 01 HILFSFELDER. 004200 05 SUCHBEGR PIC X(04) VALUE SPACES. 004300 05 HDATUM. 004400 10 HDATJHJJ PIC 9(04). 004500 10 HDATMM PIC 9(02). 004600 10 HDATTT PIC 9(02). 004700 05 H-FEHLER. 004800 10 H-KE PIC X(4). 004900 10 H-FNR PIC X(3). 005000** 005100 05 EIN-LAENGE1 PIC X(6). 005200 05 SATZLG REDEFINES EIN-LAENGE1 PIC 9(6). 005300 05 RC-SAVE PIC 9(4). 005400 05 HFELD-LG PIC 9(5) VALUE ZERO. 005500 05 SIC-GEB PIC 9(8). 005510 05 HFELD-GEB. 005600 10 HFELD-GEB-JHJJMM. 005700 15 HFELD-GEB-JH-JJ. 005800 20 HFELD-GEB-JH PIC 9(02). 005900 20 HFELD-GEB-JJ PIC 9(02). 006000 15 HFELD-GEB-JHJJ REDEFINES 006100 HFELD-GEB-JH-JJ PIC 9(04). 006200 15 HFELD-GEB-MM PIC 9(02). 006300 10 HFELD-GEB-TT PIC 9(02). 006310 05 HF-GEB-JHJJ-2 PIC 9(4). 006400 05 HFELD-VD. 006500 10 HFELD-VD-JHJJ. 006600 15 HFELD-VD-JH PIC 9(02). 006700 15 HFELD-VD-JJ PIC 9(02). 006800 10 HFELD-VD-JHJJN REDEFINES 006900 HFELD-VD-JHJJ PIC 9(04). 007000 10 HFELD-VD-MM PIC 9(02). 007100 10 HFELD-VD-TT PIC 9(02). 007200 05 HFELD-FE PIC X(2). 007300 05 HFELD-S PIC 9(1) VALUE 0. 007400 05 HFELD-KE-NEU PIC X(4). 007500 05 HFELD-KE-ALT PIC X(4). 007600 05 HFELD-KE-SAVE PIC X(4). 007700 05 HFELD-P-GBDT PIC X. 007800 05 HFELD-P-EG PIC X. 007900 05 HFELD-P-BY PIC X. 008000 05 HFELD-WG PIC X. 008001 05 HFELD-ALPHA-Z PIC 9(02). 008002 05 H-LAENGE PIC 9(5). 008003 05 DBRGLG PIC 9(5). 008004 05 AKTLG PIC 9(02). 008005 05 HFELD-LG3 PIC X(03). 008006 05 HFELD-LG3-NUM REDEFINES HFELD-LG3 PIC 9(03). 008007 05 HFELD-PRUEF PIC X(40). 008008 05 I-IND PIC 9(3). 008009 05 HFELD-BE. 008010 10 HFELD-BE-JHJJ. 008011 15 HFELD-BE-JH PIC 9(02). 008012 15 HFELD-BE-JJ PIC 9(02). 008013 10 HFELD-BE-MT. 008014 15 HFELD-BE-MM PIC 9(02). 008015 15 HFELD-BE-TT PIC 9(02). 008016 05 HFELD-BE-R PIC 9(4). 008017 05 HFELD-EN. 008018 10 HFELD-EN-JHJJ. 008019 15 HFELD-EN-JH PIC 9(02). 008020 15 HFELD-EN-JJ PIC 9(02). 008021 10 HFELD-EN-MT. 008022 15 HFELD-EN-MM PIC 9(02). 008023 15 HFELD-EN-TT PIC 9(02). 008024 05 HFELD-EG PIC 9(06). 008025 05 HFELD-OST-WEST PIC X(01). 008026 05 HFELD-PERSGR PIC 9(03). 008027 05 HFELD-VSTR PIC X(02). 008028 05 HFELD-BBNRVU-1-3 PIC X(03). 008029 05 HFELD-TAGE PIC 9(03)V99. 008030 05 HFELD-JBBG PIC 9(7)V99. 008031 05 HFELD-BBG PIC 9(7)V99. 008032 05 HFELD-BBG-DM PIC 9(7). 008033 05 HFELD-P-BBG PIC X. 008034 05 HFELD-BS PIC 9(05). 008035 05 HFELD-BS-R PIC 9(03)V9999. 008036 05 HFELD-BY PIC 9(07)V99. 008037 05 HFELD-BYN PIC 9(07). 008038 05 HFELD-BYNK REDEFINES HFELD-BYN PIC 9(5)V99. 008039 05 HFELD-KENN PIC X(04). 008040 05 HFELD-LEAT PIC 9(02). 008041 05 HFELD-ANZ-MO PIC 9(02). 008042 05 HFELD-BREAK PIC 9(01). 008043 05 SCHALTJ PIC X(01). 008044 05 RFELD1 PIC 9(04). 008045 05 REST1 PIC 9(04). 008046 05 MON-ANF PIC 9. 008047 05 MON-END PIC 9. 008048 05 BE-MO-TAGE PIC 9(02). 008049 05 EN-MO-TAGE PIC 9(02). 008050**---------------------------------------------------------------- 008051** FEHLERTABELLE 008052**---------------------------------------------------------------- 008054 01 H-FENR-TAB. 008060 05 H-FENR-ELEM OCCURS 9. 008070 10 H-FENR PIC X(7). 008071 01 H-FENR-ANZ PIC 99. 008072 01 H-FENR-SAVE PIC 99. 008073 01 H-FENR-SAVE-R REDEFINES H-FENR-SAVE. 008074 05 H-FENR-SAVE-1 PIC 9. 008075 05 H-FENR-SAVE-2 PIC 9. 008076 01 H-HINW-TAB. 008077 05 H-HINW-ELEM OCCURS 9. 008078 10 H-HINW PIC X(7). 008079 01 H-HINW-ANZ PIC 99. 008080**---------------------------------------------------------------- 008081** ZULAESSIGE KENNUNGEN 008082**---------------------------------------------------------------- 008084 01 DSME-KENN PIC X(5). 008085 88 DSME-KENN-OK VALUE 008086 "AGDEU", "KVDEU", "KVTRV", "RVTKV", "BATRV", "RVTBA", 008087 "BWTRV", "RVTBW", "BZTRV", "RVTBZ", "PVTRV", "RVTPV", 008088 "KSTRV", "RVTKS", "KSTKV", "KVTKS", 008089 "WLTKV", "KVTWL", "BFTDS", "DSTBF", 008090** ------------------------------------------------------------- 008091** ÄNDERUNG VOM 20.10.2003 / VERSION 36 008092** ------------------------------------------------------------- 008093 "ZFTRV", "RVTZF", 008094** ------------------------------------------------------------- 008095** ÄNDERUNG VOM 06.12.2004 / VERSION 42 008096** ------------------------------------------------------------- 008097 "KTTRV", "RVTKT", 008098** ------------------------------------------------------------- 008099** ÄNDERUNG VOM 09.01.2006 / VERSION 52 008100** ------------------------------------------------------------- 008101 "BDTKV", "KVTBD". 008102 008103 008104** ------------------------------------------------------------- 008105 01 DSAE-KENN PIC X(5). 008106 88 DSAE-KENN-OK VALUE 008107 "KVTRV", "BATRV", "RVTBA", 008108 "DSTBF", "SOTBF", "UETBF", "KVTWL", "BFTDS", 008109** ------------------------------------------------------------- 008110** ÄNDERUNG VOM 06.12.2004 / VERSION 42 008111** ------------------------------------------------------------- 008112 "KTTRV", "RVTKT". 008113** 008114** ------------------------------------------------------------- 008115 01 DSKO-KENN PIC X(5). 008116 88 DSKO-KENN-OK VALUE 008117 "AGDEU", "KVDEU", "WLTKV", "KVTWL", "KVTRV", "RVTKV". 008118** 008119**---------------------------------------------------------------- 008120** RECHENFELDER 008121**---------------------------------------------------------------- 008122 01 RECHENFELDER. 008123 05 GLAENGE PIC 9(03) VALUE ZERO. 008124 05 ZIFF-Z PIC 9(02). 008125 008126 008127**---------------------------------------------------------------- 008128** Steuerleiste 008129**---------------------------------------------------------------- 008130 01 ST-GES. 008131 05 ST-KE PIC X(04). 008132 88 ST-DSME VALUE "DSME". 008133 88 ST-DSAE VALUE "DSAE". 008134 88 ST-DSQU VALUE "DSQU". 008135 88 ST-DSKO VALUE "DSKO". 008136 05 ST-VF PIC X(05). 008137 88 ST-DEUEV VALUE "DEUEV". 008138 88 ST-KVNR VALUE "KVNR ". 008139 05 FILLER PIC X(52). 008140 05 ST-FEKZ PIC X(01). 008141 05 ST-FEKZ-NUM REDEFINES 008142 ST-FEKZ PIC 9(01). 008143 05 ST-FEAN PIC X(01). 008144 05 ST-FEAN-NUM REDEFINES 008145 ST-FEAN PIC 9(01). 008146 05 FILLER PIC X(127). 008147****************************************************************** 008148** Gültige OP-Codes 008149****************************************************************** 008150 01 OPCOD PIC X(05). 008151 88 OP-AGDEU VALUE "AGDEU". 008152 88 OP-BATRV VALUE "BATRV". 008153 88 OP-BFTDS VALUE "BFTDS". 008155 88 OP-BWTRV VALUE "BWTRV". 008156 88 OP-BZTRV VALUE "BZTRV". 008157 88 OP-DSTBF VALUE "DSTBF". 008159 88 OP-KSTKV VALUE "KSTKV". 008160 88 OP-KSTRV VALUE "KSTRV". 008161 88 OP-KVDEU VALUE "KVDEU". 008162 88 OP-KVTRV VALUE "KVTRV". 008163 88 OP-KVTWL VALUE "KVTWL". 008164 88 OP-PVTRV VALUE "PVTRV". 008165 88 OP-RVTBA VALUE "RVTBA". 008166 88 OP-RVTKV VALUE "RVTKV". 008167 88 OP-SOTBF VALUE "SOTBF". 008169 88 OP-WLTKV VALUE "WLTKV". 008170 88 OP-UETBF VALUE "UETBF". 008171** ------------------------------------------------------------ 008172** ÄNDERUNG VOM 20.10.2003 / VERSION 36 008173** ------------------------------------------------------------ 008174 88 OP-ZFTRV VALUE "ZFTRV". 008175 88 OP-RVTZF VALUE "RVTZF". 008176 88 OP-KTTRV VALUE "KTTRV". 008177 88 OP-RVTKT VALUE "RVTKT". 008178 008179 008180**--------------------------------------------------------------- 008181** ARBEITSBEREICH (WORKDSME) 008182**--------------------------------------------------------------- 008183 01 WORKDSME. 008184*COPY DUCDSME1 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDSME 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DTSZ-BESCHREIBUNG "DSME" 001520** : ANMELDUNG ABMELDUNG/JAHRESMELDUNG, 001530** : ÄNDERUNGSMELDUNG; VERGABE UND RÜCK- 001540** : MELDUNG EINER VERSICHERUNGSNUMMER 001541** : 001550** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001800** ÄNDERUNG : 001 VOM 15.11.2000 001810**---------------------------------------------------------------- 001820** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001830** ÄNDERUNG : 002 VOM 30.04.2001 VERSION 24 001900**---------------------------------------------------------------- 002000** PROGRAMMIERER : MICHAEL KLEMKE 002100** ÄNDERUNG : 003 VOM 13.12.2001 VERSION 26 NACHGANG 03 002200**---------------------------------------------------------------- 002300** PROGRAMMIERER : MICHAEL KLEMKE 002400** ÄNDERUNG : 004 VOM 13.05.2003 VERSION 33 002500**---------------------------------------------------------------- 007995 05 E1-DUCDSME. 008000 10 E1-KE PIC X(04). 008001 10 E1-VF PIC X(05). 008002 10 E1-BBNRAB PIC X(15). 008003 10 E1-BBNRAB-NUM REDEFINES 008004 E1-BBNRAB. 008005 15 E1-BBNRAB-NUM-1-8. 008006 20 E1-BBNRAB-NUM-1-7 PIC 9(07). 008007 20 E1-BBNRAB-NUM-8 PIC 9(01). 008008 15 E1-BBNRAB-NUM-15 PIC 9(07). 008009 10 E1-BBNREP PIC X(15). 008010 10 E1-BBNREP-NUM REDEFINES 008011 E1-BBNREP. 008012 15 E1-BBNREP-NUM-1-8. 008013 20 E1-BBNREP-NUM-1-7 PIC 9(07). 008014 20 E1-BBNREP-NUM-8 PIC 9(01). 008015 15 E1-BBNREP-NUM-15 PIC 9(07). 008016 10 E1-VERNR PIC X(02). 008017 10 E1-VERNR-NUM REDEFINES 008018 E1-VERNR PIC 9(02). 008019 10 E1-ED PIC X(20). 008020 10 E1-ED-NUM REDEFINES 008021 E1-ED. 008022 15 E1-HDAT. 008023 20 E1-HJH PIC 9(02). 008024 20 E1-HJJ PIC 9(02). 008025 20 E1-HMM PIC 9(02). 008026 20 E1-HTT PIC 9(02). 008027 15 E1-HUHR. 008028 20 E1-HSTD PIC 9(02). 008029 20 E1-HMIN PIC 9(02). 008030 20 E1-HSEK PIC 9(02). 008031 15 E1-HMSEC PIC 9(06). 008032 10 E1-FEKZ PIC X(01). 008033 10 E1-FEKZ-NUM REDEFINES 008034 E1-FEKZ PIC 9(01). 008035 10 E1-FEAN PIC X(01). 008036 10 E1-FEAN-NUM REDEFINES 008037 E1-FEAN PIC 9(01). 008038 10 E1-VSNR PIC X(12). 008039 10 E1-VSTR PIC X(02). 008040 10 E1-BBNRVU PIC X(15). 008041 10 E1-BBNRVU-NUM REDEFINES 008042 E1-BBNRVU. 008043 15 E1-BBNRVU-NUM-1-8. 008044 20 E1-BBNRVU-NUM-1-7 PIC 9(07). 008045 20 E1-BBNRVU-NUM-8 PIC 9(01). 008046 15 E1-BBNRVU-NUM-15 PIC 9(07). 008050 10 E1-AZ-VU PIC X(20). 008051 10 E1-AZ-VU-NUM REDEFINES 008052 E1-AZ-VU. 008053 15 E1-AZ-VU-NUM1 PIC 9(08). 008054 15 E1-AZ-VU-NUM2 PIC X. 008055 15 E1-AZ-VU-NUM3 PIC 9(06). 008056 15 E1-AZ-VU-NUM4 PIC X(05). 008060 10 E1-BBNRKK PIC X(15). 008061 10 E1-BBNRKK-NUM REDEFINES 008062 E1-BBNRKK. 008063 15 E1-BBNRKK-NUM-1-8. 008064 20 E1-BBNRKK-NUM-1-7 PIC 9(07). 008065 20 E1-BBNRKK-NUM-8 PIC 9(01). 008066 15 E1-BBNRKK-NUM-9-15 PIC 9(07). 008070 10 E1-AZ-KK PIC X(20). 008080 10 E1-BBNRAS PIC X(15). 008081 10 E1-BBNRAS-NUM REDEFINES 008082 E1-BBNRAS. 008083 15 E1-BBNRAS-NUM-1-8. 008084 20 E1-BBNRAS-NUM-1-7 PIC 9(07). 008085 20 E1-BBNRAS-NUM-8 PIC 9(01). 008086 15 E1-BBNRAS-NUM-9-15 PIC 9(07). 008090 10 E1-PERSGR PIC X(03). 008091 10 E1-PERSGR-NUM REDEFINES 008092 E1-PERSGR PIC 9(03). 008093 10 E1-GD PIC X(02). 008094 10 E1-GD-NUM REDEFINES 008095 E1-GD PIC 9(02). 008096 10 E1-SASC PIC X(03). 008097 10 E1-SASC-NUM REDEFINES E1-SASC PIC 9(3). 008098 10 FILLER REDEFINES E1-SASC. 008099 15 E1-MMAV PIC X(01). 008100 15 E1-MMES PIC X(01). 008101 15 E1-MMAS PIC X(01). 008104**-------------------------------------------------------- 008105** DATENBAUSTEINE 008106**-------------------------------------------------------- 008107 10 E1-MMME PIC X(01). 008108 10 E1-MMNA PIC X(01). 008109 10 E1-MMGB PIC X(01). 008110 10 E1-MMAN PIC X(01). 008111 10 E1-MMEU PIC X(01). 008112 10 E1-MMSO PIC X(01). 008113** --------------------------------------------- 008114** 13.05.2003 KERNPRÜFUNG VERSION-33 008115** --------------------------------------------- 008116 10 E1-RES-ST-176 REDEFINES E1-MMSO PIC X(01). 008117 10 E1-MMKS PIC X(01). 008118 10 E1-MMSV PIC X(01). 008119 10 E1-MMVR PIC X(01). 008120 10 E1-MMRG PIC X(01). 008130 10 E1-KENNZUE PIC X(01). 008131 10 E1-MMMQ PIC X(01). 008132 10 E1-KENNZUP PIC X(01). 008133 10 E1-KENNZGV PIC X(01). 008140 10 E1-KENNZSTA PIC X(01). 008150 10 E1-MM-UEBERW-EINZUGSVG PIC X(01). 008160 10 E1-FILLER PIC X(04). 008185*COPY DUCDBME1 REPLACING ==:S1:== BY ==E2==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBME 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBME" 001520** : MELDESACHVERHALT 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001550**---------------------------------------------------------------- 001700 05 E2-DUCDBME. 001800 10 E2-KE PIC X(04). 001900 10 E2-KENNZST PIC X(01). 002000 10 E2-KENNZANK PIC X(01). 002010 10 E2-KENNZGLE REDEFINES E2-KENNZANK PIC X(01). 002100 10 E2-ZRBG PIC 9(08). 002110 10 E2-ZRBG-NUM REDEFINES 002120 E2-ZRBG. 002130 15 E2-ZRBG-JHJJMM. 002131 20 E2-ZRBG-JH PIC 9(02). 002132 20 E2-ZRBG-JJ PIC 9(02). 002140 20 E2-ZRBG-MM PIC 9(02). 002150 15 E2-ZRBG-TT PIC 9(02). 002200 10 E2-ZREN PIC X(08). 002210 10 E2-ZREN-NUM REDEFINES 002220 E2-ZREN. 002230 15 E2-ZREN-JHJJMM. 002231 20 E2-ZREN-JH PIC 9(02). 002240 20 E2-ZREN-JJ PIC 9(02). 002250 20 E2-ZREN-MM PIC 9(02). 002260 15 E2-ZREN-TT PIC 9(02). 002300 10 E2-ZLTG PIC X(02). 002310 10 E2-ZLTG-NUM REDEFINES 002320 E2-ZLTG PIC 9(02). 002400 10 E2-WG PIC X(01). 002500 10 E2-EG PIC X(06). 002510 10 E2-EG-NUM REDEFINES 002520 E2-EG PIC 9(06). 002600 10 E2-BYGR PIC X(04). 002610 10 E2-BYGR-NUM REDEFINES 002620 E2-BYGR. 002630 15 E2-BYGR-NUM-1 PIC 9. 002640 15 E2-BYGR-NUM-2 PIC 9. 002650 15 E2-BYGR-NUM-3 PIC 9. 002660 15 E2-BYGR-NUM-4 PIC 9. 002700 10 E2-TTSC PIC X(09). 002800 10 E2-KENNZRK PIC X(01). 002900 10 E2-KENNZMF PIC X(01). 008186*COPY DUCDBNA1 REPLACING ==:S2:== BY ==E3==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBNA 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBNA" 001520** : NAME 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E3-DUCDBNA. 001800 10 E3-KE PIC X(04). 001900 10 E3-FMNA PIC X(30). 002000 10 E3-VONA PIC X(30). 002100 10 E3-VOSA PIC X(20). 002200 10 E3-NAZU PIC X(20). 002300 10 E3-TITEL PIC X(20). 002600 10 E3-KENNZAB PIC X(01). 008187*COPY DUCDBGB1 REPLACING ==:S3:== BY ==E4==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBGB 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBGB" 001520** : GEBURTSANGABEN 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 002800 05 E4-DUCDBGB. 002900 10 E4-KE PIC X(04). 003000 10 E4-GBNA PIC X(30). 003100 10 E4-GBVOSA PIC X(20). 003200 10 E4-GBNAZU PIC X(20). 003210 10 E4-GBDT PIC X(08). 003220 10 E4-GBDT-NUM REDEFINES 003230 E4-GBDT. 003231 15 E4-GBDT-JHJJ PIC 9(04). 003232 15 E4-GBDT-MM PIC 9(02). 003233 15 E4-GBDT-TT PIC 9(02). 003240 10 E4-GE PIC X(01). 003300 10 E4-GBOT PIC X(34). 008188*COPY DUCDBAN1 REPLACING ==:S4:== BY ==E5==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBAN 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBAN" 001520** : ANSCHRIFT 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E5-DUCDBAN. 001800 10 E5-KE PIC X(04). 001900 10 E5-LDKZ PIC X(03). 002000 10 E5-PLZ PIC X(10). 002010 10 E5-PLZ-NUM REDEFINES 002020 E5-PLZ. 002030 15 E5-PLZ-NUM-1 PIC 9(5). 002040 15 E5-PLZ-NUM-2 PIC 9(5). 002100 10 E5-ORT PIC X(34). 002200 10 E5-STR PIC X(33). 002300 10 E5-NR PIC X(09). 002400 10 E5-ADRZU PIC X(40). 008189*COPY DUCDBEU1 REPLACING ==:S5:== BY ==E6==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBEU 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBEU" 001520** : EUROPÄISCHE VERSICHERUNGSNUMMER 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E6-DUCDBEU. 001800 10 E6-KE PIC X(04). 001900 10 E6-GBLD PIC X(03). 001910 10 E6-GBLD-NUM REDEFINES 001920 E6-GBLD PIC 9(03). 002000 10 E6-EUVSNR PIC X(20). 008190*COPY DUCDBSO1 REPLACING ==:S6:== BY ==E7==. 008191*COPY DUCDBKS1 REPLACING ==:S7:== BY ==E8==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBKS 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBKS" 001520** : BUNDESKNAPPSCHAFT/SEE-KRANKENKASSE 001530** : 001531** ACHTUNG : WIRD Z. Z. NICHT GELIEFERT !!! 001600**---------------------------------------------------------------- 001700 05 E8-DUCDBKS. 001800 10 E8-KE PIC X(04). 001900 10 E8-KENNZKS PIC X(01). 002000 10 E8-SEE PIC X(215). 008192*COPY DUCDBSV1 REPLACING ==:S8:== BY ==E9==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBSV 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBSV" 001520** : SOZIALVERSICHERUNGSAUSWEIS 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E9-DUCDBSV. 001800 10 E9-KE PIC X(04). 001900 10 E9-KENNZSVA PIC X(01). 002000** 002100 05 E9-DUCDBSVN REDEFINES 002110 E9-DUCDBSV. 002200 10 E9-NUMDBSV PIC 9(01) OCCURS 5 TIMES. 003600** 008193*COPY DUCDBVR1 REPLACING ==:S9:== BY ==E10==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBVR 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBVR" 001520** : VERGABE/RÜCKMELDUNG 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E10-DUCDBVR. 001800 10 E10-KE PIC X(04). 001900 10 E10-GDMQ PIC X(02). 001901 10 E10-GDMQ-NUM REDEFINES 001902 E10-GDMQ PIC 9(02). 001910 10 E10-BRNR PIC X(02). 001911 10 E10-BRNR-NUM REDEFINES 001912 E10-BRNR PIC 9(02). 001920 10 E10-VSNRZH PIC X(12). 008194**OPY DUCDBRG1 REPLACING ==:S10:== BY ==E11==. 008200*COPY DUCDBRG REPLACING ==:S10:== BY ==E11==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBRG 001000** PROGRAMMIERER : MECKELEIN W. 001100** ERSTELLUNGSDATUM : 05.05.1999 001200** VERSION : 001 001300** FUNKTION : RÜCKMELDESATZ GERINGFüGIG BESCHäFTIGTE AN 001600**---------------------------------------------------------------- 001700 05 E11-DUCDBRG. 001800 10 E11-KE PIC X(04). 001900 10 E11-ZRBG PIC X(08). 001901 10 E11-ZRBG-NUM REDEFINES 001902 E11-ZRBG PIC 9(08). 001910 10 E11-ZREN PIC X(08). 001911 10 E11-ZREN-NUM REDEFINES 001912 E11-ZREN PIC 9(08). 001920 10 E11-PERSGR PIC X(03). 001921 10 E11-PERSGR-NUM REDEFINES 001922 E11-PERSGR PIC 9(03). 001930 10 E11-ZLTG PIC X(02). 001931 10 E11-ZLTG-NUM REDEFINES 001932 E11-ZLTG PIC 9(02). 001933 10 E11-WG PIC X(1). 001934 10 E11-EG PIC X(06). 001935 10 E11-EG-NUM REDEFINES 001936 E11-EG PIC 9(06). 001937 10 E11-BYGR PIC X(04). 001940 10 E11-BBNRAG PIC X(15). 001941 10 E11-BBNRAG-NUM REDEFINES 001942 E11-BBNRAG PIC 9(15). 001943 10 E11-BBNRKK PIC X(15). 001944 10 E11-BBNRKK-NUM REDEFINES 001945 E11-BBNRKK PIC 9(15). 001950 10 E11-NABE1 PIC X(28). 001960 10 E11-NABE2 PIC X(28). 001970 10 E11-STR PIC X(28). 001980 10 E11-PLZ PIC X(05). 001981 10 E11-PLZ-NUM REDEFINES 001982 E11-PLZ PIC 9(05). 001990 10 E11-OT PIC X(32). 001991 10 E11-PZB PIC X(19). 001995 10 E11-ANRG PIC X(02). 001996 10 E11-ANRG-NUM REDEFINES 001997 E11-ANRG PIC 9(2). 001998 10 E11-GANZAHL PIC X(20394). 002000** 002010 10 E11-EINZEL REDEFINES 002011 E11-GANZAHL OCCURS 99 INDEXED BY K. 002020 15 E11-ZRBGNN PIC X(08). 002021 15 E11-ZRBGNN-NUM REDEFINES 002022 E11-ZRBGNN PIC 9(08). 002030 15 E11-ZRENNN PIC X(08). 002031 15 E11-ZRENNN-NUM REDEFINES 002032 E11-ZRENNN PIC 9(08). 002040 15 E11-PERSGRNN PIC X(03). 002041 15 E11-PERSGRNN-NUM REDEFINES 002042 E11-PERSGRNN PIC 9(03). 002050 15 E11-ZLTG1 PIC X(02). 002051 15 E11-ZLTG1-NUM REDEFINES 002052 E11-ZLTG1 PIC 9(02). 002053 15 E11-WGNN PIC X(1). 002054 15 E11-EGNN PIC X(06). 002055 15 E11-EGNN-NUM REDEFINES 002056 E11-EGNN PIC 9(06). 002057 15 E11-BYGRNN PIC X(04). 002060 15 E11-BBNRAGNN PIC X(15). 002061 15 E11-BBNRAGNN-NUM REDEFINES 002062 E11-BBNRAGNN PIC 9(15). 002070 15 E11-EPNRNN PIC X(15). 002071 15 E11-EPNRNN-NUM REDEFINES 002072 E11-EPNRNN PIC 9(15). 002073 15 E11-HW PIC X(04). 002080 15 E11-NABE1NN PIC X(28). 002090 15 E11-NABE2NN PIC X(28). 002091 15 E11-STRNN PIC X(28). 002092 15 E11-PLZNN PIC X(05). 002093 15 E11-PLZNN-NUM REDEFINES 002094 E11-PLZNN PIC 9(05). 002095 15 E11-OTNN PIC X(32). 002096 15 E11-PZBNN PIC X(19). 002500** 008272**--------------------------------------------------------------- 008273** ARBEITSBEREICH (WORKDSAE) 008274**--------------------------------------------------------------- 008275 01 WORKDSAE. 008276*COPY DUCDSAE1 REPLACING ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDSAE 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DTSZ-BESCHREIBUNG "DSAE" 001520** : MELDUNGEN VON ENTGELTERSATZLEISTUNGEN 001530** : UND ANRECHNUNGSZEITEN DER LEITUNGSTRÄGER 001540** : AN DIE RENTENVERSICHERUNG 001550** : 001560** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700** PROGRAMMIERER : MICHAEL KLEMKE 001710** ERSTELLUNGSDATUM : 22.10.2003 001720** VERSION : 002 001738**---------------------------------------------------------------- 001739 05 E12-DUCDSAE. 001800 10 E12-KE PIC X(04). 001900 10 E12-VF PIC X(05). 002000 10 E12-BBNRAB PIC X(15). 002001 10 E12-BBNRAB-NUM REDEFINES 002002 E12-BBNRAB. 002004 15 E12-BBNRAB-NUM-1-8. 002005 20 E12-BBNRAB-NUM-1-7 PIC 9(07). 002006 20 E12-BBNRAB-NUM-8 PIC 9(01). 002007 15 E12-BBNRAB-NUM-15 PIC 9(07). 002100 10 E12-BBNREP PIC X(15). 002110 10 E12-BBNREP-NUM REDEFINES 002120 E12-BBNREP. 002123 15 E12-BBNREP-NUM-1-8. 002124 20 E12-BBNREP-NUM-1-7 PIC 9(07). 002125 20 E12-BBNREP-NUM-8 PIC 9(01). 002126 15 E12-BBNREP-NUM-15 PIC 9(07). 002200 10 E12-VERNR PIC X(02). 002210 10 E12-VERNR-NUM REDEFINES 002220 E12-VERNR PIC 9(02). 002300 10 E12-ED PIC X(20). 002330 10 E12-ED-NUM REDEFINES 002340 E12-ED. 002350 15 E12-HDAT. 002360 20 E12-HJH PIC 9(02). 002370 20 E12-HJJ PIC 9(02). 002380 20 E12-HMM PIC 9(02). 002390 20 E12-HTT PIC 9(02). 002391 15 E12-HUHR. 002392 20 E12-HSTD PIC 9(02). 002393 20 E12-HMIN PIC 9(02). 002394 20 E12-HSEK PIC 9(02). 002395 15 E12-HMSEC PIC 9(06). 002400 10 E12-FEKZ PIC X(01). 002410 10 E12-FEKZ-NUM REDEFINES 002420 E12-FEKZ PIC 9(01). 002500 10 E12-FEAN PIC X(01). 002510 10 E12-FEAN-NUM REDEFINES 002520 E12-FEAN PIC 9(01). 002600 10 E12-VSNR PIC X(12). 002700 10 E12-VSTR PIC X(02). 002800 10 E12-BBNRVU PIC X(15). 002801 10 E12-BBNRVU-NUM REDEFINES 002802 E12-BBNRVU. 002803 15 E12-BBNRVU-NUM-1-8. 002804 20 E12-BBNRVU-NUM-1-7 PIC 9(07). 002805 20 E12-BBNRVU-NUM-8 PIC 9(01). 002806 15 E12-BBNRVU-NUM-15 PIC 9(07). 002900 10 E12-AZ-VU PIC X(20). 002910 10 E12-AZ-VU-NUM REDEFINES 002920 E12-AZ-VU. 002930 15 E12-AZ-VU-NUM1 PIC 9(08). 002940 15 E12-AZ-VU-NUM2 PIC X. 002950 15 E12-AZ-VU-NUM3 PIC 9(06). 002960 15 E12-AZ-VU-NUM4 PIC X(05). 003000 10 E12-RESERVE PIC X(58). 003600 10 E12-MMAZ PIC X(01). 003700 10 E12-MMEZ PIC X(01). 003710* --------------------------------------------------- 003720* ÄNDERUNG VOM 22.10.2003 003730* --------------------------------------------------- 003800* 10 :S11:-RESERVE PIC X(18). 003810 10 E12-RESERVE-2 PIC X(08). 003900 10 E12-KENNZUE PIC X(01). 004000 10 E12-RESERVE-3 PIC X(09). 008277*COPY DUCDBAZ1 REPLACING ==:S12:== BY ==E13==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBAZ 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBAZ" 001520** : ANRECHNUNGSZEITEN 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E13-DUCDBAZ. 001800 10 E13-KE PIC X(04). 001900 10 E13-KENNZST PIC X(01). 002000 10 E13-LEAT PIC X(02). 002010 10 E13-LEAT-NUM REDEFINES 002020 E13-LEAT PIC 9(02). 002100 10 E13-ZRBE PIC X(08). 002110 10 E13-ZRBE-NUM REDEFINES 002120 E13-ZRBE. 002121 15 E13-ZRBE-JHJJ. 002130 20 E13-ZRBE-JH PIC 9(02). 002140 20 E13-ZRBE-JJ PIC 9(02). 002150 15 E13-ZRBE-MM PIC 9(02). 002160 15 E13-ZRBE-TT PIC 9(02). 002200 10 E13-ZREN PIC X(08). 002201 10 E13-ZREN-NUM REDEFINES 002202 E13-ZREN. 002203 15 E13-ZREN-JHJJ. 002204 20 E13-ZREN-JH PIC 9(02). 002205 20 E13-ZREN-JJ PIC 9(02). 002206 15 E13-ZREN-MM PIC 9(02). 002207 15 E13-ZREN-TT PIC 9(02). 008278*COPY DUCDBEZ1 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDBEZ 001000** PROGRAMMIERER : CARMEN SCHNEIDERBAUER 001100** ERSTELLUNGSDATUM : 28.11.1997 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : ENTDICHTEN VON DATENSÄTZEN (DUEVO) 001500** : 001510** HIER : DATENBAUSTEIN "DBEZ" 001520** : ENTGELTERSATZLEISTUNGSZEITEN 001530** : 001540** : AUFRUF ÜBER DAS PROGRAMM "DU201" 001600**---------------------------------------------------------------- 001700 05 E14-DUCDBEZ. 001800 10 E14-KE PIC X(04). 001900 10 E14-KENNZST PIC X(01). 002000 10 E14-LEAT PIC X(02). 002100 10 E14-GDMQ PIC X(02). 002110 10 E14-GDMQ-NUM REDEFINES 002120 E14-GDMQ PIC 9(02). 002200 10 E14-ZRBE PIC X(08). 002210 10 E14-ZRBE-NUM REDEFINES 002220 E14-ZRBE. 002230 15 E14-ZRBE-JHJJ. 002231 20 E14-ZRBE-JH PIC 9(02). 002240 20 E14-ZRBE-JJ PIC 9(02). 002250 15 E14-ZRBE-MM PIC 9(02). 002260 15 E14-ZRBE-TT PIC 9(02). 002300 10 E14-ZREN PIC X(08). 002310 10 E14-ZREN-NUM REDEFINES 002320 E14-ZREN. 002330 15 E14-ZREN-JHJJ. 002331 20 E14-ZREN-JH PIC 9(02). 002340 20 E14-ZREN-JJ PIC 9(02). 002350 15 E14-ZREN-MM PIC 9(02). 002360 15 E14-ZREN-TT PIC 9(02). 002400 10 E14-WG PIC X(01). 002500 10 E14-EG PIC X(06). 002510 10 E14-EG-NUM REDEFINES 002520 E14-EG PIC 9(06). 002600 10 E14-BY PIC X(07). 002610 10 E14-BY-NUM REDEFINES 002620 E14-BY PIC 9(07). 002700 10 E14-KENNZRK PIC X(01). 002800 10 E14-KENNZWE PIC X(01). 008279**--------------------------------------------------------------- 008280** ARBEITSBEREICH (WORKDSKO) 008290**--------------------------------------------------------------- 008300 01 WORKDSKO. 008400*COPY DUCDSKO1 REPLACING ==:S0:== BY ==E15==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : DUCDSKO1 001000** PROGRAMMIERER : MICHAEL KLEMKE 001100** ERSTELLUNGSDATUM : 14.10.2004 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 002500**---------------------------------------------------------------- 007995 05 E15-DUCDSKO. 008000 10 E15-KE PIC X(04). 008001 10 E15-VF PIC X(05). 008002 10 E15-BBNRAB PIC X(15). 008003 10 E15-BBNRAB-NUM REDEFINES 008004 E15-BBNRAB. 008005 15 E15-BBNRAB-NUM-1-8. 008006 20 E15-BBNRAB-NUM-1-7 PIC 9(07). 008007 20 E15-BBNRAB-NUM-8 PIC 9(01). 008008 15 E15-BBNRAB-NUM-15 PIC 9(07). 008009 10 E15-BBNREP PIC X(15). 008010 10 E15-BBNREP-NUM REDEFINES 008011 E15-BBNREP. 008012 15 E15-BBNREP-NUM-1-8. 008013 20 E15-BBNREP-NUM-1-7 PIC 9(07). 008014 20 E15-BBNREP-NUM-8 PIC 9(01). 008015 15 E15-BBNREP-NUM-15 PIC 9(07). 008016 10 E15-VERNR PIC X(02). 008017 10 E15-VERNR-NUM REDEFINES 008018 E15-VERNR PIC 9(02). 008019 10 E15-ED PIC X(20). 008020 10 E15-ED-NUM REDEFINES 008021 E15-ED. 008022 15 E15-HDAT. 008023 20 E15-HJH PIC 9(02). 008024 20 E15-HJJ PIC 9(02). 008025 20 E15-HMM PIC 9(02). 008026 20 E15-HTT PIC 9(02). 008027 15 E15-HUHR. 008028 20 E15-HSTD PIC 9(02). 008029 20 E15-HMIN PIC 9(02). 008030 20 E15-HSEK PIC 9(02). 008031 15 E15-HMSEC PIC 9(06). 008032 10 E15-FEKZ PIC X(01). 008033 10 E15-FEKZ-NUM REDEFINES 008034 E15-FEKZ PIC 9(01). 008035 10 E15-FEAN PIC X(01). 008036 10 E15-FEAN-NUM REDEFINES 008037 E15-FEAN PIC 9(01). 008040 10 E15-BBNRVU PIC X(15). 008041 10 E15-BBNRVU-NUM REDEFINES 008042 E15-BBNRVU. 008043 15 E15-BBNRVU-NUM-1-8. 008044 20 E15-BBNRVU-NUM-1-7 PIC 9(07). 008045 20 E15-BBNRVU-NUM-8 PIC 9(01). 008046 15 E15-BBNRVU-NUM-15 PIC 9(07). 008049 10 E15-PROD-ID PIC X(07). 008050 10 E15-MOD-ID PIC X(08). 008051 10 E15-NAME1 PIC X(30). 008052 10 E15-NAME2 PIC X(30). 008053 10 E15-NAME3 PIC X(30). 008054 10 E15-PLZ PIC X(10). 008055 10 E15-ORT PIC X(34). 008056 10 E15-STR PIC X(33). 008057 10 E15-NR PIC X(09). 008058 10 E15-ANR-AP PIC X(01). 008059 10 E15-NAME-AP PIC X(30). 008060 10 E15-TEL-AP PIC X(20). 008061 10 E15-FAX-AP PIC X(20). 008062 10 E15-EMAIL-AP PIC X(70). 008063 008064 008070 008758**---------------------------------------------------------------- 008759 LINKAGE SECTION. 008760**---------------------------------------------------------------- 008761** OP-CODE : VERFAHRENSMERKMAL AUS VORLAUFSATZ 008762**---------------------------------------------------------------- 008763 01 OP-CODE PIC X(5). 008764**---------------------------------------------------------------- 008765** EINGABEBEREICH (EINBER) 008766**---------------------------------------------------------------- 008767 01 EIN-LG PIC X(6). 008768 01 EIN-SATZ. 008769 05 EIN-STEUER PIC X(190). 008770 05 EIN-REST PIC X(31810). 008772**---------------------------------------------------------------- 008773** VERARBEITUNGSDATUM 008774**---------------------------------------------------------------- 008775 01 P-VERDATUM. 008776 05 P-DATE. 008777 10 P-JHJJ PIC X(4). 008778 10 P-MM PIC X(2). 008779 10 P-TT PIC X(2). 008780 05 P-TIME. 008781 10 P-HH PIC X(2). 008782 10 P-MM PIC X(2). 008783 10 P-SS PIC X(2). 008784 05 P-MSEC PIC X(6). 008785 01 P-RC PIC 9(4). 008786 PROCEDURE DIVISION USING OP-CODE EIN-LG EIN-SATZ P-VERDATUM P-RC. 016000**---------------------------------------------------------------- 016100** HAUPTPROGRAMM: STEUERROUTINE 016200** FUNKTION : AUFRUF DER EINZELNEN PRueFUNGEN 016300** PARAMETER : PARM, EINBER, AISZ 016400**---------------------------------------------------------------- 016500 STEUER SECTION. 016501 STEUERE. 016502 IF WEICHE = SPACE THEN 016504 DISPLAY "Kernprüfung der Rentenversicherung:" 016505 DISPLAY "Version Anlage 9 Gem. Rundschreiben: " 016506 "2.28 , Einsatztermin ab 12.06.2007" 016508 DISPLAY "Programmversion: 95, " 016509 "Programmdatum: 11.06.2007, " 016510 "Softwareentwurf: 62 " 016513 MOVE "X" TO WEICHE 016514 END-IF 016515 PERFORM VORLAUF 016516 IF NOT ST-DSQU 016517** ---------------------------------------------------------- 016518** QUITTUNGSDATENSATZ WIRD NICHT GEPRÜFT (VERSION-41) 016519** ---------------------------------------------------------- 016520 PERFORM ABS-5-1 016522 IF H-FENR-ANZ = 0 AND P-RC = 0 016523 PERFORM ABS-5-2 016524 IF H-FENR-ANZ < 9 016525 IF ST-DSME OR ST-DSAE 016527 PERFORM ABS-5-3 016528 ELSE 016529 PERFORM ABS-5-4 016530 END-IF 016531 END-IF 016532 END-IF 016533 IF H-FENR-ANZ > 0 OR H-HINW-ANZ > 0 016534 PERFORM DBFE-BILD 016535 END-IF 016536 END-IF 016547 . 016548 016549 016550**---------------------------------------------------------------- 016551** PROGRAMM-ENDE 016552**---------------------------------------------------------------- 016553 ENDE. 016560 EXIT PROGRAM. 016570 016571 016574**---------------------------------------------------------------- 016575** UNTERROUTINE : VORLAUF 016576** FUNKTION : FELDER INITIALISIEREN 016577** VARIABLEN : 016578**---------------------------------------------------------------- 016579 VORLAUF SECTION. 016580 VORLAUFE. 016581 INITIALIZE HILFSFELDER 016582 INITIALIZE RECHENFELDER 016583 INITIALIZE WORKDSME 016584 INITIALIZE WORKDSAE 016585 INITIALIZE WORKDSKO 016586 INITIALIZE H-FENR-ANZ, H-FENR-SAVE, H-FENR-TAB 016587 INITIALIZE H-HINW-ANZ, H-HINW-TAB 016588 MOVE 0 TO P-RC 016589 MOVE 0 TO REST, RESTB 016597 MOVE EIN-STEUER TO ST-GES 016598 MOVE ST-KE TO H-KE 016599 MOVE ST-KE TO HFELD-KE-SAVE 016600 MOVE EIN-LG TO EIN-LAENGE1 016601 MOVE OP-CODE TO OPCOD 016602** ------------------------------------------------------------- 016603** ÄNDERUNGEN VON 09.04.2002 016604** VERMEIDEN VON REDEFINES MIT UNTERSCH. GROSSEN BEREICHEN 016605** LÖSUNG: DEFINIERTE ZEILEN AUF GRÖSSEREN BEREICH ÜBERTRAGEN 016606** ------------------------------------------------------------- 016607 MOVE SPACES TO FEHLERKTLG 016608 MOVE FEHLERKONST TO FEHLERKTLG 016609 016611* INITIALIZE TB-ENTGELT 016612 MOVE SPACES TO TB-ENTGELT 016613 MOVE TABELLE-ENTGELT TO TB-ENTGELT 016614 016615* INITIALIZE TB-ENTGELT-E 016616 MOVE SPACES TO TB-ENTGELT-E 016617 MOVE TABELLE-ENTGELT-E TO TB-ENTGELT-E 016618 016619* INITIALIZE TB-BEZGR 016620 MOVE SPACES TO TB-BEZGR 016621 MOVE TABELLE-BEZUGSGROESSE TO TB-BEZGR 016622 016623* INITIALIZE TB-BEZGR-E 016624 MOVE SPACES TO TB-BEZGR-E 016625 MOVE TABELLE-BEZUGSGROESSE-E TO TB-BEZGR-E 016626 016627 016628* INITIALIZE TB-BEITS 016629 MOVE SPACES TO TB-BEITS 016630 MOVE TABELLE-BEITRAGSSATZ TO TB-BEITS 016631 . 016632 016633 016634 VORLAUF-EXIT. 016635 EXIT. 016637 016670 016671**---------------------------------------------------------------- 016672** UNTERROUTINE : GRUNDPRUEF 016673** FUNKTION : EINGABESATZ PRueFEN UND AUFBAUEN. 016674** VARIABLEN : EINBER 016675**---------------------------------------------------------------- 016676 ABS-5-1 SECTION. 016677 ABS-5-1A. 016678** ------------------------------------------------------------- 016679** ABS-511 ANFANG 016680** ------------------------------------------------------------- 016681 IF ST-DEUEV OR ST-KVNR 016682 IF ST-DSME OR ST-DSAE OR ST-DSKO 016685 IF ST-FEKZ-NUM NUMERIC 016689 IF ST-DSME AND (ST-FEKZ-NUM = 1 OR 2 OR 3 OR 4) OR 016690 ST-DSAE AND (ST-FEKZ-NUM = 1 OR 2) OR 016691 ST-DSKO AND ST-FEKZ-NUM = 1 016692 MOVE 1100 TO P-RC 016693 END-IF 016694 END-IF 016698 ELSE 016699 MOVE 1002 TO P-RC 016700 END-IF 016701 ELSE 016702 MOVE 1001 TO P-RC 016703 END-IF 016704** ------------------------------------------------------------- 016705** ABS-511 ENDE 016706** ------------------------------------------------------------- 016707 IF P-RC = 0 016709** ---------------------------------------------------------- 016710** ABS-512 ANFANG 016711** ---------------------------------------------------------- 016712 IF ST-DSME 016713 MOVE OP-CODE TO DSME-KENN 016714 IF NOT DSME-KENN-OK THEN 016715 MOVE "004" TO H-FNR 016716 PERFORM FEHLER 016717 END-IF 016718 ELSE 016719 IF ST-DSAE 016720 MOVE OP-CODE TO DSAE-KENN 016721 IF NOT DSAE-KENN-OK THEN 016722 MOVE "004" TO H-FNR 016723 PERFORM FEHLER 016724 END-IF 016725 ELSE 016726 IF ST-DSKO 016727 MOVE OP-CODE TO DSKO-KENN 016728 IF NOT DSKO-KENN-OK THEN 016729 MOVE "004" TO H-FNR 016730 PERFORM FEHLER 016731 END-IF 016732 END-IF 016733 END-IF 016734 END-IF 016735** ---------------------------------------------------------- 016736** ABS-512 ENDE 016737** ---------------------------------------------------------- 016738 IF H-FENR-ANZ = 0 016739 IF ST-DSME OR ST-DSAE 016740** ---------------------------------------------------- 016741** ABS-51F ANFANG 016742** ---------------------------------------------------- 016743 MOVE 191 TO HFELD-LG 016744 MOVE SPACES TO HFELD-FE 016745 MOVE ST-KE TO HFELD-KE-ALT 016746 IF ST-DSME 016747 PERFORM ABS-5-1-3 016748 ELSE 016749 PERFORM ABS-5-1-4 016750 END-IF 016751 PERFORM ABS-5-1-5 016752** ---------------------------------------------------- 016755 ELSE 016756** ---------------------------------------------------- 016757** ABS-516 ANFANG 016758** ---------------------------------------------------- 016759 IF SATZLG = 410 016760 MOVE EIN-SATZ TO WORKDSKO 016761 ELSE 016762 MOVE 910 TO H-FNR 016763 PERFORM FEHLER 016764 END-IF 016765** ---------------------------------------------------- 016766 END-IF 016770 END-IF 016771 END-IF 016772 . 016773 016774 016775 ABS-5-1-EXIT. 016776 EXIT. 016777 016780 020110**---------------------------------------------------------------- 020120** UNTERROUTINE : ABS-5-1-5 020130** FUNKTION : Pruefung, ob Länge Bausteine mit Satzlänge 020131** übereinstimmt 020140** VARIABLEN : HFELD-FE 020150**---------------------------------------------------------------- 020160 ABS-5-1-5 SECTION. 020161 ABS-5-1-5A. 020162 IF HFELD-FE NOT EQUAL SPACE THEN 020163 IF HFELD-FE = "FE" THEN 020164 EVALUATE HFELD-KE-NEU 020165 WHEN "DBME" MOVE 930 TO H-FNR 020166 WHEN "DBNA" MOVE 931 TO H-FNR 020167 WHEN "DBGB" MOVE 932 TO H-FNR 020168 WHEN "DBAN" MOVE 933 TO H-FNR 020169 WHEN "DBEU" MOVE 934 TO H-FNR 020171 WHEN "DBKS" MOVE 936 TO H-FNR 020172 WHEN "DBSV" MOVE 937 TO H-FNR 020173 WHEN "DBVR" MOVE 938 TO H-FNR 020174 WHEN "DBRG" MOVE 939 TO H-FNR 020175 WHEN "DBAZ" MOVE 930 TO H-FNR 020176 WHEN "DBEZ" MOVE 931 TO H-FNR 020178 END-EVALUATE 020179 PERFORM FEHLER 020180 ELSE 020181 MOVE 910 TO H-FNR 020182 PERFORM FEHLER 020183 END-IF 020184 ELSE 020186* COMPUTE HFELD-LG = HFELD-LG - 1 020187 IF HFELD-LG NOT EQUAL SATZLG 020188 MOVE 910 TO H-FNR 020189 PERFORM FEHLER 020192 END-IF 020193 END-IF 020194 . 020195 020196 020197 ABS-5-1-5-EXIT. 020198 EXIT. 020199 020200 020201**---------------------------------------------------------------- 020202** UNTERROUTINE : ABS-5-2 020203** FUNKTION : DSME/DSAE/DSKO PRUEFEN 020204** VARIABLEN : 020205**---------------------------------------------------------------- 020206 ABS-5-2 SECTION. 020207 ABS-5-2A. 020208** ------------------------------------------------------------- 020209** ABS-5-2-1 - ANFANG 020210** ------------------------------------------------------------- 020211 IF NOT ST-DSKO 020212 IF ST-DSME THEN 020213** ------------------------------------------------------- 020214** ABS-5210 020215** ------------------------------------------------------- 020216 IF ST-KVNR 020217 IF OP-KVTRV OR OP-RVTKV OR OP-KVTWL OR OP-WLTKV 020218 CONTINUE 020219 ELSE 020220 MOVE "DSME010" TO H-FEHLER 020221 END-IF 020222 END-IF 020225 PERFORM FEHLER 020226** ------------------------------------------------------- 020227** ABS-5211 020228** ------------------------------------------------------- 020229 PERFORM FDSME020 020230 PERFORM FEHLER 020231** ------------------------------------------------------- 020232** ABS-5212 020233** ------------------------------------------------------- 020234 PERFORM FDSME030 020235 PERFORM FEHLER 020236** ------------------------------------------------------- 020237** ABS-5213 020238** ------------------------------------------------------- 020239 PERFORM FDSME040 020240 PERFORM FEHLER 020241** ------------------------------------------------------- 020242** ABS-5214 020243** ------------------------------------------------------- 020244 PERFORM FDSME050 020245 PERFORM FEHLER 020246** ------------------------------------------------------- 020247** ABS-5215 020248** ------------------------------------------------------- 020249 PERFORM FDSME060 020250 PERFORM FEHLER 020251 ELSE 020252** ------------------------------------------------------- 020253** ABS-5211 020254** ------------------------------------------------------- 020255 PERFORM FDSAE020 020256 PERFORM FEHLER 020257** ------------------------------------------------------- 020258** ABS-5212 020259** ------------------------------------------------------- 020260 PERFORM FDSAE030 020261 PERFORM FEHLER 020262** ------------------------------------------------------- 020263** ABS-5213 020264** ------------------------------------------------------- 020265 PERFORM FDSAE040 020266 PERFORM FEHLER 020267** ------------------------------------------------------- 020268** ABS-5214 020269** ------------------------------------------------------- 020270 PERFORM FDSAE050 020271 PERFORM FEHLER 020272** ------------------------------------------------------- 020273** ABS-5215 020274** ------------------------------------------------------- 020275 PERFORM FDSAE060 020276 PERFORM FEHLER 020277 END-IF 020278 ELSE 020279** ---------------------------------------------------------- 020280** ABS-5213 020281** ---------------------------------------------------------- 020282** ABS-5213 020283** ---------------------------------------------------------- 020284 PERFORM FDSKO040 020285 PERFORM FEHLER 020286** ---------------------------------------------------------- 020287** ABS-5214 020288** ---------------------------------------------------------- 020289 PERFORM FDSKO050 020290 PERFORM FEHLER 020291** ---------------------------------------------------------- 020292** ABS-5215 020293** ---------------------------------------------------------- 020294 PERFORM FDSKO060 020295 PERFORM FEHLER 020296 END-IF 020297** ------------------------------------------------------------- 020298** ABS-5-2-1 - ENDE 020299** ------------------------------------------------------------- 020300** ABS-5-2-2 - ANFANG 020301** ------------------------------------------------------------- 020302 IF NOT ST-DSKO 020303 IF ST-DSME THEN 020304 PERFORM FDSME080 020305 PERFORM FEHLER 020306 PERFORM FDSME120 020307 PERFORM FEHLER 020308 PERFORM FDSME140 020309 PERFORM FEHLER 020310 PERFORM FDSME160 020311 PERFORM FEHLER 020312 ELSE 020313 PERFORM FDSAE080 020314 PERFORM FEHLER 020315 PERFORM FDSAE120 020316 PERFORM FEHLER 020317 PERFORM FDSAE140 020318 PERFORM FEHLER 020319 PERFORM FDSAE160 020320 PERFORM FEHLER 020321 END-IF 020322 END-IF 020323** ------------------------------------------------------------- 020324** ABS-5-2-2 - ENDE 020325** ------------------------------------------------------------- 020326 IF H-FENR-ANZ < 9 020327 IF ST-DSME THEN 020328** ------------------------------------------------------- 020329** ABS-5-2-3 - ANFANG 020330** ------------------------------------------------------- 020331 PERFORM FDSME170 020332 PERFORM FEHLER 020333 PERFORM FDSME190 020334 PERFORM FEHLER 020335 PERFORM FDSME200 020336 PERFORM FEHLER 020337 PERFORM FDSME230 020338 PERFORM FDSME250 020339 PERFORM FEHLER 020340** ------------------------------------------------------- 020341** ABS-5-2-3 - ENDE 020342** ------------------------------------------------------- 020343** ABS-5-2-4 - ANFANG 020344** ------------------------------------------------------- 020345 PERFORM FDSME260 020346 PERFORM FEHLER 020347 PERFORM FDSME270 020348 PERFORM FEHLER 020349 PERFORM FDSME280 020350 PERFORM FEHLER 020351 PERFORM FDSME290 020352 PERFORM FEHLER 020353 PERFORM FDSME300 020354 PERFORM FEHLER 020355 PERFORM FDSME310 020356 PERFORM FEHLER 020357 PERFORM FDSME320 020358 PERFORM FEHLER 020359 PERFORM FDSME330 020360 PERFORM FEHLER 020361 PERFORM FDSME340 020362 PERFORM FEHLER 020363 PERFORM FDSME350 020364 PERFORM FEHLER 020365 PERFORM FDSME360 020366 PERFORM FEHLER 020367 PERFORM FDSME380 020368 PERFORM FEHLER 020369 PERFORM FDSME390 020370 PERFORM FEHLER 020371 PERFORM FDSME395 020372** ------------------------------------------------------- 020373** ABS-5-2-4 - ENDE 020374** ------------------------------------------------------- 020375 ELSE 020376 IF ST-DSAE THEN 020377** ---------------------------------------------------- 020378** ABS-5-2-5 - ANFANG 020379** ---------------------------------------------------- 020380 PERFORM FDSAE400 020381 END-IF 020382 END-IF 020383 END-IF 020384** ------------------------------------------------------------- 020385** ABS-5-2 - ENDE 020386** ------------------------------------------------------------- 020387 . 020388 020389 020390 ABS-5-2-EXIT. 020391 EXIT. 020392 020393 020394**---------------------------------------------------------------- 020395** UNTERROUTINE : ABS-5-3 020400** FUNKTION : RESTLICHE DATENBAUSTEINE PRueFEN 020500** VARIABLEN : 020600**---------------------------------------------------------------- 020610 ABS-5-3 SECTION. 020611 ABS-5-3A. 020620 IF ST-DSME THEN 020621** Aufbauen Geburtsdatum mit Jahrhundert sofern gültige VSNR 020622 IF HFELD-P-GBDT NOT EQUAL "N" 020624 MOVE P-DATE TO HFELD-VD 020625** COMPUTE HFELD-VD-JHJJN = HFELD-VD-JHJJN - 12 020626 MOVE E1-VSNR TO HVSNR 020627 MOVE 00 TO HFELD-GEB-JH 020628 MOVE HVSNRGEBJJ TO HFELD-GEB-JJ 020629 MOVE HVSNRGEBMM TO HFELD-GEB-MM 020630 MOVE HVSNRGEBTT TO HFELD-GEB-TT 020632 IF HFELD-GEB-MM = 0 THEN 020633 MOVE 07 TO HFELD-GEB-MM 020634 MOVE 01 TO HFELD-GEB-TT 020635 ELSE 020636 IF HFELD-GEB-TT = 0 THEN 020637 MOVE 15 TO HFELD-GEB-TT 020638 END-IF 020639 END-IF 020642** IF HFELD-GEB-JH >= HFELD-VD-JH THEN 020643 IF HFELD-GEB-JJ > HFELD-VD-JJ THEN 020644 COMPUTE HFELD-GEB-JH = HFELD-VD-JH - 1 020645 ELSE 020646 MOVE HFELD-VD-JH TO HFELD-GEB-JH 020647 END-IF 020649** ------------------------------------------------------- 020650** ERWEITERUNG VERSION-25 VOM 25.07.2001 020651** ------------------------------------------------------- 020652 IF HFELD-GEB-TT > 64 THEN 020653 COMPUTE HFELD-GEB-TT = HFELD-GEB-TT - 64 020654 ELSE 020655 IF HFELD-GEB-TT > 32 THEN 020656 COMPUTE HFELD-GEB-TT = HFELD-GEB-TT - 32 020657 END-IF 020658 END-IF 020659** ------------------------------------------------------- 020660** GEBURTSDATUM SPEICHERN IN ZWISCHENFELD (WIRD N.VERÄND.) 020661** ------------------------------------------------------- 020662 MOVE HFELD-GEB TO SIC-GEB 020665 END-IF 020666 IF E1-MMME = "J" 020667 PERFORM DBME-PRUEF 020668 END-IF 020669 IF E1-MMNA = "J" AND H-FENR-ANZ < 9 020670 PERFORM DBNA-PRUEF 020680 END-IF 020690 IF E1-MMGB = "J" AND H-FENR-ANZ < 9 020691 PERFORM DBGB-PRUEF 020692 END-IF 020693 IF E1-MMAN = "J" AND H-FENR-ANZ < 9 020697 PERFORM DBAN-PRUEF 020700 END-IF 020701 IF E1-MMEU = "J" AND H-FENR-ANZ < 9 020702 PERFORM DBEU-PRUEF 020703 END-IF 020707 IF E1-MMKS = "J" AND H-FENR-ANZ < 9 020708 PERFORM DBKS-PRUEF 020709 END-IF 020710 IF E1-MMSV = "J" AND H-FENR-ANZ < 9 020711 PERFORM DBSV-PRUEF 020712 END-IF 020713 IF E1-MMVR = "J" AND H-FENR-ANZ < 9 020714 PERFORM DBVR-PRUEF 020715 END-IF 020716 IF E1-MMRG = "J" AND H-FENR-ANZ < 9 020717 PERFORM DBRG-PRUEF 020718 END-IF 020719 ELSE 020720** Aufbauen Geburtsdatum mit Jahrhundert 020721 IF HFELD-P-GBDT NOT EQUAL "N" 020722 MOVE P-DATE TO HFELD-VD 020723** COMPUTE HFELD-VD-JHJJN = HFELD-VD-JHJJN - 12 020724 MOVE E12-VSNR TO HVSNR 020725 MOVE 00 TO HFELD-GEB-JH 020726 MOVE HVSNRGEBJJ TO HFELD-GEB-JJ 020727 MOVE HVSNRGEBMM TO HFELD-GEB-MM 020728 MOVE HVSNRGEBTT TO HFELD-GEB-TT 020729 IF HFELD-GEB-MM = 0 THEN 020730 MOVE 07 TO HFELD-GEB-MM 020731 MOVE 01 TO HFELD-GEB-TT 020732 ELSE 020733 IF HFELD-GEB-TT = 0 THEN 020734 MOVE 15 TO HFELD-GEB-TT 020735 END-IF 020736 END-IF 020737** IF HFELD-GEB-JH >= HFELD-VD-JH THEN 020738 IF HFELD-GEB-JJ > HFELD-VD-JJ THEN 020739 COMPUTE HFELD-GEB-JH = HFELD-VD-JH - 1 020740 ELSE 020741 MOVE HFELD-VD-JH TO HFELD-GEB-JH 020742 END-IF 020743** ------------------------------------------------------- 020744** ERWEITERUNG VERSION-25 VOM 25.07.2001 020745** ------------------------------------------------------- 020746 IF HFELD-GEB-TT > 64 THEN 020747 COMPUTE HFELD-GEB-TT = HFELD-GEB-TT - 64 020748 ELSE 020749 IF HFELD-GEB-TT > 32 THEN 020750 COMPUTE HFELD-GEB-TT = HFELD-GEB-TT - 32 020751 END-IF 020752 END-IF 020753** ------------------------------------------------------- 020754** GEBURTSDATUM SPEICHERN IN ZWISCHENFELD (WIRD N.VERÄND.) 020755** ------------------------------------------------------- 020756 MOVE HFELD-GEB TO SIC-GEB 020757 END-IF 020776 IF E12-MMAZ = "J" 020777 PERFORM DBAZ-PRUEF 020778 END-IF 020779 IF E12-MMEZ = "J" AND H-FENR-ANZ < 9 020780 PERFORM DBEZ-PRUEF 020781 END-IF 020782 END-IF 020783 . 020784 020785 020786 ABS-5-3-EXIT. 020790 EXIT. 020800 020900 021000**---------------------------------------------------------------- 021100** UNTERROUTINE : ABS-5-4 021110** FUNKTION : PRUEFEN DSKO 021120** VARIABLEN : 021130**---------------------------------------------------------------- 021140 ABS-5-4 SECTION. 021150 ABS-5-4A. 021160 PERFORM FDSKO500 021161 . 021190 021191 021192 ABS-5-4-EXIT. 021193 EXIT. 021194 021195 021200**---------------------------------------------------------------- 021300** UNTERROUTINE : DBME-PRUEF 021400** FUNKTION : PRueFEN DATENBAUSTEIN DBME 021500** VARIABLEN : 021600**---------------------------------------------------------------- 021700 DBME-PRUEF SECTION. 021710 DBME-PRUEFE. 021800 PERFORM FDBME010 021810 PERFORM FEHLER 021820 PERFORM FDBME020 021830 PERFORM FEHLER 021840 PERFORM FDBME030 021850 PERFORM FEHLER 021860 PERFORM FDBME050 021870** PERFORM FEHLER 021880 PERFORM FDBME070 021890 PERFORM FEHLER 021891 PERFORM FDBME080 021892 PERFORM FEHLER 021893 PERFORM FDBME090 021894 PERFORM FEHLER 021895 PERFORM FDBME110 021896** PERFORM FEHLER 021897 PERFORM FDBME140 021898 PERFORM FEHLER 021899 PERFORM FDBME160 021900 PERFORM FEHLER 021901 PERFORM FDBME170 021902 PERFORM FEHLER 021903 PERFORM FDBMEBBG 021904 PERFORM FEHLER 021910 . 022000 DBME-PRUEF-EXIT. 022100 EXIT. 022101**---------------------------------------------------------------- 022102** UNTERROUTINE : DBan-PRUEF 022103** FUNKTION : PRueFEN DATENBAUSTEIN DBan 022104** VARIABLEN : 022105**---------------------------------------------------------------- 022106 DBNA-PRUEF SECTION. 022107 DBNA-PRUEFE. 022108 PERFORM FDBNA010 022110 PERFORM FDBNA030 022111 PERFORM FEHLER 022112 PERFORM FDBNA040 022114 PERFORM FDBNA060 022116 PERFORM FDBNA080 022117 PERFORM FDBNA090 022118 PERFORM FEHLER 022119 . 022120 DBNA-PRUEF-EXIT. 022121 EXIT. 022122**---------------------------------------------------------------- 022123** UNTERROUTINE : DBGB-PRUEF 022124** FUNKTION : PRueFEN DATENBAUSTEIN DBGB 022125** VARIABLEN : 022126**---------------------------------------------------------------- 022127 DBGB-PRUEF SECTION. 022128 DBGB-PRUEFE. 022129 PERFORM FDBGB010 022130 PERFORM FDBGB040 022132 PERFORM FDBGB060 022133 PERFORM FDBGB100 022134 PERFORM FEHLER 022135 PERFORM FDBGB120 022136 PERFORM FEHLER 022137 PERFORM FDBGB140 022138 PERFORM FEHLER 022139 . 022140 DBGB-PRUEF-EXIT. 022141 EXIT. 022142**---------------------------------------------------------------- 022143** UNTERROUTINE : DBAN-PRUEF 022144** FUNKTION : PRueFEN DATENBAUSTEIN DBNA 022145** VARIABLEN : 022146**---------------------------------------------------------------- 022147 DBAN-PRUEF SECTION. 022148 DBAN-PRUEFE. 022149 PERFORM FDBAN010 022150 PERFORM FEHLER 022151 PERFORM FDBAN020 022152 PERFORM FEHLER 022153 PERFORM FDBAN120 022155 PERFORM FDBAN150 022156 PERFORM FDBAN170 022158 PERFORM FDBAN180 022159 . 022160 DBAN-PRUEF-EXIT. 022161 EXIT. 022162**---------------------------------------------------------------- 022163** UNTERROUTINE : DBEU-PRUEF 022164** FUNKTION : PRueFEN DATENBAUSTEIN DBEU 022165** VARIABLEN : 022166**---------------------------------------------------------------- 022167 DBEU-PRUEF SECTION. 022168 DBEU-PRUEFE. 022169 PERFORM FDBEU010 022170 PERFORM FEHLER 022171 . 022172 DBEU-PRUEF-EXIT. 022173 EXIT. 022174 022192**---------------------------------------------------------------- 022193** UNTERROUTINE : DBKS-PRUEF 022194** FUNKTION : PRueFEN DATENBAUSTEIN DBKS 022195** VARIABLEN : 022196**---------------------------------------------------------------- 022197 DBKS-PRUEF SECTION. 022198 DBKS-PRUEFE. 022199 PERFORM FDBKS010 022200 . 022201 DBKS-PRUEF-EXIT. 022202 EXIT. 022203**---------------------------------------------------------------- 022204** UNTERROUTINE : DBSV-PRUEF 022205** FUNKTION : PRueFEN DATENBAUSTEIN DBSV 022206** VARIABLEN : 022207**---------------------------------------------------------------- 022208 DBSV-PRUEF SECTION. 022209 DBSV-PRUEFE. 022210 PERFORM FDBSV010 022211 PERFORM FEHLER 022212 . 022213 DBSV-PRUEF-EXIT. 022214 EXIT. 022215**---------------------------------------------------------------- 022216** UNTERROUTINE : DBvr-PRUEF 022217** FUNKTION : PRUEFEN DATENBAUSTEIN DBVR 022218** VARIABLEN : 022219**---------------------------------------------------------------- 022220 DBVR-PRUEF SECTION. 022221 DBVR-PRUEFE. 022222 PERFORM FDBVR010 022223 PERFORM FEHLER 022224 PERFORM FDBVR030 022225 PERFORM FEHLER 022226 PERFORM FDBVR080 022227 PERFORM FEHLER 022228 . 022229 DBVR-PRUEF-EXIT. 022230 EXIT. 022231**---------------------------------------------------------------- 022232** UNTERROUTINE : DBRG-PRUEF 022233** FUNKTION : PRUEFEN DATENBAUSTEIN DBRG 022234** VARIABLEN : 022235**---------------------------------------------------------------- 022236 DBRG-PRUEF SECTION. 022237 DBRG-PRUEFE. 022238 PERFORM FDBRG300 022239 PERFORM FEHLER 022244 . 022245 DBRG-PRUEF-EXIT. 022246 EXIT. 022247**---------------------------------------------------------------- 022248** UNTERROUTINE : DBAZ-PRUEF 022249** FUNKTION : PRUEFEN DATENBAUSTEIN DBAZ 022250** VARIABLEN : 022251**---------------------------------------------------------------- 022252 DBAZ-PRUEF SECTION. 022253 DBAZ-PRUEFE. 022254 PERFORM FDBAZ010 022255 PERFORM FEHLER 022256 PERFORM FDBAZ020 022257 PERFORM FEHLER 022258 PERFORM FDBAZ030 022259 PERFORM FEHLER 022260 PERFORM FDBAZ040 022261 PERFORM FEHLER 022262 . 022263 DBAZ-PRUEF-EXIT. 022264 EXIT. 022265**---------------------------------------------------------------- 022266** UNTERROUTINE : DBEZ-PRUEF 022267** FUNKTION : PRueFEN DATENBAUSTEIN DBEZ 022268** VARIABLEN : 022269**---------------------------------------------------------------- 022270 DBEZ-PRUEF SECTION. 022271 DBEZ-PRUEFE. 022272 PERFORM FDBEZ010 022273 PERFORM FEHLER 022274 PERFORM FDBEZ020 022275 PERFORM FEHLER 022276 PERFORM FDBEZ030 022277 PERFORM FEHLER 022278 PERFORM FDBEZ040 022279 PERFORM FEHLER 022280 PERFORM FDBEZ050 022281 PERFORM FEHLER 022282 PERFORM FDBEZ080 022283 PERFORM FEHLER 022284 PERFORM FDBEZ090 022285 PERFORM FEHLER 022286 PERFORM FDBEZ100 022287 PERFORM FEHLER 022288 PERFORM FDBEZ160 022289 PERFORM FEHLER 022290 PERFORM FDBEZ180 022291 PERFORM FEHLER 022292 PERFORM FDBEZBBG 022293 PERFORM FEHLER 022294 . 022295 DBEZ-PRUEF-EXIT. 022296 EXIT. 022297**---------------------------------------------------------------- 022298** UNTERROUTINE : FEHLERILD 022299** FUNKTION : BILDEN DES FEHLERBAUSTEINS GEM H-FENR-TAB 022300** VARIABLEN : 022301**---------------------------------------------------------------- 022302 DBFE-BILD SECTION. 022303 DBFE-BILDE. 022304 IF H-FENR-ANZ > 0 022305** ---------------------------------------------------------- 022306** AUSGABE VON FEHLERNUMMERN 022307** ---------------------------------------------------------- 022309 MOVE H-FENR-ANZ TO H-FENR-SAVE 022410 ADD 1 TO SATZLG 022411 PERFORM VARYING H-FENR-ANZ FROM 1 BY 1 UNTIL 022412 H-FENR-ANZ > H-FENR-SAVE OR H-FENR-ANZ > 9 022430 PERFORM VARYING I-IND FROM 1 BY 1 UNTIL 022431 H-FENR(H-FENR-ANZ) = FEHLERNR(I-IND) OR 022432 FEHLERNR(I-IND) = "XXXXXXX" 022433 CONTINUE 022434 END-PERFORM 022435 MOVE "DBFE" TO EIN-SATZ(SATZLG:4) 022436 ADD 4 TO SATZLG 022437 MOVE FEHLERELEM(I-IND) TO EIN-SATZ(SATZLG:72) 022438 IF FEHLERNR(I-IND) = "XXXXXXX" THEN 022439 MOVE H-FENR(H-FENR-ANZ) TO EIN-SATZ(SATZLG:72) 022440 END-IF 022441 ADD 72 TO SATZLG 022443 END-PERFORM 022444 MOVE "1" TO EIN-SATZ(62:1) 022445 MOVE H-FENR-SAVE-2 TO EIN-SATZ(63:1) 022446 IF H-FENR-SAVE > 9 THEN 022447 MOVE "9" TO EIN-SATZ(63:1) 022448** ---------------------------------------------------- 022449** SATZLÄNGE UM DAS NEUNTE ELEMENT VERRINGERN 022450** ---------------------------------------------------- 022451 COMPUTE SATZLG = SATZLG - 76 022452 IF ST-DSME THEN 022453 PERFORM VARYING I-IND FROM 1 BY 1 UNTIL 022454 FEHLERNR(I-IND) = "DSME920" 022455 CONTINUE 022456 END-PERFORM 022457 MOVE "DBFE" TO EIN-SATZ(SATZLG:4) 022458 ADD 4 TO SATZLG 022459 MOVE FEHLERELEM(I-IND) TO EIN-SATZ(SATZLG:72) 022460 ADD 72 TO SATZLG 022461 ELSE 022462 PERFORM VARYING I-IND FROM 1 BY 1 UNTIL 022463 FEHLERNR(I-IND) = "DSAE920" 022464 CONTINUE 022465 END-PERFORM 022466 MOVE "DBFE" TO EIN-SATZ(SATZLG:4) 022467 ADD 4 TO SATZLG 022468 MOVE FEHLERELEM(I-IND) TO EIN-SATZ(SATZLG:72) 022469 ADD 72 TO SATZLG 022470 END-IF 022471 END-IF 022472 SUBTRACT 1 FROM SATZLG 022473 MOVE SATZLG TO EIN-LG 022474 IF RC-SAVE = 9000 THEN 022475 MOVE RC-SAVE TO P-RC 022476 ELSE 022477 MOVE 1000 TO P-RC 022478 END-IF 022479 ELSE 022480 IF H-HINW-ANZ > 0 THEN 022481** ------------------------------------------------------- 022482** KEINE FEHLER-NUMMERN VORHANDEN 022483** ------------------------------------------------------- 022484 MOVE H-HINW-ANZ TO H-FENR-SAVE 022489 ADD 1 TO SATZLG 022490 PERFORM VARYING H-HINW-ANZ FROM 1 BY 1 UNTIL 022491 H-HINW-ANZ > H-FENR-SAVE OR H-HINW-ANZ > 9 022492 PERFORM VARYING I-IND FROM 1 BY 1 UNTIL 022493 H-HINW(H-HINW-ANZ) = FEHLERNR(I-IND) OR 022494 FEHLERNR(I-IND) = "XXXXXXX" 022495 CONTINUE 022496 END-PERFORM 022497 MOVE "DBFE" TO EIN-SATZ(SATZLG:4) 022498 ADD 4 TO SATZLG 022499 MOVE FEHLERELEM(I-IND) TO EIN-SATZ(SATZLG:72) 022500 IF FEHLERNR(I-IND) = "XXXXXXX" THEN 022501 MOVE H-HINW(H-HINW-ANZ) TO EIN-SATZ(SATZLG:72) 022502 END-IF 022503 ADD 72 TO SATZLG 022505 END-PERFORM 022506 MOVE "3" TO EIN-SATZ(62:1) 022507 MOVE H-FENR-SAVE-2 TO EIN-SATZ(63:1) 022508 IF H-FENR-SAVE > 9 THEN 022509 MOVE "9" TO EIN-SATZ(63:1) 022510** ------------------------------------------------- 022511** SATZLÄNGE UM DAS NEUNTE ELEMENT VERRINGERN 022512** ------------------------------------------------- 022513 COMPUTE SATZLG = SATZLG - 76 022514 IF ST-DSME THEN 022515 PERFORM VARYING I-IND FROM 1 BY 1 UNTIL 022516 FEHLERNR(I-IND) = "DSME922" 022517 CONTINUE 022518 END-PERFORM 022519 MOVE "DBFE" TO EIN-SATZ(SATZLG:4) 022520 ADD 4 TO SATZLG 022521 MOVE FEHLERELEM(I-IND) TO EIN-SATZ(SATZLG:72) 022522 ADD 72 TO SATZLG 022523 ELSE 022524 PERFORM VARYING I-IND FROM 1 BY 1 UNTIL 022525 FEHLERNR(I-IND) = "DSAE922" 022526 CONTINUE 022527 END-PERFORM 022528 MOVE "DBFE" TO EIN-SATZ(SATZLG:4) 022529 ADD 4 TO SATZLG 022530 MOVE FEHLERELEM(I-IND) TO EIN-SATZ(SATZLG:72) 022531 ADD 72 TO SATZLG 022532 END-IF 022533 END-IF 022534 SUBTRACT 1 FROM SATZLG 022535 MOVE SATZLG TO EIN-LG 022536 IF RC-SAVE = 9000 THEN 022537 MOVE RC-SAVE TO P-RC 022538 ELSE 022539 MOVE 2000 TO P-RC 022540 END-IF 022541 END-IF 022542 END-IF 022543 . 022544 DBFE-BILD-EXIT. 022545 EXIT. 022546**---------------------------------------------------------------- 022547** UNTERROUTINE : FEHLER 022548** FUNKTION : Belegen der Fehlertab 022549**---------------------------------------------------------------- 022550 FEHLER SECTION. 022551 FEHLERE. 022552 IF H-FNR NOT = SPACE THEN 022553 IF H-FEHLER(5:1) NOT = "H" THEN 022554 ADD 1 TO H-FENR-ANZ 022555 IF H-FENR-ANZ <= 9 022556 MOVE H-FEHLER TO H-FENR(H-FENR-ANZ) 022557 END-IF 022558 MOVE SPACES TO H-FNR 022559 ELSE 022560 ADD 1 TO H-HINW-ANZ 022561 IF H-HINW-ANZ <= 9 022562 MOVE H-FEHLER TO H-HINW(H-HINW-ANZ) 022563 END-IF 022564 MOVE SPACES TO H-FNR 022565 END-IF 022566 END-IF 022567 MOVE 0 TO HFELD-S 022568 . 022569 FEHLER-EXIT. 022570 EXIT. 022572*COPY CDSME020 REPLACING ==:S0:== BY ==E1==. 000100**---------------------------------------------------------------- 000200** COPY-MEMBER : CDSME020 000300** PROGRAMMIERER : WERNER KRAUS 000400** ERSTELLUNGSDATUM : 09.02.1998 000500** VERSION : 001 (PGM-NEUERSTELLUNG) 000600** FUNKTION : FEHLERPRüFUNG BBNRAB-NUM IN DSME 000700**---------------------------------------------------------------- 000800** PROGRAMMIERER : MICHAEL KLEMKE 000900** ERSTELLUNGSDATUM : 17.04.2002 001000** VERSION : 002 001100** FUNKTION : ERWEITERUNG DER BETRIEBSNUMMERN 001200**---------------------------------------------------------------- 001300** PROGRAMMIERER : MICHAEL KLEMKE 001400** ERSTELLUNGSDATUM : 20.10.2003 001500** VERSION : 003 / 036 001700**---------------------------------------------------------------- 001800** PROGRAMMIERER : MICHAEL KLEMKE 001900** ERSTELLUNGSDATUM : 14.07.2006 002000** VERSION : 004 / 055 002100**---------------------------------------------------------------- 002200** PROGRAMMIERER : MICHAEL KLEMKE 002300** ERSTELLUNGSDATUM : 10.10.2006 002400** VERSION : 005 / 056 002500**---------------------------------------------------------------- 043900 FDSME020 SECTION. 043910 FDSME020E. 043920 IF E1-BBNRAB-NUM-1-8 NUMERIC THEN 043921** ---------------------------------------------------------- 043922 IF (E1-BBNRAB-NUM(1:3) >= "001" AND <= "099") OR 043923 (E1-BBNRAB-NUM(1:3) > "110") 043924 043925 MOVE E1-BBNRAB-NUM-1-7 TO ZIFFER-TABELLE 043926 MOVE 0 TO HILFSFELD 043927 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 043928 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 043929 END-COMPUTE 043930 COMPUTE HILFSFELD = HILFSFELD + QUERSUMME-1 043931 + QUERSUMME-2 043932 END-COMPUTE 043933 END-PERFORM 043934 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 043935 COMPUTE RESTB = REST + 5 END-COMPUTE 043936 IF E1-BBNRAB-NUM-8 = REST OR 043937 E1-BBNRAB-NUM-8 = RESTBR2 THEN 043938** ---------------------------------------------------- 043939** BETRIEBSNUMMER DES ABSENDERS FEHLERFREI 043940** ---------------------------------------------------- 043941 IF OP-BATRV 043942 IF E1-BBNRAB-NUM-1-8 = "76641777" 043943 CONTINUE 043944 ELSE 043948 IF E1-BBNRAB-NUM-1-8 = "12621621" 043949 IF ST-DSAE 043950 CONTINUE 043951 ELSE 043952 MOVE "DSME022" TO H-FEHLER 043954 END-IF 043955 ELSE 043956 MOVE "DSME022" TO H-FEHLER 043957 END-IF 043958 END-IF 043959 ELSE 043960** --------------------------------------------------- 043961** T52111 043962** --------------------------------------------------- 043963 IF OP-BWTRV 043964 IF E1-BBNRAB-NUM-1-8 = "32349289" THEN 043965 CONTINUE 043966 ELSE 043967 MOVE "DSME022" TO H-FEHLER 043968 END-IF 043969 ELSE 043970 IF OP-BZTRV 043971 IF E1-BBNRAB-NUM-1-8 = "38065304" THEN 043972 CONTINUE 043973 ELSE 043974 MOVE "DSME022" TO H-FEHLER 043975 END-IF 043976 ELSE 043977** ----------------------------------------------- 043978** T52112 043979** ----------------------------------------------- 043980 IF OP-PVTRV 043981 IF E1-BBNRAB-NUM(1:3) = "996" THEN 043982 CONTINUE 043983 ELSE 043984 MOVE "DSME022" TO H-FEHLER 043985 END-IF 043986 ELSE 043987 IF OP-KSTRV 043988 IF E1-BBNRAB-NUM-1-8 = "28180427" 043989 CONTINUE 043990 ELSE 043991 MOVE "DSME022" TO H-FEHLER 043992 END-IF 043993 ELSE 043994** ------------------------------------------- 043995** T52114 043996** ------------------------------------------- 043997 IF OP-UETBF 043998 IF E1-BBNRAB-NUM-1-8 = "98503184" OR 043999 E1-BBNRAB-NUM-1-8 = "98702232" THEN 044000 CONTINUE 044001 ELSE 044002 MOVE "DSME022" TO H-FEHLER 044003 END-IF 044004 ELSE 044005** ------------------------------------------ 044006** T52115 044007** ------------------------------------------ 044008 IF OP-ZFTRV 044009 IF E1-BBNRAB-NUM-1-8 = "02998824" 044010 CONTINUE 044011 ELSE 044012 MOVE "DSME022" TO H-FEHLER 044013 END-IF 044016 END-IF 044017 END-IF 044018 END-IF 044019 END-IF 044021 END-IF 044022 END-IF 044023 END-IF 044024 ELSE 044025 MOVE "DSME020" TO H-FEHLER 044026 END-IF 044027 ELSE 044028 MOVE "DSME020" TO H-FEHLER 044029 END-IF 044030 ELSE 044031 MOVE "DSME020" TO H-FEHLER 044033 END-IF 044034 . 044040 044100 044930 FDSME020-EXIT. 044940 EXIT. 022580*COPY CDSME030 REPLACING ==:S0:== BY ==E1==. 044960**---------------------------------------------------------------- 044970** COPY-MEMBER : CDSME030 044980** PROGRAMMIERER : WERNER KRAUS 044990** ERSTELLUNGSDATUM : 09.02.1998 045000** VERSION : 001 (PGM-NEUERSTELLUNG) 045010** FUNKTION : FEHLERPRüFUNG BBNREP-NUM IN DSME 045011**---------------------------------------------------------------- 045012** PROGRAMMIERER : GERTRAUD SCHUHMACHER 045013** ÄNDERUNG : 001 VOM 30.04.2001 VERSION 24 045020**---------------------------------------------------------------- 045021** PROGRAMMIERER : MICHAEL KLEMKE 045022** ÄNDERUNG : 002 VOM 20.10.2003 VERSION 36 045023**---------------------------------------------------------------- 045024** PROGRAMMIERER : MICHAEL KLEMKE 045025** ÄNDERUNG : 003 VOM 06.12.2004 VERSION 42 045026**---------------------------------------------------------------- 045027** PROGRAMMIERER : MICHAEL KLEMKE 045028** ÄNDERUNG : 004 VOM 10.10.2006 VERSION 56 045029**---------------------------------------------------------------- 045030 FDSME030 SECTION. 045040 FDSME030E. 045050 IF E1-BBNREP-NUM-1-8 NUMERIC THEN 045054 045090 MOVE E1-BBNREP-NUM-1-7 TO ZIFFER-TABELLE 045100 MOVE 0 TO HILFSFELD 045110 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 045120 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 045130 END-COMPUTE 045140 COMPUTE HILFSFELD = HILFSFELD 045141 + QUERSUMME-1 045150 + QUERSUMME-2 045160 END-COMPUTE 045170 END-PERFORM 045180 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 045190 COMPUTE RESTB = REST + 5 END-COMPUTE 045200 IF E1-BBNREP-NUM-8 = REST OR 045210 E1-BBNREP-NUM-8 = RESTBR2 THEN 045240* ----------------------------------------------------- 045241* T52121 045242* ----------------------------------------------------- 045250 IF OP-KVTWL OR OP-KVTRV THEN 045251 IF E1-BBNREP-NUM-1-8 NOT = "66667777" 045253 MOVE "DSME032" TO H-FEHLER 045255 END-IF 045256 ELSE 045257* -------------------------------------------------- 045258* ÄNDERUNG VOM 20.10.2003 / VERSION 36 045259* -------------------------------------------------- 045260 IF OP-ZFTRV THEN 045261 IF E1-BBNREP-NUM-1-8 NOT = "90209055" THEN 045262 MOVE "DSME032" TO H-FEHLER 045264 END-IF 045265 END-IF 045266* -------------------------------------------------- 045269 END-IF 045270 IF H-FEHLER NOT = "DSME032" 045272* -------------------------------------------------- 045273* T52122 045274* -------------------------------------------------- 045276 IF OP-BATRV OR OP-KTTRV 045277 IF E1-BBNREP-NUM-1-8 NOT = "66667777" 045279 MOVE "DSME032" TO H-FEHLER 045281 END-IF 045282 ELSE 045284 IF OP-RVTBA THEN 045285 IF E1-BBNREP-NUM-1-8 NOT = "76641777" THEN 045286 MOVE "DSME032" TO H-FEHLER 045288 END-IF 045289 END-IF 045290 END-IF 045291 END-IF 045292* ----------------------------------------------------- 045293 ELSE 045294 MOVE "DSME030" TO H-FEHLER 045296 END-IF 045298 ELSE 045299 MOVE "DSME030" TO H-FEHLER 045300 END-IF 045301 . 045302 045303 045310 FDSME030-EXIT. 045400 EXIT. 022600*COPY CDSME040 REPLACING ==:S0:== BY ==E1==. 045310**---------------------------------------------------------------- 045320** COPY-MEMBER : CDSME040 045330** PROGRAMMIERER : WERNER KRAUS 045340** ERSTELLUNGSDATUM : 09.02.1998 045350** VERSION : 001 (PGM-NEUERSTELLUNG) 045360** FUNKTION : FEHLERPRüFUNG VERSINSNUMMER 045370**---------------------------------------------------------------- 045380 FDSME040 SECTION. 045390 FDSME040E. 045400 IF E1-VERNR NOT NUMERIC 045410 MOVE "DSME040" TO H-FEHLER 045420 ELSE IF 045430 E1-VERNR NOT EQUAL 01 045440 MOVE "DSME042" TO H-FEHLER 045450 END-IF 045460 . 045470 FDSME040-EXIT. 045480 EXIT. 022610*COPY CDSME050 REPLACING ==:S0:== BY ==E1==. 045680**---------------------------------------------------------------- 045690** COPY-MEMBER : CDSME050 045700** PROGRAMMIERER : WERNER KRAUS 045710** ERSTELLUNGSDATUM : 09.02.1998 045720** VERSION : 001 (PGM-NEUERSTELLUNG) 045730** FUNKTION : FEHLERPRüFUNG DATUM-ERSTELLUNG 045740** DATENDEFINITION IM COPYMEMBER DDSME050 045741**---------------------------------------------------------------- 045742** PROGRAMMIERER : GERTRAUD SCHUHMACHER 045743** ÄNDERUNG : 001 VOM 30.04.2001 VERSION 24 045750**---------------------------------------------------------------- 046000** PROGRAMMIERER : MICHAEL KLEMKE 046100** ÄNDERUNG : 002 VOM 11.10.2004 VERSION 41 046200**---------------------------------------------------------------- 046300 FDSME050 SECTION. 046400 FDSME050E. 046500 SET NOT-DSME05X-VOR TO TRUE 046600 IF E1-ED NUMERIC THEN 046800 DIVIDE 4 INTO E1-HJJ GIVING ERG REMAINDER SCHALTJAHR 046900 IF E1-HMM > ZERO AND < 13 047000 AND E1-HTT > ZERO 047100 AND <= TGT(SCHALTJAHR + 1, E1-HMM) THEN 047200 IF E1-HDAT > P-DATE 047300 MOVE "DSME054" TO H-FEHLER 047400 SET DSME05X-VORH TO TRUE 047500 PERFORM FEHLER 047600 END-IF 047700 ELSE 047800 MOVE "DSME052" TO H-FEHLER 047900 SET DSME05X-VORH TO TRUE 048000 PERFORM FEHLER 048100 END-IF 048200 IF E1-HSTD > 23 OR 048300 E1-HMIN >= 60 OR 048400 E1-HSEK >= 60 THEN 048500 MOVE "DSME056" TO H-FEHLER 048600 SET DSME05X-VORH TO TRUE 048700 PERFORM FEHLER 048800 END-IF 048900 IF NOT-DSME05X-VOR 049000 IF OP-AGDEU OR OP-WLTKV 049100 CONTINUE 049200 ELSE 049300 IF E1-HDAT = P-DATE THEN 049400 IF NOT ST-DSKO 049500 IF E1-HUHR >= P-TIME THEN 049600 MOVE "DSME058" TO H-FEHLER 049700 PERFORM FEHLER 049800 END-IF 049900 END-IF 050000 END-IF 050100 END-IF 050200 END-IF 050300 ELSE 050400 MOVE "DSME050" TO H-FEHLER 050500 END-IF 050600 . 050700 050800 050900 FDSME050-EXIT. 051000 EXIT. 051100 051200 022630*COPY CDSME060 REPLACING ==:S0:== BY ==E1==. 045920**---------------------------------------------------------------- 045930** COPY-MEMBER : CDSME060 045940** PROGRAMMIERER : WERNER KRAUS 045950** ERSTELLUNGSDATUM : 10.02.1998 045960** VERSION : 001 (PGM-NEUERSTELLUNG) 045970** FUNKTION : FEHLERPRüFUNG FEHLERKENNZEICHEN 045980** DATENDEFINITION IM COPYMEMBER DDSME060 045990**---------------------------------------------------------------- 045991** PROGRAMMIERER : MICHAEL KLEMKE 045992** ÄNDERUNG : 11.10.2004 045993** VERSION : 002 / VERSION 41 045994**---------------------------------------------------------------- 046000 FDSME060 SECTION. 046010 FDSME060E. 046110 IF E1-FEKZ NUMERIC THEN 046120 IF E1-FEAN NUMERIC THEN 046130 IF E1-FEAN = 0 046140 IF E1-FEKZ = 0 OR 1 OR 2 OR 3 OR 4 046150 CONTINUE 046160 ELSE 046161 MOVE "DSME062" TO H-FEHLER 046162 END-IF 046163 ELSE 046164 MOVE "DSME072" TO H-FEHLER 046165 END-IF 046166 ELSE 046167 MOVE "DSME070" TO H-FEHLER 046168 END-IF 046169 ELSE 046170 MOVE "DSME060" TO H-FEHLER 046171 END-IF 046172 . 046173 046174 046180 FDSME060-EXIT. 046190 EXIT. 022640*COPY CDSME080 REPLACING ==:S0:== BY ==E1==. 046210**---------------------------------------------------------------- 046220** COPY-MEMBER : CDSME080 046230** PROGRAMMIERER : WERNER KRAUS 046240** ERSTELLUNGSDATUM : 10.02.1998 046250** VERSION : 001 046260** FUNKTION : FEHLERPRüFUNG VSNR 046270**---------------------------------------------------------------- 046272** PROGRAMMIERER : MICHAEL KLEMKE 046273** ERSTELLUNGSDATUM : 20.10.2003 046274** VERSION : 002 046276**---------------------------------------------------------------- 046277** PROGRAMMIERER : MICHAEL KLEMKE 046278** ERSTELLUNGSDATUM : 06.12.2004 046279** VERSION : 003 / VERSION 42 046280**---------------------------------------------------------------- 046281** PROGRAMMIERER : MICHAEL KLEMKE 046282** ERSTELLUNGSDATUM : 10.10.2006 046283** VERSION : 004 / VERSION 56 046284**---------------------------------------------------------------- 046285** PROGRAMMIERER : MICHAEL KLEMKE 046286** AENDERUNGSDATUM : 28.02.2007 046287** VERSION : 005 / VERSION 60 046288**---------------------------------------------------------------- 046289** PROGRAMMIERER : MICHAEL KLEMKE 046290** AENDERUNGSDATUM : 18.04.2007 046291** VERSION : 006 / VERSION 62 046292**---------------------------------------------------------------- 046293 FDSME080 SECTION. 046294 FDSME080E. 046300 MOVE E1-VSNR TO HVSNR 046400 IF E1-VSNR = SPACE THEN 046500 IF ST-DSAE THEN 046600 MOVE "DSME082" TO H-FEHLER 046700 MOVE "N" TO HFELD-P-GBDT 046800 GO TO FDSME080-EXIT 046900 ELSE 047000 IF OP-AGDEU OR OP-KVDEU OR OP-WLTKV OR OP-KSTKV THEN 047100 MOVE "N" TO HFELD-P-GBDT 047200 GO TO FDSME080-EXIT 047300 ELSE 047400 MOVE "DSME080" TO H-FEHLER 047500 MOVE "N" TO HFELD-P-GBDT 047600 GO TO FDSME080-EXIT 047700 END-IF 047800 END-IF 047900 ELSE 048000 IF HVSNRNUM1 NOT NUMERIC OR HVSNRNUM2 NOT NUMERIC OR 048100 HVSNR2 NOT VSNRBUCHSTABE 048200 MOVE "DSME082" TO H-FEHLER 048300 MOVE "N" TO HFELD-P-GBDT 048400 GO TO FDSME080-EXIT 048500 ELSE 048510* ----------------------------------------------------- 048520* T52210 048530* ----------------------------------------------------- 048531 IF ST-DSME THEN 048532 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB0 048533 IF BNR-TAB0-OK THEN 048540 SET PRUEF-T52211 TO TRUE 048550 ELSE 048551 IF HVSNR1(1:2) = "40" 048552 SET PRUEF-T52211 TO TRUE 048553 ELSE 048554 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB1 048555 IF BNR1-OK 048556 SET PRUEF-T52212 TO TRUE 048557 ELSE 048558 MOVE "DSME084" TO H-FEHLER 048559 MOVE "N" TO HFELD-P-GBDT 048560 GO TO FDSME080-EXIT 048561 END-IF 048562 END-IF 048563 END-IF 048564 ELSE 048565 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB0 048566 IF BNR-TAB0-OK THEN 048567 SET PRUEF-T52211 TO TRUE 048568 ELSE 048569 MOVE "DSME084" TO H-FEHLER 048570 MOVE "N" TO HFELD-P-GBDT 048571 GO TO FDSME080-EXIT 048572 END-IF 048573 END-IF 048574* ----------------------------------------------------- 048575* T52210 ENDE 048576* ----------------------------------------------------- 048580 048700 IF PRUEF-T52211 THEN 048710* -------------------------------------------------- 048720* T52211 048730* -------------------------------------------------- 048800 IF ST-DSME THEN 048900 IF OP-BATRV OR OP-KTTRV 049000 MOVE "DSME092" TO H-FEHLER 049100 PERFORM FEHLER 049200 MOVE "N" TO HFELD-P-GBDT 049400 ELSE 050100 PERFORM T522111-E1 050300 END-IF 050400 ELSE 050500 PERFORM T522111-E1 050600 END-IF 050610* -------------------------------------------------- 050620* T5221-1 - ENDE 050630* -------------------------------------------------- 050700 ELSE 051310* -------------------------------------------------- 051320* T52212 051330* -------------------------------------------------- 051500 IF OP-AGDEU OR OP-KSTKV THEN 051600 MOVE "DSME090" TO H-FEHLER 051700 MOVE "N" TO HFELD-P-GBDT 051800 GO TO FDSME080-EXIT 051900 END-IF 052000 IF HVSNRGEBMM < 00 OR > 12 THEN 052100 MOVE "DSME096" TO H-FEHLER 052200 MOVE "N" TO HFELD-P-GBDT 052300 GO TO FDSME080-EXIT 052400 END-IF 052500 IF HVSNRGEBTT > 95 AND NOT EQUAL 97 THEN 052600 MOVE "DSME096" TO H-FEHLER 052700 MOVE "N" TO HFELD-P-GBDT 052800 GO TO FDSME080-EXIT 052900 END-IF 053000 IF HVSNRGEBTT = 97 AND 053100 HVSNRGEBMM < 01 OR > 12 053200 MOVE "DSME096" TO H-FEHLER 053300 MOVE "N" TO HFELD-P-GBDT 053400 GO TO FDSME080-EXIT 053500 END-IF 053511 IF (HVSNRGEBTT > ZERO AND HVSNRGEBTT <= 31) AND 053512 (HVSNRGEBMM > ZERO AND HVSNRGEBMM <= 12) THEN 053520 MOVE 0 TO HFELD-GEB 053530 MOVE HVSNRGEBJJ TO HFELD-GEB-JJ 053540 MOVE HVSNRGEBMM TO HFELD-GEB-MM 053550 MOVE HVSNRGEBTT TO HFELD-GEB-TT 053560 DIVIDE 4 INTO HFELD-GEB-JJ GIVING ERG 053570 REMAINDER SCHALTJAHR 053580 IF HFELD-GEB-MM > ZERO AND < 13 053590 AND HFELD-GEB-TT > ZERO 053591 AND <= TGT(SCHALTJAHR + 1, HFELD-GEB-MM) THEN 053592 CONTINUE 053593 ELSE 053594 MOVE "DSME096" TO H-FEHLER 053595 MOVE "N" TO HFELD-P-GBDT 053596 GO TO FDSME080-EXIT 053598 END-IF 053599 END-IF 053610 IF OP-PVTRV THEN 053700 IF HVSNRBNR NOT EQUAL 94 THEN 053800 MOVE "DSME112" TO H-FEHLER 053900 END-IF 054100 GO TO FDSME080-EXIT 054300 ELSE 054400 MOVE HVSNRNUM1 TO ZIFF-1-8 054500 MOVE HVSNRSS TO ZIFF-11-12 054600 MOVE 1 TO I 054700 MOVE 0 TO SX-BUCHSTABE 054800 PERFORM UNTIL I > 26 054900 OR BUCHSTABE-GEFUNDEN 055000 IF HVSNR2 = ALPHA-B(I) 055100 MOVE I TO ZIFF-9-A2 055200 MOVE 1 TO SX-BUCHSTABE 055300 END-IF 055400 ADD 1 TO I 055500 END-PERFORM 055600 MOVE 0 TO HILFSFELD 055700 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 12 055800 COMPUTE QUERSUMME = ZIFFER(I) * 055900 FAKTOR-VSNR(I) 056000 END-COMPUTE 056100 COMPUTE HILFSFELD = QUERSUMME-1 + 056200 QUERSUMME-2 + 056300 HILFSFELD 056400 END-COMPUTE 056500 END-PERFORM 056600 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER 056700 REST 056800 IF REST NOT EQUAL HVSNRPR 056900 MOVE "DSME088" TO H-FEHLER 057000 GO TO FDSME080-EXIT 057100 END-IF 057110* -------------------------------------------- 057120* T52213 057130* -------------------------------------------- 057200 IF E1-BBNRAB = 98000006 OR 057300 E1-BBNRAB = 99086875 OR 057310 E1-BBNRAB = 98000001 THEN 057400 IF HVSNRBNR = 00 THEN 057500 GO TO FDSME080-EXIT 057600 ELSE 057700 MOVE "DSME100" TO H-FEHLER 057800 GO TO FDSME080-EXIT 057900 END-IF 058000 END-IF 058100 IF OP-KSTRV THEN 058200 IF HVSNRBNR = 77 THEN 058300 GO TO FDSME080-EXIT 058400 ELSE 058500 MOVE "DSME102" TO H-FEHLER 058600 GO TO FDSME080-EXIT 058700 END-IF 058800 END-IF 058810* -------------------------------------------- 058820* T52214 058830* -------------------------------------------- 058900 IF OP-KVTRV THEN 059000 IF HVSNRBNR >= 83 AND <= 87 THEN 059100 GO TO FDSME080-EXIT 059200 ELSE 059300 MOVE "DSME104" TO H-FEHLER 059400 GO TO FDSME080-EXIT 059500 END-IF 059510 ELSE 059700 IF OP-BATRV OR OP-KTTRV 059800 IF HVSNRBNR = 88 THEN 059900 GO TO FDSME080-EXIT 060000 ELSE 060100 MOVE "DSME106" TO H-FEHLER 060200 GO TO FDSME080-EXIT 060300 END-IF 060400 END-IF 060401 END-IF 060410* -------------------------------------------- 060420* T52215 060430* -------------------------------------------- 060500 IF OP-BWTRV THEN 060600 IF HVSNRBNR = 91 THEN 060700 GO TO FDSME080-EXIT 060800 ELSE 060900 MOVE "DSME108" TO H-FEHLER 061000 GO TO FDSME080-EXIT 061100 END-IF 061200 END-IF 061300 IF OP-BZTRV THEN 061400 IF HVSNRBNR = 92 THEN 061500 GO TO FDSME080-EXIT 061600 ELSE 061700 MOVE "DSME110" TO H-FEHLER 061800 GO TO FDSME080-EXIT 061900 END-IF 062000 END-IF 062010* -------------------------------------------- 062020* T52216 062030* -------------------------------------------- 062810 IF OP-ZFTRV OR OP-RVTZF 062820 IF HVSNRBNR = 41 THEN 062830 GO TO FDSME080-EXIT 062840 ELSE 062850 MOVE "DSME099" TO H-FEHLER 062860 GO TO FDSME080-EXIT 062870 END-IF 062871 ELSE 062872 IF HVSNRBNR = 41 THEN 062873 MOVE "DSME101" TO H-FEHLER 062878 END-IF 062879 GO TO FDSME080-EXIT 062890 END-IF 062891* -------------------------------------------- 062900 END-IF 063100 END-IF 063200 END-IF 063300 END-IF 063400 . 063500 FDSME080-EXIT. 063600 EXIT. 063610 063620 063700 T522111-E1 SECTION. 063800 T522111-E1E. 063900 IF HVSNRGEBMM < 00 OR > 12 THEN 064000 MOVE "DSME086" TO H-FEHLER 064100 MOVE "N" TO HFELD-P-GBDT 064200 GO TO T522111-E1-EXIT 064300 END-IF 064400 IF HVSNRGEBTT > 95 AND NOT EQUAL 97 THEN 064500 MOVE "DSME086" TO H-FEHLER 064600 MOVE "N" TO HFELD-P-GBDT 064700 GO TO T522111-E1-EXIT 064800 END-IF 064900 IF HVSNRGEBTT = 97 AND 065000 HVSNRGEBMM < 01 OR > 12 THEN 065100 MOVE "DSME086" TO H-FEHLER 065200 MOVE "N" TO HFELD-P-GBDT 065300 GO TO T522111-E1-EXIT 065400 END-IF 065402 IF (HVSNRGEBTT > ZERO AND HVSNRGEBTT <= 31) AND 065403 (HVSNRGEBMM > ZERO AND HVSNRGEBMM <= 12) THEN 065404 MOVE 0 TO HFELD-GEB 065405 MOVE HVSNRGEBJJ TO HFELD-GEB-JJ 065406 MOVE HVSNRGEBMM TO HFELD-GEB-MM 065407 MOVE HVSNRGEBTT TO HFELD-GEB-TT 065408 DIVIDE 4 INTO HFELD-GEB-JJ GIVING ERG 065409 REMAINDER SCHALTJAHR 065410 IF HFELD-GEB-MM > ZERO AND < 13 065411 AND HFELD-GEB-TT > ZERO 065412 AND <= TGT(SCHALTJAHR + 1, HFELD-GEB-MM) THEN 065420 CONTINUE 065430 ELSE 065440 MOVE "DSME086" TO H-FEHLER 065450 MOVE "N" TO HFELD-P-GBDT 065451 GO TO T522111-E1-EXIT 065452 END-IF 065453 END-IF 065500 MOVE HVSNRNUM1 TO ZIFF-1-8 065600 MOVE HVSNRSS TO ZIFF-11-12 065700 MOVE 1 TO I 065800 MOVE 0 TO SX-BUCHSTABE 065900 PERFORM UNTIL I > 26 066000 OR BUCHSTABE-GEFUNDEN 066100 IF HVSNR2 = ALPHA-B(I) 066200 MOVE I TO ZIFF-9-A2 066300 MOVE 1 TO SX-BUCHSTABE 066400 END-IF 066500 ADD 1 TO I 066600 END-PERFORM 066700 MOVE 0 TO HILFSFELD 066800 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 12 066900 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR-VSNR(I) 067000 END-COMPUTE 067100 COMPUTE HILFSFELD = QUERSUMME-1 + QUERSUMME-2 + 067200 HILFSFELD 067300 END-COMPUTE 067400 END-PERFORM 067500 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER 067600 REST 067700 IF REST NOT EQUAL HVSNRPR 067800 MOVE "DSME088" TO H-FEHLER 067900 MOVE "N" TO HFELD-P-GBDT 068000 GO TO T522111-E1-EXIT 068100 ELSE 068101* -------------------------------------------------------- 068102* ÄNDERUNG VOM 20.10.2003 / VERSION 36 068103* -------------------------------------------------------- 068104* T522112 068105* -------------------------------------------------------- 068106 IF HVSNR1(1:2) = "40" AND NOT OP-ZFTRV AND NOT OP-RVTZF 068107 MOVE "DSME085" TO H-FEHLER 068109 GO TO T522111-E1-EXIT 068110 ELSE 068111* ----------------------------------------------------- 068112* T522113 068113* ----------------------------------------------------- 068120 IF HVSNR = "12140421E115" OR "12140441E119" OR 068121 "39180607P581" OR "39180607S584" OR 068122 "65010166L519" OR "13010181R009" OR 068123 "13010481R002" OR "13160481R002" OR 068124 "13010581R003" OR "13130681R007" OR 068125 "12140461E114" OR "12140481E118" THEN 068126 MOVE "DSME089" TO H-FEHLER 068127 GO TO T522111-E1-EXIT 068300 END-IF 068310 END-IF 068311* -------------------------------------------------------- 068320 END-IF 068400 . 068500 T522111-E1-EXIT. 068600 EXIT. 022641*COPY CDSME120 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME120 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG PERSGR 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 20.10.2003 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 06.12.2004 001680** VERSION : 003 / 42 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ERSTELLUNGSDATUM : 07.02.2005 001693** VERSION : 004 / 43 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** ERSTELLUNGSDATUM : 18.10.2005 001697** VERSION : 005 / 50 001698**---------------------------------------------------------------- 001700 FDSME120 SECTION. 001710 FDSME120E. 001730 IF E1-VSTR = "0A" OR "0B" OR "0C" OR "0G" OR "AB" OR "AC" 001740 OR "AG" OR "BA" OR "BB" OR "BC" OR "BG" OR "IL" OR "PB" OR 001750 "PA" OR "PC" OR "PG" OR " " THEN 001760 CONTINUE 001770 ELSE 001780 MOVE "DSME120" TO H-FEHLER 001790 GO TO FDSME120-EXIT 001791 END-IF 001792** ------------------------------------------------------------- 001793** T5222-1 001794** ------------------------------------------------------------- 001800 IF OP-AGDEU OR OP-WLTKV THEN 001900 EVALUATE E1-VSTR 002000 WHEN "0A" GO TO FDSME120-EXIT 002010 WHEN "0B" GO TO FDSME120-EXIT 002011 WHEN "0C" GO TO FDSME120-EXIT 002012 WHEN "0G" GO TO FDSME120-EXIT 002020 WHEN " " GO TO FDSME120-EXIT 002030 WHEN OTHER 002050 MOVE "DSME122" TO H-FEHLER 002060 GO TO FDSME120-EXIT 002070 END-EVALUATE 002071 ELSE 002080 IF OP-KVTWL OR OP-KVTRV OR OP-PVTRV OR 002090 OP-BATRV OR OP-BWTRV OR OP-BZTRV OR 002091 OP-KTTRV 002092 EVALUATE E1-VSTR 002093 WHEN "0A" GO TO FDSME120-EXIT 002094 WHEN "0B" GO TO FDSME120-EXIT 002095 WHEN "0C" GO TO FDSME120-EXIT 002096 WHEN "0G" GO TO FDSME120-EXIT 002097 WHEN OTHER 002098 MOVE "DSME124" TO H-FEHLER 002099 GO TO FDSME120-EXIT 002100 END-EVALUATE 002110 ELSE 003110** ------------------------------------------------------- 003111** T5222-3 003112** ------------------------------------------------------- 003120 IF OP-DSTBF THEN 003201 IF E1-VSTR = "BA" OR "BB" OR "BC" OR "BG" 003203 GO TO FDSME120-EXIT 003204 ELSE 003205 MOVE "DSME132" TO H-FEHLER 003208 END-IF 003211 END-IF 003212 END-IF 003215 END-IF 003223 . 003224** 003225** 003230 FDSME120-EXIT. 003300 EXIT. 003400** 003500** 022650*COPY CDSME140 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME140 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001602** ERSTELLUNGSDATUM : 17.04.2002 001603** VERSION : 002 001604** FUNKTION : ERWEITERUNG DER BETRIEBSNUMMERN 001610**---------------------------------------------------------------- 001620** PROGRAMMIERER : MICHAEL KLEMKE 001630** ERSTELLUNGSDATUM : 20.10.2003 001640** VERSION : 003 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ERSTELLUNGSDATUM : 11.10.2006 001690** VERSION : 004 / Version 56 001691**---------------------------------------------------------------- 001700 FDSME140 SECTION. 001710 FDSME140E. 001800 IF E1-BBNRVU EQUAL SPACE 001810 IF ST-DSME THEN 001900 IF E1-PERSGR = "205" 002000 GO TO FDSME140-EXIT 002100 ELSE MOVE "DSME140" TO H-FEHLER 002300 GO TO FDSME140-EXIT 002310 END-IF 002320 ELSE 002330 MOVE "DSME142" TO H-FEHLER 002340 GO TO FDSME140-EXIT 002400 END-IF 002500 ELSE 002510 IF E1-BBNRVU-NUM-1-8 NOT NUMERIC 002600 MOVE "DSME142" TO H-FEHLER 002800 GO TO FDSME140-EXIT 002900 ELSE 002910** ------------------------------------------------------ 002920** VERSION 27 VOM 17.04.2002 002921** ------------------------------------------------------ 003000** (:S0:-BBNRVU-NUM(1:3) >= "010" AND <= "099") OR 003010 IF (E1-BBNRVU-NUM(1:3) >= "001" AND <= "099") OR 003100 (E1-BBNRVU-NUM(1:3) > 110) 003101 MOVE ZERO TO QUERSUMME, ZIFFER-TABELLE 003102 MOVE E1-BBNRVU-NUM-1-7 TO ZIFFER-TABELLE 003103 MOVE 0 TO HILFSFELD, ERG, REST 003104 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 003105 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 003106 END-COMPUTE 003107 COMPUTE HILFSFELD = HILFSFELD + QUERSUMME-1 003108 + QUERSUMME-2 003109 END-COMPUTE 003110 END-PERFORM 003111 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 003112 COMPUTE RESTB = REST + 5 END-COMPUTE 003113 IF E1-BBNRVU-NUM-8 = REST OR 003114 E1-BBNRVU-NUM-8 = RESTBR2 THEN 003115** ------------------------------------------------ 003116** ÄNDERUNG VOM 20.10.2003 / VERSION 36 003117** ------------------------------------------------ 003118 IF E1-BBNRVU-NUM-1-8 = 15000002 OR 33333330 OR 003119 80000008 OR 80000031 OR 99999993 003120 MOVE "DSME141" TO H-FEHLER 003121 GO TO FDSME140-EXIT 003122 END-IF 003123** ------------------------------------------------ 003124 ELSE 003125 MOVE "DSME142" TO H-FEHLER 003126 GO TO FDSME140-EXIT 003127 END-IF 003128 ELSE 003130 MOVE "DSME142" TO H-FEHLER 003150 GO TO FDSME140-EXIT 003160 END-IF 003161 END-IF 003162 END-IF 003167** ------------------------------------------------------------- 003168** T52231 003169** ------------------------------------------------------------- 003203 IF OP-BWTRV THEN 003204 IF E1-BBNRVU = "32349289" THEN 003220 GO TO FDSME140-EXIT 003230 ELSE 003240 MOVE "DSME146" TO H-FEHLER 003251 GO TO FDSME140-EXIT 003252 END-IF 003253 END-IF 003254 IF OP-BZTRV THEN 003255 IF E1-BBNRVU = "38065304" THEN 003256 GO TO FDSME140-EXIT 003257 ELSE 003258 MOVE "DSME148" TO H-FEHLER 003259 GO TO FDSME140-EXIT 003260 END-IF 003266 END-IF 003267** ------------------------------------------------------------- 003268** T52232 003269** ------------------------------------------------------------- 003270 IF OP-PVTRV THEN 003271 IF E1-BBNRVU(1:3) = "996" THEN 003272 GO TO FDSME140-EXIT 003273 ELSE 003274 MOVE "DSME150" TO H-FEHLER 003275 GO TO FDSME140-EXIT 003276 END-IF 003277 END-IF 003278** ------------------------------------------------------------- 003279** T52233 003280** ------------------------------------------------------------- 003284 IF OP-KSTRV OR OP-KSTKV THEN 003285 IF E1-BBNRVU = "01085914" OR "28180427" THEN 003286 GO TO FDSME140-EXIT 003287 ELSE 003288 MOVE "DSME154" TO H-FEHLER 003289 GO TO FDSME140-EXIT 003290 END-IF 003291 END-IF 003292** ------------------------------------------------------------- 003293** T52234 003294** ------------------------------------------------------------- 003304 IF OP-AGDEU OR OP-WLTKV 003311 IF E1-VSTR = "0C" OR "0G" 003312 IF E1-BBNRVU(1:3) = "098" OR "980" 003313 GO TO FDSME140-EXIT 003314 ELSE 003315 MOVE "DSME143" TO H-FEHLER 003316 GO TO FDSME140-EXIT 003317 END-IF 003318 ELSE 003319 GO TO FDSME140-EXIT 003320 END-IF 003322 END-IF 003342** ------------------------------------------------------------- 003343** T52236 003344** ------------------------------------------------------------- 003345 IF OP-UETBF THEN 003346 IF E1-BBNRVU = "98503184" 003347 OR E1-BBNRVU = "98702232" 003348 GO TO FDSME140-EXIT 003349 ELSE 003350 MOVE "DSME158" TO H-FEHLER 003351 GO TO FDSME140-EXIT 003352 END-IF 003357 END-IF 003358** ------------------------------------------------------------- 003359** ÄNDERUNG VOM 20.10.2003 / VERSION 36 003360** ------------------------------------------------------------- 003361** T52237 003362** ------------------------------------------------------------- 003363 IF OP-ZFTRV THEN 003364 IF E1-BBNRVU = "02998824" 003365 GO TO FDSME140-EXIT 003366 ELSE 003367 MOVE "DSME155" TO H-FEHLER 003368 GO TO FDSME140-EXIT 003369 END-IF 003370 ELSE 003371 IF OP-RVTZF THEN 003372 IF E1-BBNRVU NOT = "90209055" 003373 MOVE "DSME159" TO H-FEHLER 003374 GO TO FDSME140-EXIT 003375 END-IF 003376 END-IF 003377 END-IF 003378** ------------------------------------------------------------- 003379 . 003380 003381 003390 FDSME140-EXIT. 003400 EXIT. 022660*COPY CDSME160 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME160 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001620** ÄNDERUNG : 001 VOM 15.11.2000 001621**---------------------------------------------------------------- 001622** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001623** ÄNDERUNG : 002 VOM 21.03.2001 VERSION 23 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 18.05.2004 VERSION 40 001660**---------------------------------------------------------------- 001700 FDSME160 SECTION. 001701 FDSME160E. 001710 IF OP-BATRV THEN 001720 IF E1-AZ-VU-NUM1 NUMERIC AND 001721 E1-AZ-VU-NUM2 GROSSBUCHSTABE AND 001722 E1-AZ-VU-NUM3 NUMERIC THEN 001723 IF E1-AZ-VU-NUM1 = 0 OR 001724 E1-AZ-VU-NUM3 = 0 THEN 001725 MOVE "DSME160" TO H-FEHLER 001726 END-IF 001729 ELSE 001730 MOVE "DSME160" TO H-FEHLER 001774 END-IF 001780 END-IF 001800 . 001900 002000 003310 FDSME160-EXIT. 003400 EXIT. 003500 003600 022670*COPY CDSME170 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME170 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 001300** FUNKTION : FEHLERPRüFUNG BETRIEBSNUMMER KRANKENKASSE 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001602** ERSTELLUNGSDATUM : 17.04.2002 001603** VERSION : 002 001604** FUNKTION : ERWEITERUNG DER BETRIEBSNUMMERN 001610**---------------------------------------------------------------- 001620** PROGRAMMIERER : MICHAEL KLEMKE 001630** ERSTELLUNGSDATUM : 04.11.2002 (VERSION-29) 001640** VERSION : 003 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ERSTELLUNGSDATUM : 21.10.2003 (VERSION-36) 001690** VERSION : 004 001691**---------------------------------------------------------------- 001692** PROGRAMMIERER : MICHAEL KLEMKE 001693** ERSTELLUNGSDATUM : 11.10.2006 (VERSION-56) 001694** VERSION : 005 001695**---------------------------------------------------------------- 001700 FDSME170 SECTION. 001800 FDSME170E. 001810** ------------------------------------------------------------- 001820** T5231 001830** ------------------------------------------------------------- 001840 IF E1-BBNRKK NOT = " " THEN 001850 IF OP-ZFTRV THEN 001860 MOVE "DSME168" TO H-FEHLER 001900 ELSE 001901 IF E1-BBNRKK-NUM-1-8 = 15000002 OR 33333330 OR 001902 80000008 OR 80000031 OR 001903 99999993 001904 MOVE "DSME171" TO H-FEHLER 001905 ELSE 001906** ---------------------------------------------------- 001907** T52311 001908** ---------------------------------------------------- 001909 IF E1-BBNRKK-NUM-1-8 NOT NUMERIC 001910 MOVE "DSME170" TO H-FEHLER 001911 ELSE 001912** ------------------------------------------------- 001913** VERSION 27 VOM 17.04.2002 001914** ------------------------------------------------- 001915 IF (E1-BBNRKK-NUM(1:3) >= "001" AND <= "099") 001916 OR 001917 (E1-BBNRKK-NUM(1:3) > 110) 001918 MOVE E1-BBNRKK-NUM-1-7 TO ZIFFER-TABELLE 001919 MOVE 0 TO HILFSFELD 001920 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 001921 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 001922 END-COMPUTE 001923 COMPUTE HILFSFELD = HILFSFELD + 001924 QUERSUMME-1 + 001925 QUERSUMME-2 001926 END-COMPUTE 001927 END-PERFORM 001928 DIVIDE 10 INTO HILFSFELD GIVING ERG 001929 REMAINDER REST 001930 COMPUTE RESTB = REST + 5 END-COMPUTE 001931 IF E1-BBNRKK-NUM-8 = REST OR 001932 E1-BBNRKK-NUM-8 = RESTBR2 THEN 001933 IF (OP-PVTRV OR OP-KSTRV) 001934 AND E1-BBNRKK NOT = E1-BBNRVU THEN 001935 MOVE "DSME172" TO H-FEHLER 001936 ELSE 001937** ---------------------------------------- 001938** VERSION-29 VOM 04.11.2002 001939** ---------------------------------------- 001940** T52312 001941** ---------------------------------------- 001942 IF OP-AGDEU THEN 001943 IF E1-BBNRKK-NUM-1-8 = 001944 "32023311" OR 001945 "35382142" OR 001946 "37912580" OR 001947 "47056789" OR 001948 "15451439" THEN 001949 MOVE "DSME174" TO H-FEHLER 001950 ELSE 001951 IF E1-BBNRKK NOT = E1-BBNREP 001952 MOVE "DSME176" TO H-FEHLER 001953 END-IF 001954 END-IF 001955 END-IF 001956** ---------------------------------------- 001957** ENDE T52312 001958** ---------------------------------------- 001959 END-IF 001960 ELSE 001961 MOVE "DSME170" TO H-FEHLER 001962 END-IF 001963 ELSE 001964 MOVE "DSME170" TO H-FEHLER 001965 END-IF 001966 END-IF 001968 END-IF 001969 END-IF 001970 ELSE 001971 IF NOT OP-ZFTRV THEN 001972 IF E1-PERSGR IS NUMERIC AND E1-PERSGR = "304" 001973 MOVE "DSME169" TO H-FEHLER 001974 ELSE 001975 IF E1-PERSGR IS NUMERIC AND 001976 E1-PERSGR = "301" OR "302" OR "303" THEN 001977 CONTINUE 001978 ELSE 001979 IF E1-VSNR(1:2) = "88" THEN 001980 CONTINUE 001981 ELSE 001982 MOVE "DSME170" TO H-FEHLER 001983 END-IF 001984 END-IF 001985 END-IF 001986 END-IF 001987 END-IF 001988 . 001989 001990 001991 FDSME170-EXIT. 001992 EXIT. 001993 002000 022680*COPY CDSME190 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME190 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG BETRIEBSNUMMER ABRECHNUNGSST 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001602** ERSTELLUNGSDATUM : 17.04.2002 001603** VERSION : 002 001604** FUNKTION : ERWEITERUNG DER BETRIEBSNUMMERN 001610**---------------------------------------------------------------- 001620** PROGRAMMIERER : MICHAEL KLEMKE 001630** ERSTELLUNGSDATUM : 21.10.2003 VERSION 36 001640** VERSION : 003 001660**---------------------------------------------------------------- 001700 FDSME190 SECTION. 001710 FDSME190E. 001800 IF E1-BBNRAS NOT EQUAL " " 001900 IF E1-BBNRAS-NUM-1-8 NOT NUMERIC 001910 MOVE "DSME190" TO H-FEHLER 001930 GO TO FDSME190-EXIT 001940 ELSE 001941** ------------------------------------------------------- 001942** VERSION 27 VOM 17.04.2002 001943** ------------------------------------------------------- 001950** IF (:S0:-BBNRAS-NUM(1:3) >= "010" AND <= "099") OR 001951 IF (E1-BBNRAS-NUM(1:3) >= "001" AND <= "099") OR 001960 (E1-BBNRAS-NUM(1:3) > 110) 001961 MOVE E1-BBNRAS-NUM-1-7 TO ZIFFER-TABELLE 001962 MOVE 0 TO HILFSFELD 001963 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 001964 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 001965 END-COMPUTE 001966 COMPUTE HILFSFELD = HILFSFELD + QUERSUMME-1 001967 + QUERSUMME-2 001968 END-COMPUTE 001969 END-PERFORM 001970 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 001971 COMPUTE RESTB = REST + 5 END-COMPUTE 001972 IF E1-BBNRAS-NUM-8 = REST OR 001973 E1-BBNRAS-NUM-8 = RESTBR2 THEN 001974** ------------------------------------------------- 001975** ÄNDERUNG VOM 21.10.2003 / VERSION 36 001976** ------------------------------------------------- 001977 IF E1-BBNRAS-NUM-1-8 = 15000002 OR 33333330 OR 001978 80000008 OR 80000031 OR 001979 99999993 001980 MOVE "DSME195" TO H-FEHLER 001981 END-IF 001985** ------------------------------------------------- 001986 ELSE 001990 MOVE "DSME190" TO H-FEHLER 001992 GO TO FDSME190-EXIT 001993 END-IF 002091 ELSE 002092 MOVE "DSME190" TO H-FEHLER 002094 END-IF 002095 END-IF 002096 END-IF 002100 . 002200 002300 003310 FDSME190-EXIT. 003400 EXIT. 003500 003600 022690*COPY CDSME200 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME200 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 001300** FUNKTION : FEHLERPRüFUNG PERSONENGRUPPE 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001602** DATUM : 17.07.2003 001610** VERSION : 002 / 35 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** DATUM : 21.10.2003 001660** VERSION : 003 / 36 001670**---------------------------------------------------------------- 001680** PROGRAMMIERER : MICHAEL KLEMKE 001690** DATUM : 06.12.2004 001691** VERSION : 004 / 42 001692**---------------------------------------------------------------- 001693** PROGRAMMIERER : MICHAEL KLEMKE 001694** DATUM : 11.10.2006 001695** VERSION : 005 / 56 001696**---------------------------------------------------------------- 001700 FDSME200 SECTION. 001710 FDSME200E. 001720** ------------------------------------------------------------- 001730** T5233 001740** ------------------------------------------------------------- 001800 IF E1-PERSGR-NUM NOT NUMERIC THEN 001900 MOVE "DSME200" TO H-FEHLER 002010 GO TO FDSME200-EXIT 002020 ELSE 002030 IF E1-PERSGR-NUM = 999 THEN 002031 IF OP-AGDEU OR OP-WLTKV OR OP-KVTWL THEN 002050 GO TO FDSME200-EXIT 002060 ELSE 002070 MOVE "DSME201" TO H-FEHLER 002090 GO TO FDSME200-EXIT 002091 END-IF 002093** ------------------------------------------------------------- 002094** T52331 002095** ------------------------------------------------------------- 002096 ELSE IF E1-PERSGR-NUM = 0 THEN 002097 GO TO FDSME200-EXIT 002098 ELSE 002099 IF OP-BATRV OR OP-KTTRV 002100 MOVE "DSME216" TO H-FEHLER 002110 GO TO FDSME200-EXIT 002150 ELSE 002160 MOVE E1-PERSGR-NUM TO PERSGR-TAB 002170 IF NOT PERSGR-OK THEN 002180 MOVE "DSME204" TO H-FEHLER 002191 GO TO FDSME200-EXIT 002192 ELSE 002193 IF OP-AGDEU 002194 IF E1-PERSGR(1:1) = "1" 002195 PERFORM T52332 002198 ELSE 002200 MOVE "DSME202" TO H-FEHLER 002220 GO TO FDSME200-EXIT 002230 END-IF 002240 ELSE 002241 PERFORM T52332 002242 END-IF 002243 END-IF 002244 END-IF 002245 END-IF 002246 END-IF 002247 END-IF 002248 . 002249 002250 002251 FDSME200-EXIT. 002252 EXIT. 002253 002254 002255 T52332 SECTION. 002256 T52332E. 002260 IF E1-BBNRVU(1:3) = "985" OR "987" THEN 002261* -------------------------------------------------- 002262* ÄNDERUNG VOM 17.07.2003 / VERSION 35 002263* -------------------------------------------------- 002270 IF E1-PERSGR-NUM = 102 OR 103 OR 107 OR 111 OR 204 THEN 002280 GO TO T52332-EXIT 002281 ELSE 002290 MOVE "DSME208" TO H-FEHLER 002291 GO TO T52332-EXIT 002292 END-IF 002294 ELSE 002303 IF E1-PERSGR-NUM = 140 OR 141 OR 142 OR 143 OR 149 THEN 002305 IF E1-BBNRVU(1:3) = "099" OR "990" OR "991" 002306 OR "992" THEN 002308 GO TO T52332-EXIT 002309 ELSE 002310 MOVE "DSME209" TO H-FEHLER 002311 GO TO T52332-EXIT 002313 END-IF 002314 END-IF 002315 IF E1-BBNRVU = "01085914" OR "28180427" 002317 IF E1-PERSGR-NUM = 203 THEN 002319 GO TO T52332-EXIT 002321 ELSE 002322 MOVE "DSME212" TO H-FEHLER 002323 GO TO T52332-EXIT 002325 END-IF 002326 ELSE 002335 IF E1-PERSGR-NUM = 301 OR 302 002336 IF E1-BBNRVU = "32349289" 002337 GO TO T52332-EXIT 002340 ELSE 002350 MOVE "DSME218" TO H-FEHLER 002360 GO TO T52332-EXIT 002380 END-IF 002390 ELSE 002398* ---------------------------------------------------- 002399* ÄNDERUNG VOM 21.10.2003 / VERSION 36 002400* ---------------------------------------------------- 002401* IF :S0:-PERSGR-NUM = 303 002402 IF E1-PERSGR-NUM = 303 OR 304 002403* ---------------------------------------------------- 002404 IF E1-BBNRVU = "38065304" 002405 GO TO T52332-EXIT 002406 ELSE 002407 MOVE "DSME222" TO H-FEHLER 002408 GO TO T52332-EXIT 002440 END-IF 002450 ELSE 002493 IF E1-PERSGR-NUM = 207 OR 208 002495 IF E1-BBNRVU(1:3) = "996" 002496 GO TO T52332-EXIT 002498 ELSE 002499 MOVE "DSME226" TO H-FEHLER 002500 GO TO T52332-EXIT 002530 END-IF 002540 ELSE 002541 IF E1-BBNRVU(1:3) = "996" 002570 MOVE "DSME228" TO H-FEHLER 002580 GO TO T52332-EXIT 002640 END-IF 002650 END-IF 002670 END-IF 002690 END-IF 002800 END-IF 003100 END-IF 003200 . 003300 T52332-EXIT. 003400 EXIT. 022691*COPY CDSME230 REPLACING ==:S0:== BY ==E1== 022692* ==:S9:== BY ==E10==. 053890**---------------------------------------------------------------- 053900** COPY-MEMBER : CDSME230 053910** PROGRAMMIERER : WERNER KRAUS 053920** ERSTELLUNGSDATUM : 10.02.1998 053930** VERSION : 001 053940** FUNKTION : FEHLERPRüFUNG PERSONENGRUPPE 053950**---------------------------------------------------------------- 053951** PROGRAMMIERER : GERTRAUD SCHUHMACHER 053952** ÄNDERUNG : 001 VOM 15.11.2000 053953**---------------------------------------------------------------- 053954** PROGRAMMIERER : GERTRAUD SCHUHMACHER 053955** ÄNDERUNG : 002 VOM 30.04.2001 VERSION 24 053956**---------------------------------------------------------------- 053957** PROGRAMMIERER : MICHAEL KLEMKE 053958** ÄNDERUNG : 003 VOM 09.04.2002 VERSION 27 053959** ÄNDERUNG : KORREKTUR BEI ABFRAGE GD (2-STELLIG) 053960**---------------------------------------------------------------- 053961** PROGRAMMIERER : MICHAEL KLEMKE 053962** ÄNDERUNG : 004 VOM 08.08.2002 VERSION 28 053963** ÄNDERUNG : NEUE MELDEGRUENDE 86 - 88 053964**---------------------------------------------------------------- 053965** PROGRAMMIERER : MICHAEL KLEMKE 053966** ÄNDERUNG : 005 VOM 04.11.2002 VERSION 29 / NACHGANG 1 053967** ÄNDERUNG : NEUE MELDEGRUENDE 94 - 95 053968**---------------------------------------------------------------- 053969** PROGRAMMIERER : MICHAEL KLEMKE 053970** ÄNDERUNG : 006 VOM 13.05.2003 VERSION 33 053971** ÄNDERUNG : DBSO entfällt 053972**---------------------------------------------------------------- 053973** PROGRAMMIERER : MICHAEL KLEMKE 053974** ÄNDERUNG : 007 VOM 21.10.2003 VERSION 36 053976**---------------------------------------------------------------- 053977** PROGRAMMIERER : MICHAEL KLEMKE 053978** ÄNDERUNG : 008 VOM 11.10.2004 VERSION 41 053979**---------------------------------------------------------------- 053980** PROGRAMMIERER : MICHAEL KLEMKE 053981** ÄNDERUNG : 009 VOM 06.12.2004 VERSION 42 053982**---------------------------------------------------------------- 053983** PROGRAMMIERER : MICHAEL KLEMKE 053984** ÄNDERUNG : 010 VOM 16.02.2005 VERSION 44 053985**---------------------------------------------------------------- 053986** PROGRAMMIERER : MICHAEL KLEMKE 053987** ÄNDERUNG : 011 VOM 26.04.2005 VERSION 45 053988**---------------------------------------------------------------- 053989** PROGRAMMIERER : MICHAEL KLEMKE 053990** ÄNDERUNG : 012 VOM 02.06.2005 VERSION 46 053991**---------------------------------------------------------------- 053992** PROGRAMMIERER : MICHAEL KLEMKE 053993** ÄNDERUNG : 013 VOM 31.10.2005 VERSION 50 053994**---------------------------------------------------------------- 053995** PROGRAMMIERER : MICHAEL KLEMKE 053996** ÄNDERUNG : 014 VOM 05.12.2005 VERSION 51 053997**---------------------------------------------------------------- 053998** PROGRAMMIERER : MICHAEL KLEMKE 053999** ÄNDERUNG : 015 VOM 11.10.2006 VERSION 56 054000**---------------------------------------------------------------- 054001** PROGRAMMIERER : MICHAEL KLEMKE 054002** ÄNDERUNG : 016 VOM 02.03.2007 VERSION 60 054003**---------------------------------------------------------------- 054004** PROGRAMMIERER : MICHAEL KLEMKE 054005** ÄNDERUNG : 017 VOM 23.04.2007 VERSION 62 054006**---------------------------------------------------------------- 054007 FDSME230 SECTION. 054008 FDSME230E. 054009** ------------------------------------------------------------- 054010** T5234 054011** ------------------------------------------------------------- 054012 IF E1-GD-NUM NOT NUMERIC THEN 054013 MOVE "DSME230" TO H-FEHLER 054014 PERFORM FEHLER 054020 ELSE 054030 MOVE E1-GD-NUM TO GDFIKT-TAB 054040 IF GDFIKT-OK THEN 054050 IF OP-AGDEU OR OP-WLTKV OR OP-KVTWL THEN 054051** ---------------------------------------------------- 054052** AUFRUF T52343 054053** ---------------------------------------------------- 054060 PERFORM GDT52343 054070 ELSE 054080 MOVE "DSME231" TO H-FEHLER 054090 PERFORM FEHLER 054110 END-IF 054120 ELSE 054130 MOVE E1-GD-NUM TO GD-TAB 054140 IF NOT GD-OK THEN 054150 MOVE "DSME232" TO H-FEHLER 054160 PERFORM FEHLER 054171 ELSE 054172** ---------------------------------------------------- 054173** AUFRUF T52343 054174** ---------------------------------------------------- 054175 PERFORM GDT52343 054180 END-IF 054190 END-IF 054191 END-IF 054192** ------------------------------------------------------------- 054193** T5234 - ENDE 054194** ------------------------------------------------------------- 054200 . 054300 054310 054320 FDSME230-EXIT. 054330 EXIT. 054340 054341 054342 054343 GDT52343 SECTION. 054344 GDT52343E. 054345** ------------------------------------------------------------- 054346** ÄNDERUNG VOM 21.10.2003 / VERSION 36 054347** ------------------------------------------------------------- 054348** T52343 054349** ------------------------------------------------------------- 054430 IF OP-BATRV OR OP-ZFTRV OR OP-KTTRV 054440 IF E1-GD = "99" THEN 054450 PERFORM GDT52345 054460 ELSE 054470 MOVE "DSME236" TO H-FEHLER 054480 PERFORM FEHLER 054500 END-IF 054510 ELSE 054511 IF ST-KVNR AND E1-GD NOT = "99" THEN 054512 MOVE "DSME236" TO H-FEHLER 054513 PERFORM FEHLER 054515 ELSE 054516** ------------------------------------------------------- 054517** T52344 054518** ------------------------------------------------------- 054520 IF OP-BWTRV OR OP-BZTRV THEN 054530 IF E1-GD = "30" OR "99" THEN 054540 PERFORM GDT52344A 054550 ELSE 054560 MOVE "DSME238" TO H-FEHLER 054570 PERFORM FEHLER 054590 END-IF 054600 ELSE 054610 IF OP-PVTRV THEN 054620 IF E1-GD = "30" OR "50" OR "60" OR "61" OR "99" 054640 PERFORM GDT52344A 054650 ELSE 054660 MOVE "DSME240" TO H-FEHLER 054670 PERFORM FEHLER 054690 END-IF 054700 ELSE 054710 PERFORM GDT52344A 054720 END-IF 054721 END-IF 054730 END-IF 054740 END-IF 054760 . 054761 054762 054763 GDT52343-EXIT. 054764 EXIT. 054765 054766 054767 GDT52344A SECTION. 054768 GDT52344AE. 054769** ------------------------------------------------------------- 054770** NEUE TABELLE AB VERSION 50 054771** ------------------------------------------------------------- 054772 IF E1-GD = "60" OR "61" OR "62" OR "63" OR 054773 "80" OR "90" OR "99" 054774** "80" OR "89" OR "90" OR "99" 054780 IF E1-VSTR = " " OR "0A" OR "0C" 054781 PERFORM GDT52345 054782 ELSE 054783 IF OP-BATRV 054784 IF E1-VSTR = "0B" OR "0G" 054785 PERFORM GDT52345 054786 ELSE 054787 MOVE "DSME241" TO H-FEHLER 054788 PERFORM FEHLER 054789 END-IF 054790 ELSE 054791 IF OP-DSTBF OR OP-BFTDS 054792 IF E1-VSTR = "BA" OR "BB" OR "BC" OR "BG" 054793 PERFORM GDT52345 054794 ELSE 054795 MOVE "DSME241" TO H-FEHLER 054796 PERFORM FEHLER 054800 END-IF 054801 ELSE 054802 MOVE "DSME241" TO H-FEHLER 054803 PERFORM FEHLER 054804 END-IF 054805 END-IF 054807 END-IF 054808 ELSE 054809 PERFORM GDT52345 054810 END-IF 054811 054812 . 054813 054814 GDT52344A-EXIT. 054815 EXIT. 054816 054817 054818 GDT52345 SECTION. 054819 GDT52345E. 054820 IF E1-GD-NUM = 00 OR 01 OR 10 OR 11 OR 12 OR 13 054821 IF OP-AGDEU OR OP-WLTKV 054822 IF E1-KENNZUE = "A" THEN 054823 IF E1-VSNR NOT = SPACE THEN 054824 IF E1-MMME = "J" AND E1-MMGB = "N" AND 054825 E1-MMEU = "N" AND 054826 E1-MMKS = "N" AND E1-MMSV = "N" AND 054827 E1-MMVR = "N" AND E1-MMRG = "N" THEN 054828 PERFORM GDT52347 054829 ELSE 054830 PERFORM GDT52346 054831 END-IF 054832 ELSE 054833 PERFORM GDT52346 054834 END-IF 054835 ELSE 054836 PERFORM GDT52346 054837 END-IF 054838 ELSE 054839 PERFORM GDT52346 054840 END-IF 054841 ELSE 054842 PERFORM GDT52346 054843 END-IF 054844 . 054845** --------------------------------------------------------- 054846** T52345 ENDE 054847** --------------------------------------------------------- 054848 054849 054850 GDT52345-EXIT. 054851 EXIT. 054852 054853 054854 054855 054856 GDT52346 SECTION. 054857 GDT52346E. 054863** --------------------------------------------------------- 054864** T52346 054870** --------------------------------------------------------- 054980 MOVE E1-GD-NUM TO HFELD-KOMBGD 055000 IF E1-GD-NUM = 10 OR 11 OR 12 OR 13 OR 40 055010 IF E1-VSNR = " " THEN 055020 MOVE "X" TO HFELD-KOMB-VSNR 055030 ELSE 055040 MOVE " " TO HFELD-KOMB-VSNR 055050 END-IF 055060 ELSE 055070 MOVE " " TO HFELD-KOMB-VSNR 055080 END-IF 055081** --------------------------------------------------------- 055082** 13.05.2003 VERSION-33 055083** --------------------------------------------------------- 055090 MOVE EIN-SATZ(171:10) TO HFELD-KOMBDB 055100 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10 055110 IF HFELD-KOMBDB(I:1) = "J" THEN 055120 CONTINUE 055130 ELSE 055140 MOVE "N" TO HFELD-KOMBDB(I:1) 055150 END-IF 055160 END-PERFORM 055161 MOVE " " TO HFELD-KOMBDB(6:1) 055164** --------------------------------------------------------- 055170 IF E1-PERSGR = "140" OR "141" OR "142" OR "143" OR "149" 055180 IF E1-GD-NUM = 99 AND (E10-GDMQ = "01" OR "99") THEN 055200 MOVE HFELD-KOMB TO GD-KOMBI9901-TAB 055210 IF NOT GD-KOMBI9901-OK THEN 055220 MOVE "DSME248" TO H-FEHLER 055230 PERFORM FEHLER 055240 END-IF 055250 ELSE 055251 IF E1-GD-NUM = 99 AND 055252 (E10-GDMQ = "04" OR "05" OR "80" OR "81" OR "82" 055253 OR "83" OR "84" OR "85") THEN 055254 IF E10-GDMQ = "04" OR "05" 055255* ------------------------------------------------- 055256* ÄNDERUNG VOM 26.04.2005 055257* UNTERSCHEIDUNG NACH DEUEV / KVNR 055258* ------------------------------------------------- 055259 IF ST-KVNR 055260 MOVE HFELD-KOMB TO GD-KOMBI9904-KVNR 055261 IF NOT GD-KOMBI9904-KVNR-OK THEN 055262 MOVE "DSME248" TO H-FEHLER 055263 PERFORM FEHLER 055264 END-IF 055266 ELSE 055267 MOVE HFELD-KOMB TO GD-KOMBI9904-TAB 055268 IF NOT GD-KOMBI9904-OK THEN 055269 MOVE "DSME248" TO H-FEHLER 055270 PERFORM FEHLER 055271 END-IF 055272 END-IF 055273* ------------------------------------------------- 055274* ENDE DER ÄNDERUNG VOM 26.04.2005 055276* ------------------------------------------------- 055277 ELSE 055278 MOVE HFELD-KOMB TO GD-KOMBI9980-TAB 055279 IF NOT GD-KOMBI9980-OK THEN 055280 MOVE "DSME248" TO H-FEHLER 055281 PERFORM FEHLER 055282 END-IF 055283 END-IF 055284 ELSE 055285* ---------------------------------------------------- 055286* ÄNDERUNG VOM 28.02.2007 055287* ---------------------------------------------------- 055288 IF (E1-BBNRVU(1:3) = "098" OR "980") AND 055289 (E1-GD-NUM = 00 OR 01 OR 10 OR 11 OR 055290 12 OR 13 OR 40) 055291 MOVE HFELD-KOMB TO GD-KOMBI140KNA-TAB 055292 IF NOT GD-KOMBI140KNA-OK THEN 055293 MOVE "DSME248" TO H-FEHLER 055294 PERFORM FEHLER 055300 END-IF 055301 ELSE 055302 MOVE HFELD-KOMB TO GD-KOMBI140-TAB 055303 IF NOT GD-KOMBI140-OK THEN 055304 MOVE "DSME248" TO H-FEHLER 055305 PERFORM FEHLER 055306 END-IF 055307 END-IF 055310 END-IF 055311 END-IF 055320 ELSE 055330 IF E1-GD-NUM = 99 AND (E10-GDMQ = "01" OR "99") THEN 055350 MOVE HFELD-KOMB TO GD-KOMBI9901-TAB 055360 IF NOT GD-KOMBI9901-OK THEN 055370 MOVE "DSME248" TO H-FEHLER 055380 PERFORM FEHLER 055390 END-IF 055400 ELSE 055401 IF E1-GD-NUM = 99 AND 055402 (E10-GDMQ = "04" OR "05" OR "80" OR "81" OR "82" 055403 OR "83" OR "84" OR "85") THEN 055404 IF E10-GDMQ = "04" OR "05" 055405* ------------------------------------------------- 055406* ÄNDERUNG VOM 26.04.2005 055407* UNTERSCHEIDUNG NACH DEUEV / KVNR 055408* ------------------------------------------------- 055409 IF ST-KVNR 055410 MOVE HFELD-KOMB TO GD-KOMBI9904-KVNR 055411 IF NOT GD-KOMBI9904-KVNR-OK THEN 055412 MOVE "DSME248" TO H-FEHLER 055413 PERFORM FEHLER 055414 END-IF 055415 ELSE 055416 MOVE HFELD-KOMB TO GD-KOMBI9904-TAB 055417 IF NOT GD-KOMBI9904-OK THEN 055418 MOVE "DSME248" TO H-FEHLER 055419 PERFORM FEHLER 055420 END-IF 055421 END-IF 055422* ------------------------------------------------- 055424* ENDE DER ÄNDERUNG VOM 26.04.2005 055425* ------------------------------------------------- 055431 ELSE 055432 MOVE HFELD-KOMB TO GD-KOMBI9980-TAB 055433 IF NOT GD-KOMBI9980-OK THEN 055434 MOVE "DSME248" TO H-FEHLER 055435 PERFORM FEHLER 055436 END-IF 055437 END-IF 055438 ELSE 055439* ---------------------------------------------------- 055440* ÄNDERUNG VOM 28.02.2007 055441* ---------------------------------------------------- 055443 055444 055445 055446 055447 055448 IF (E1-BBNRVU(1:3) = "098" OR "980") AND 055449 (E1-GD-NUM = 00 OR 01 OR 10 OR 11 OR 055450 12 OR 13 OR 40) 055454 IF E1-PERSGR = "109" OR "110" 055465** -------------------------------------------- 055466** DBKS DARF NICHT VORHANDEN SEIN 055467** -------------------------------------------- 055469 MOVE HFELD-KOMB TO GD-KOMBIKNA-DBKSN-TAB 055470 IF NOT GD-KOMBIKNA-DBKSN-OK THEN 055471 MOVE "DSME248" TO H-FEHLER 055472 PERFORM FEHLER 055473 END-IF 055476 ELSE 055478 MOVE HFELD-KOMB TO GD-KOMBIKNA-DBKSJ-TAB 055479 IF NOT GD-KOMBIKNA-DBKSJ-OK THEN 055480 MOVE "DSME248" TO H-FEHLER 055481 PERFORM FEHLER 055482 END-IF 055484 END-IF 055485 ELSE 055486 MOVE HFELD-KOMB TO GD-KOMBI-TAB 055487 IF NOT GD-KOMBI-OK THEN 055488 MOVE "DSME248" TO H-FEHLER 055489 PERFORM FEHLER 055490 END-IF 055491 END-IF 055492 END-IF 055493 END-IF 055494 END-IF 055495 PERFORM GDT52347 055496 . 055497** --------------------------------------------------------- 055498** T52346 ENDE 055499** --------------------------------------------------------- 055500 055501 055502 GDT52346-EXIT. 055503 EXIT. 055504 055505 055506 GDT52347 SECTION. 055507 GDT52347E. 055508** --------------------------------------------------------- 055509** T52347 055510** --------------------------------------------------------- 055511 IF E1-VSNR EQUAL SPACE THEN 055512 IF E1-GD = "00" OR "01" OR "10" OR 055513 "11" OR "12" OR "13" THEN 055514 IF OP-AGDEU OR OP-KVDEU OR OP-WLTKV OR OP-KSTKV 055520 CONTINUE 055530 ELSE 055540 MOVE "DSME234" TO H-FEHLER 055550 PERFORM FEHLER 055570 END-IF 055571 PERFORM GDT523410 055580 ELSE 055581** --------------------------------------------------- 055582** ÄNDERUNG VOM 21.10.2003 / VERSION 36 055583** --------------------------------------------------- 055584 IF E1-GD = "40" AND 055585 (E1-PERSGR = "110" OR "210") AND 055586 (OP-AGDEU OR OP-KVDEU OR OP-WLTKV) THEN 055587 CONTINUE 055589 ELSE 055590 MOVE "DSME234" TO H-FEHLER 055591 PERFORM FEHLER 055592 END-IF 055610 PERFORM GDT523410 055620 END-IF 055630 ELSE 055631** ------------------------------------------------------ 055632** T52348 055633** ------------------------------------------------------ 055640 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB1 055650 IF BNR1-OK THEN 055660 IF E1-GD = "99" THEN 055670 CONTINUE 055680 ELSE 055690 MOVE "DSME242" TO H-FEHLER 055700 PERFORM FEHLER 055720 END-IF 055721 PERFORM GDT523410 055730 ELSE 055731** --------------------------------------------------- 055732** T52349 055733** --------------------------------------------------- 055740 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB 055750 IF BNR-OK THEN 055760 CONTINUE 055770 ELSE 055780 IF E1-GD = "00" OR "01" OR "10" OR 055781 "11" OR "12" OR "13" THEN 055782 CONTINUE 055810 ELSE 055820 IF E1-GD = "99" THEN 055821 CONTINUE 055840 ELSE 055850 MOVE "DSME246" TO H-FEHLER 055860 PERFORM FEHLER 055880 END-IF 055890 END-IF 055900 END-IF 055901 PERFORM GDT523410 055902** --------------------------------------------------- 055903** T52349 ENDE 055904** --------------------------------------------------- 055910 END-IF 055920 END-IF 055921** --------------------------------------------------------- 055922** T52347 ENDE 055923** --------------------------------------------------------- 055930 . 055931 055932 055940 GDT52347-EXIT. 055950 EXIT. 055951 055952 055953 055960 GDT523410 SECTION. 055970 GDT523410E. 055971** --------------------------------------------------------- 055972** T523410 055973** --------------------------------------------------------- 055980 IF E1-PERSGR = "000" THEN 055990 IF E1-GD = "60" OR "61" OR "90" OR "99" THEN 056000 CONTINUE 056010 ELSE 056020 MOVE "DSME244" TO H-FEHLER 056030 PERFORM FEHLER 056040 END-IF 056050 END-IF 056051** --------------------------------------------------------- 056052** T523411 056053** --------------------------------------------------------- 056060 IF E1-PERSGR = "107" OR "204" THEN 056070** ------------------------------------------------------- 056071** ÄNDERUNG VOM 21.10 2003 / VERSION 36 056072** ------------------------------------------------------- 056074 IF E1-GD = "60" OR "61" OR "80" OR 056075 "90" OR "99" THEN 056076** ------------------------------------------------------- 056080 CONTINUE 056090 ELSE 056100 IF E1-BBNRVU(1:3) = "985" OR "987" 056110 CONTINUE 056120 ELSE 056130 MOVE "DSME245" TO H-FEHLER 056140 PERFORM FEHLER 056150 END-IF 056160 END-IF 056170 END-IF 056171** ---------------------------------------------------------- 056172** T523412 056173** ---------------------------------------------------------- 056174 IF E1-PERSGR = "203" THEN 056175 IF E1-GD = "60" OR "61" OR "90" OR "99" THEN 056176 CONTINUE 056177 ELSE 056178 IF E1-BBNRVU = "01085914" OR "28180427" 056179 CONTINUE 056180 ELSE 056181 MOVE "DSME235" TO H-FEHLER 056182 PERFORM FEHLER 056183 END-IF 056184 END-IF 056185 END-IF 056186** ---------------------------------------------------------- 056187** T523413 056188** ---------------------------------------------------------- 056189 IF E1-GD = "56" THEN 056190 IF E1-PERSGR = "103" OR "142" THEN 056191 CONTINUE 056192 ELSE 056193 MOVE "DSME243" TO H-FEHLER 056194 PERFORM FEHLER 056195 END-IF 056196 END-IF 056197** ---------------------------------------------------------- 056198** 04.11.02 (VERSION 29) 056199** ---------------------------------------------------------- 056200** T523414 056201** ---------------------------------------------------------- 056203 IF E1-GD = "94" OR "95" THEN 056204 IF OP-KVTRV OR OP-KVTWL OR 056206 OP-WLTKV OR OP-DSTBF OR OP-BFTDS THEN 056207 CONTINUE 056208 ELSE 056209 MOVE "DSME249" TO H-FEHLER 056210 PERFORM FEHLER 056213 END-IF 056214 END-IF 056215** ---------------------------------------------------------- 056219** T523415 056220** ---------------------------------------------------------- 056221 IF E1-GD = "59" THEN 056222 IF OP-KVTRV OR OP-KVTWL OR 056223 OP-WLTKV OR OP-DSTBF OR OP-BFTDS THEN 056225 CONTINUE 056230 ELSE 056231 MOVE "DSME239" TO H-FEHLER 056232 PERFORM FEHLER 056233 END-IF 056234 END-IF 056235** ---------------------------------------------------------- 056236** T523416 056237** ---------------------------------------------------------- 056238 IF E1-PERSGR = "202" THEN 056240 IF E1-GD = "63" OR "90" THEN 056241 MOVE "DSME247" TO H-FEHLER 056242 PERFORM FEHLER 056243 END-IF 056244 END-IF 056259 . 056260 056261 056270 GDT523410-EXIT. 056300 EXIT. 022693*COPY CDSME250 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME250 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG PERSONENGRUPPE 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** DATUM : 17.07.2003 001630** VERSION : 002 / VERSION 35 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** DATUM : 22.10.2003 001680** VERSION : 003 / VERSION 36 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** DATUM : 11.10.2006 001693** VERSION : 004 / VERSION 56 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** DATUM : 23.04.2007 001697** VERSION : 004 / VERSION 62 001698**---------------------------------------------------------------- 001700 FDSME250 SECTION. 001710 FDSME250E. 001800 IF E1-SASC = " " THEN 001900 IF E1-GD = "60" OR "61" THEN 002000 GO TO FDSME250-EXIT 002100 ELSE 002110 IF E1-BBNRVU(1:3) = "996" THEN 002111 IF E1-GD = "99" THEN 002112 MOVE "DSME250" TO H-FEHLER 002113 END-IF 002130 ELSE 002131 MOVE "DSME250" TO H-FEHLER 002132 END-IF 003302 END-IF 003304 ELSE 003305** ---------------------------------------------------------- 003306** T52351 003307** ---------------------------------------------------------- 003308 MOVE E1-SASC TO SA-TAB 003309 IF NOT SA-OK 003310 MOVE "DSME252" TO H-FEHLER 003311 GO TO FDSME250-EXIT 003312 ELSE 003313** ------------------------------------------------------- 003314** ÄNDERUNG VOM 22.10.2003 / VERSION 36 003315** ------------------------------------------------------- 003317 IF OP-BWTRV OR OP-BZTRV 003318 IF E1-SASC NOT = "000" 003321 MOVE "DSME254" TO H-FEHLER 003323 END-IF 003324 ELSE 003325 IF E1-GD = "63" OR "99" THEN 003326 IF E1-SASC = "138" OR "132" 003327 MOVE "DSME253" TO H-FEHLER 003331 END-IF 003332 END-IF 003333 END-IF 003334 END-IF 003335 END-IF 003336 . 003340 FDSME250-EXIT. 003400 EXIT. 022694*COPY CDSME260 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME260 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-MELDESACHVERHALT 001600**---------------------------------------------------------------- 001700 FDSME260 SECTION. 001710 FDSME260E. 001800 IF E1-MMME = "J" OR "N" THEN 002700 GO TO FDSME260-EXIT 002900 ELSE 003000 MOVE "DSME260" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME260-EXIT. 003400 EXIT. 022695*COPY CDSME270 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME270 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-NAME 001600**---------------------------------------------------------------- 001700 FDSME270 SECTION. 001710 FDSME270E. 001800 IF E1-MMNA = "J" OR "N" THEN 002200 GO TO FDSME270-EXIT 002900 ELSE 003000 MOVE "DSME270" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME270-EXIT. 003400 EXIT. 022696*COPY CDSME280 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME280 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-GEBURTSANGABEN 001600**---------------------------------------------------------------- 001700 FDSME280 SECTION. 001710 FDSME280E. 001800 IF E1-MMGB = "J" OR "N" THEN 001910 GO TO FDSME280-EXIT 002900 ELSE 003000 MOVE "DSME280" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME280-EXIT. 003400 EXIT. 022697*COPY CDSME290 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME290 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-ANSCHRIFT 001600**---------------------------------------------------------------- 001700 FDSME290 SECTION. 001710 FDSME290E. 001800 IF E1-MMAN = "J" OR "N" THEN 001910 GO TO FDSME290-EXIT 002900 ELSE 003000 MOVE "DSME290" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME290-EXIT. 003400 EXIT. 022698*COPY CDSME300 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME300 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-EUROPäISCHE VSNR 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001610** ÄNDERUNGSDATUM : 11.10.2006 001620** VERSION : 002 - VERSION 56 001640**---------------------------------------------------------------- 001700 FDSME300 SECTION. 001710 FDSME300E. 001800 IF E1-MMEU = "J" OR "N" THEN 001900 IF E1-MMEU = "J" THEN 001910 MOVE E1-SASC TO EU-SASC-TAB 001920 IF NOT EU-SASC-OK THEN 001930 MOVE "DSME302" TO H-FEHLER 001940 GO TO FDSME300-EXIT 001950 ELSE 001960 IF OP-BWTRV OR OP-BZTRV 001970 MOVE "DSME304" TO H-FEHLER 001980 GO TO FDSME300-EXIT 001990 END-IF 001991 END-IF 002800 END-IF 002900 ELSE 003000 MOVE "DSME300" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME300-EXIT. 003400 EXIT. 022699*COPY CDSME310 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME310 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-SOFORTMELDUNG 001600**---------------------------------------------------------------- 001610** ERSTELLUNGSDATUM : 13.05.2003 001620** VERSION : 002 / 33 001630** FUNKTION : PRÜFUNG KZ FÜR DB-SOFORTMELDUNG 001631** : - NUR LEERZEICHEN ZULÄSSIG 001640**---------------------------------------------------------------- 001641** PROGRAMMIERER : MICHAEL KLEMKE 001650** ERSTELLUNGSDATUM : 23.11.2006 001660** VERSION : 003 / 56 001690**---------------------------------------------------------------- 001700 FDSME310 SECTION. 001710 FDSME310E. 001800 IF E1-RES-ST-176 = " " OR "N" THEN 001801 CONTINUE 001803** IF :S0:-RES-ST-176 = "N" 001804** IF OP-BWTRV OR OP-BZTRV OR 001805** OP-PVTRV OR OP-KSTRV OR 001806** OP-SOTBF OR OP-UETBF OR 001807** OP-ZFTRV 001808** CONTINUE 001809** ELSE 001810** MOVE "DSME318" TO H-FEHLER 001820** END-IF 001840** END-IF 002900 ELSE 003000 MOVE "DSME316" TO H-FEHLER 003100 END-IF 003317 . 003318 003319 003320 FDSME310-EXIT. 003400 EXIT. 022700*COPY CDSME320 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME320 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-BKN/SEE-KK 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄNDERUNGSDATUM : 18.03.2002 001621** ÄNDERUNG : WEITERE PRÜFUNGEN ZUM MMKS 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ÄNDERUNGSDATUM : 30.11.2002 001680** ÄNDERUNG : T524072 ENTFÄLLT 001690** VERSION : 003 001691**---------------------------------------------------------------- 001692** PROGRAMMIERER : MICHAEL KLEMKE 001693** ÄNDERUNGSDATUM : 14.10.2004 001695** VERSION : 004 - Version 41 001696**---------------------------------------------------------------- 001697** PROGRAMMIERER : MICHAEL KLEMKE 001698** ÄNDERUNGSDATUM : 06.12.2004 001699** VERSION : 005 - Version 42 001700**---------------------------------------------------------------- 001701** PROGRAMMIERER : MICHAEL KLEMKE 001702** ÄNDERUNGSDATUM : 11.10.2006 001703** VERSION : 006 - Version 56 001704**---------------------------------------------------------------- 001705** PROGRAMMIERER : MICHAEL KLEMKE 001706** ÄNDERUNGSDATUM : 23.02.2007 001707** VERSION : 007 - Version 60 001708**---------------------------------------------------------------- 001709** PROGRAMMIERER : MICHAEL KLEMKE 001710** ÄNDERUNGSDATUM : 23.04.2007 001711** VERSION : 008 - Version 62 001712**---------------------------------------------------------------- 001713 FDSME320 SECTION. 001720 FDSME320E. 001730** ------------------------------------------------------------- 001740** T52407 001750** ------------------------------------------------------------- 001800 IF E1-MMKS = "J" OR "N" THEN 001900 IF E1-MMKS = "J" THEN 002000 IF OP-BATRV OR OP-BWTRV OR OP-BZTRV OR 002010 OP-PVTRV OR OP-KSTRV OR OP-KSTKV OR 002011 OP-KTTRV THEN 002100 MOVE "DSME322" TO H-FEHLER 002200 ELSE 002300** ---------------------------------------------------- 002310** T524071 ANFANG 002400** ---------------------------------------------------- 002401 IF OP-AGDEU 002402 IF E1-BBNRVU(1:3) = "980" OR "098" 002410 CONTINUE 002420 ELSE 002421 IF E1-BBNRKK(1:8) = "99086875" 002422 IF E1-BBNRVU(1:3) = "099" OR "990" OR 002423 "991" OR "992" 002430 CONTINUE 002440 ELSE 002441 MOVE "DSME324" TO H-FEHLER 002480 END-IF 002481 ELSE 002482 MOVE "DSME324" TO H-FEHLER 002483 END-IF 002484 END-IF 002490 END-IF 002500** ---------------------------------------------------- 002510** T524071 ENDE 002520** ---------------------------------------------------- 002600 END-IF 002800 END-IF 002900 ELSE 003000 MOVE "DSME320" TO H-FEHLER 003100 END-IF 003317 . 003318 003319 003320 FDSME320-EXIT. 003400 EXIT. 003500 003600 022701*COPY CDSME330 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME330 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-SOZIALVERSICHERUNGSAUSW. 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄnderungsDATUM : 06.12.2004 001640** VERSION : 002 / 42 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ÄnderungsDATUM : 11.10.2006 001680** VERSION : 003 / 56 001690**---------------------------------------------------------------- 001700 FDSME330 SECTION. 001710 FDSME330E. 001800 IF E1-MMSV = "J" OR "N" THEN 001900 IF E1-MMSV = "J" THEN 002000 IF OP-AGDEU OR OP-WLTKV OR OP-BATRV 002010 OR OP-BWTRV OR OP-BZTRV OR OP-PVTRV OR OP-KSTRV 002020 OR OP-KSTKV OR OP-KTTRV 002100 MOVE "DSME332" TO H-FEHLER 002200 GO TO FDSME330-EXIT 002600 END-IF 002800 END-IF 002900 ELSE 003000 MOVE "DSME330" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME330-EXIT. 003400 EXIT. 022710*COPY CDSME340 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME340 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-VERGABE/RüCHMELDUNG 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 06.12.2004 001630** VERSION : 002 / 42 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 11.10.2006 001680** VERSION : 003 / 56 001690**---------------------------------------------------------------- 001700 FDSME340 SECTION. 001710 FDSME340E. 001800 IF E1-MMVR = "J" OR "N" THEN 001900 IF E1-MMVR = "J" THEN 002000 IF OP-AGDEU OR OP-KSTKV THEN 002100 MOVE "DSME342" TO H-FEHLER 002600 END-IF 002800 ELSE 002801 IF OP-AGDEU OR OP-KSTKV THEN 002802 CONTINUE 002803 ELSE 002806 IF OP-BATRV OR OP-KTTRV 002810 MOVE "DSME344" TO H-FEHLER 002830 END-IF 002831 END-IF 002840 END-IF 002900 ELSE 003000 MOVE "DSME340" TO H-FEHLER 003100 END-IF 003317 . 003318 003319 003320 FDSME340-EXIT. 003400 EXIT. 022711*COPY CDSME350 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME350 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-RüCKMELDUNG GERINGF. 001600**---------------------------------------------------------------- 001700 FDSME350 SECTION. 001710 FDSME350E. 001800 IF E1-MMRG = "J" OR "N" THEN 001900 IF E1-MMRG = "J" THEN 002000 IF OP-RVTKV OR OP-WLTKV THEN 002010 GO TO FDSME350-EXIT 002520 ELSE 002530 MOVE "DSME352" TO H-FEHLER 002540 GO TO FDSME350-EXIT 002600 END-IF 002800 END-IF 002900 ELSE 003000 MOVE "DSME350" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME350-EXIT. 003400 EXIT. 022712*COPY CDSME360 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME360 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR ALTMELDUNG 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001620** ÄNDERUNG : 001 VOM 15.11.2000 001621**---------------------------------------------------------------- 001622** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001623** ÄNDERUNG : 002 VOM 30.04.2001 VERSION 24 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 22.10.2003 VERSION 36 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ÄNDERUNG : 004 VOM 18.05.2004 VERSION 40 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ÄNDERUNG : 005 VOM 11.10.2004 VERSION 41 001693**---------------------------------------------------------------- 001694** PROGRAMMIERER : MICHAEL KLEMKE 001695** ÄNDERUNG : 006 VOM 07.12.2004 VERSION 42 001696**---------------------------------------------------------------- 001697** PROGRAMMIERER : MICHAEL KLEMKE 001698** ÄNDERUNG : 007 VOM 02.06.2005 VERSION 46 001699**---------------------------------------------------------------- 001700** PROGRAMMIERER : MICHAEL KLEMKE 001701** ÄNDERUNG : 008 VOM 11.10.2006 VERSION 56 001702**---------------------------------------------------------------- 001710 FDSME360 SECTION. 001800 FDSME360E. 001801 SET T524112-AUSF TO TRUE 001810** ------------------------------------------------------------- 001820** T52411 001830** ------------------------------------------------------------- 001900 IF E1-KENNZUE NOT = "A" AND 001901 E1-KENNZUE NOT = " " AND 001902 E1-KENNZUE NOT = "1" AND 001903 E1-KENNZUE NOT = "2" AND 001904 E1-KENNZUE NOT = "3" AND 001905 E1-KENNZUE NOT = "4" AND 001906 E1-KENNZUE NOT = "5" AND 001907 E1-KENNZUE NOT = "6" AND 001908 E1-KENNZUE NOT = "7" AND 001909 E1-KENNZUE NOT = "8" THEN 001910 MOVE "DSME360" TO H-FEHLER 001911 SET T524112-NOT-AUSF TO TRUE 001912 PERFORM FEHLER 001913 ELSE 001914 IF E1-KENNZUE = "A" THEN 001915 SET T524112-NOT-AUSF TO TRUE 001920 IF OP-BWTRV OR OP-BZTRV OR OP-ZFTRV THEN 001921 MOVE "DSME361" TO H-FEHLER 001922 PERFORM FEHLER 001923 ELSE 001924** -------------------------------------------------- 001925** T524113 001926** -------------------------------------------------- 001927 SET T524112-NOT-AUSF TO TRUE 001928 IF P-DATE < 20050101 THEN 001929 CONTINUE 001930 ELSE 001931 IF E1-GD = "60" OR "61" or "62" OR "63" OR 001932 "80" OR "90" OR "99" 001933 MOVE "DSME363" TO H-FEHLER 001934 PERFORM FEHLER 001935 END-IF 001936 END-IF 001941** -------------------------------------------------- 001942 END-IF 001943 ELSE 001944 IF E1-KENNZUE = "1" OR "2" OR "3" OR "4" OR "5" OR 001945 "6" OR "7" 001946 IF OP-DSTBF OR OP-BFTDS OR OP-BATRV OR OP-RVTBA 001947 CONTINUE 001948 ELSE 001949 MOVE "DSME362" TO H-FEHLER 001950 PERFORM FEHLER 001951 SET T524112-NOT-AUSF TO TRUE 001952 END-IF 001953 ELSE 001954 IF E1-KENNZUE = "8" THEN 001955 SET T524112-NOT-AUSF TO TRUE 001956 IF NOT OP-KTTRV AND NOT OP-RVTKT 001957 MOVE "DSME365" TO H-FEHLER 001958 PERFORM FEHLER 001959 END-IF 001960 END-IF 001970 END-IF 002500 IF E1-PERSGR = "999" THEN 002600 MOVE "DSME364" TO H-FEHLER 002700 PERFORM FEHLER 002710 SET T524112-NOT-AUSF TO TRUE 002800 END-IF 002900 IF E1-GD = "00" OR "01" OR "02" OR "03" OR "04" OR 003000 "05" OR "07" OR "08" OR "09" THEN 003100 MOVE "DSME366" TO H-FEHLER 003200 PERFORM FEHLER 003300 SET T524112-NOT-AUSF TO TRUE 003400 END-IF 003500 END-IF 003700 END-IF 003701 IF T524112-AUSF 003702** ---------------------------------------------------------- 003703** T524112 003704** ---------------------------------------------------------- 003705 IF OP-BATRV 003706 IF E1-KENNZUE = "1" OR "2" OR "3" OR "4" OR "5" OR 003707 "6" OR "7" 003710 CONTINUE 003711 ELSE 003712 MOVE "DSME362" TO H-FEHLER 003713 PERFORM FEHLER 003715 END-IF 003716 ELSE 003717 IF OP-KTTRV 003718 IF E1-KENNZUE NOT = "8" 003719 MOVE "DSME365" TO H-FEHLER 003720 PERFORM FEHLER 003723 END-IF 003724 END-IF 003725 END-IF 003730 END-IF 003800 . 003810 003820 003900 FDSME360-EXIT. 004000 EXIT. 004100 004200 022713*COPY CDSME380 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME380 001000** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001100** ERSTELLUNGSDATUM : 15.11.2000 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG MERKMAL ÜBERMITTLUNGSWEG 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 22.10.2003 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 13.04.2005 001680** VERSION : 003 001690**---------------------------------------------------------------- 001700 FDSME380 SECTION. 001710 FDSME380E. 001720** ------------------------------------------------------------- 001730** T52412 001740** ------------------------------------------------------------- 001800 IF E1-MMMQ = " " OR "1" OR "2" OR "9" THEN 001801** ---------------------------------------------------------- 001802** ÄNDERUNG VOM 22.10.2003 / VERSION 36 001803** ---------------------------------------------------------- 001804 IF E1-MMMQ NOT = " " 001805** ------------------------------------------------------- 001806** ÄNDERUNG VOM 13.04.2005 / VERSION 45 001807** ------------------------------------------------------- 001808 IF OP-BWTRV OR OP-BZTRV OR OP-ZFTRV OR 001809 OP-BATRV OR OP-KTTRV THEN 001810 MOVE "DSME381" TO H-FEHLER 001811 END-IF 001812 END-IF 001820 ELSE 001930 MOVE "DSME380" TO H-FEHLER 003100 END-IF 003317 . 003320 FDSME380-EXIT. 003400 EXIT. 022714*COPY CDSME390 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME390 001000** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001100** ERSTELLUNGSDATUM : 30.04.2001 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KENNZ-UNIPOST-GEPRUEFT 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 22.10.2003 001630** VERSION : 002 / VERSION 36 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 13.04.2005 001680** VERSION : 003 / VERSION 45 001690**---------------------------------------------------------------- 001700 FDSME390 SECTION. 001710 FDSME390E. 001720** ------------------------------------------------------------- 001730** T52413 001740** ------------------------------------------------------------- 001800 IF E1-KENNZUP = "D" OR " " THEN 001801** ---------------------------------------------------------- 001802** T524131 001803** ---------------------------------------------------------- 001804 IF E1-KENNZUP = "D" THEN 001805 IF E1-GD = "99" THEN 001806** ---------------------------------------------------- 001807** ÄNDERUNG VOM 22.10.2003 / VERSION 36 001808** ---------------------------------------------------- 001809 IF OP-BWTRV OR OP-BZTRV OR OP-ZFTRV OR 001810 OP-BATRV OR OP-KTTRV THEN 001811 MOVE "DSME386" TO H-FEHLER 001812 END-IF 001813 ELSE 001814 MOVE "DSME385" TO H-FEHLER 001815 END-IF 001816 END-IF 001817 ELSE 001818 MOVE "DSME383" TO H-FEHLER 003100 END-IF 003317 . 003318 003319 003320 FDSME390-EXIT. 003400 EXIT. 003500 003600 022715*COPY CDSME395 REPLACING ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSME395 001000** PROGRAMMIERER : MICHAEL KLEMKE 001100** ERSTELLUNGSDATUM : 13.12.2001 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRÜFUNG KENNZ-GESAMTVERS 001600**---------------------------------------------------------------- 001610** ERSTELLUNGSDATUM : 03.02.2003 001620** VERSION : 002 / 030 001630** ÄNDERUNG : DSME389 ENTFÄLLT 001640**---------------------------------------------------------------- 001650** ERSTELLUNGSDATUM : 07.05.2003 001660** VERSION : 003 / 033 001670** ÄNDERUNG : DSME388 NEU 001680**---------------------------------------------------------------- 001690** ERSTELLUNGSDATUM : 03.06.2003 MECKELEIN WERNER 001691** VERSION : 004 / 034 001692** ÄNDERUNG : DSME388 ENTFÄLLT 001693**---------------------------------------------------------------- 001694** PROGRAMMIERER : MICHAEL KLEMKE 001695** ERSTELLUNGSDATUM : 22.10.2003 001697** VERSION : 005 / 036 001698**---------------------------------------------------------------- 001699** PROGRAMMIERER : MICHAEL KLEMKE 001700** ERSTELLUNGSDATUM : 11.10.2004 001701** VERSION : 006 / 041 001702**---------------------------------------------------------------- 001703** PROGRAMMIERER : MICHAEL KLEMKE 001704** ERSTELLUNGSDATUM : 13.04.2005 001705** VERSION : 007 / 045 001706**---------------------------------------------------------------- 001707** PROGRAMMIERER : MICHAEL KLEMKE 001708** ERSTELLUNGSDATUM : 11.10.2006 001709** VERSION : 008 / 056 001710**---------------------------------------------------------------- 001711 FDSME395 SECTION. 001712 FDSME395E. 001720** ------------------------------------------------------------- 001730** T52414 001740** ------------------------------------------------------------- 001800 IF E1-KENNZGV = " " OR "J" OR "N" THEN 001816 CONTINUE 001829 ELSE 001830 MOVE "DSME387" TO H-FEHLER 001840 PERFORM FEHLER 003100 END-IF 003200** ------------------------------------------------------------- 003302** T52415 003310** ------------------------------------------------------------- 003311 IF E1-KENNZSTA = " " OR "1" OR "2" OR "3" OR "5" 003312 CONTINUE 003313 ELSE 003314 MOVE "DSME400" TO H-FEHLER 003315 PERFORM FEHLER 003316 END-IF 003317 IF E1-MM-UEBERW-EINZUGSVG = " " OR "N" OR "J" 003318 IF E1-MM-UEBERW-EINZUGSVG = "J" 003319 IF OP-DSTBF 003320 CONTINUE 003321 ELSE 003322 MOVE "DSME542" TO H-FEHLER 003323 PERFORM FEHLER 003325 END-IF 003326 END-IF 003327 ELSE 003328 MOVE "DSME500" TO H-FEHLER 003329 PERFORM FEHLER 003330 END-IF 003331 IF E1-FILLER(1:4) NOT = " " 003332 MOVE "DSME410" TO H-FEHLER 003333 PERFORM FEHLER 003334 END-IF 003335 IF OP-AGDEU 003336 IF E1-KENNZSTA = " " OR "1" OR "2" 003337 CONTINUE 003338 ELSE 003339 MOVE "DSME402" TO H-FEHLER 003340 PERFORM FEHLER 003341 END-IF 003342 END-IF 003343 003344 . 003345 003346 003350 FDSME395-EXIT. 003400 EXIT. 003500 003600 022716*COPY CDBNA010 REPLACING ==:S2:== BY ==E3==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBNA010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG FAMILIENNAME 001600**---------------------------------------------------------------- 001800** PROGRAMMIERER : MICHAEL KLEMKE 001900** ÄNDERUNGSDATUM : 24.04.2006 002000** VERSION : 002 / 053 002200**---------------------------------------------------------------- 002300** PROGRAMMIERER : MICHAEL KLEMKE 002310** ÄNDERUNGSDATUM : 12.10.2006 002320** VERSION : 003 / 056 002330**---------------------------------------------------------------- 002400 FDBNA010 SECTION. 002500 FDBNA010E. 002600 IF E3-FMNA = " " THEN 002700 MOVE "DBNA005" TO H-FEHLER 002800 PERFORM FEHLER 002900 GO TO FDBNA010-EXIT 003000 END-IF 003100** ERMITTELN TATSäCHLICHE LäNGE FMNA 003200 MOVE 30 TO I 003300 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E3-FMNA(I:1) 003400 NOT = SPACE 003500 COMPUTE I = I - 1 END-COMPUTE 003600 END-PERFORM 003700 MOVE I TO AKTLG 003800 MOVE SPACES TO ALPHA-TAB11 003900** üBERTRAGEN IN HILFSFELD 004000 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 004100 MOVE E3-FMNA(I : 1) TO ALPHA-ELEM(I) 004101 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 004110 TO GROSSBUCHSTB 004200 END-PERFORM 004210** PRüFEN MINDESTENS 2 BUCHSTABEN 004220 MOVE 0 TO ZIFF-Z 004230 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 004240 IF ALPHA-ELEM(I) IS ALPHA-ALLG 004250 ADD 1 TO ZIFF-Z 004260 END-IF 004270 END-PERFORM 004271 IF OP-CODE(3:3) = "TRV" OR "TWL" THEN 004280 IF ZIFF-Z < 2 THEN 004290 MOVE "DBNA007" TO H-FEHLER 004291 PERFORM FEHLER 004292 GO TO FDBNA010-EXIT 004293 END-IF 004294 END-IF 004300** PRüFEN AUF GLEICHE SONDERZEICHEN 004400 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 004500 OR HFELD-S = 1 004600 IF ALPHA-ELEM(I) IS SONDERZ THEN 004700 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 004800 MOVE "DBNA010" TO H-FEHLER 004900 MOVE 1 TO HFELD-S 005000 END-IF 005100 END-IF 005200 END-PERFORM 005300 IF HFELD-S = 1 THEN 005400 PERFORM FEHLER 005500 END-IF 005510** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM NAMENSANFANG 005520 IF AKTLG >= 3 AND ALPHA-ELEM(1) IS ALPHA-ALLG AND 005521 (ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND ALPHA-ELEM(1) 005530 EQUAL ALPHA-ELEM(3)) THEN 005540 MOVE "DBNA011" TO H-FEHLER 005550 PERFORM FEHLER 005560 END-IF 005600** PRüFEN AUF KOMBI BLANK-BINDE/SCHRäGSTRICH 005700 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 005800 OR HFELD-S = 1 005900 IF ALPHA-ELEM(I) = "-" THEN 006000 IF ALPHA-ELEM(I + 1) = " " OR (I > 1 AND 006100 ALPHA-ELEM(I - 1) = " ") THEN 006200 MOVE "DBNA012" TO H-FEHLER 006300 MOVE 1 TO HFELD-S 006400 END-IF 006500 END-IF 006600 END-PERFORM 006700 IF HFELD-S = 1 THEN 006800 PERFORM FEHLER 006900 END-IF 007000** PRüFEN AUF GüLTIGE ZEICHEN 007100 IF E3-FMNA(1:AKTLG) NOT FMNA-ALPHA AND AKTLG > ZERO THEN 007200 MOVE "DBNA014" TO H-FEHLER 007300 PERFORM FEHLER 007400 END-IF 007500** PRüFEN 1 ZEICHEN BUCHSTABE 007600 IF E3-FMNA(1:1) NOT ALPHA-ALLG OR E3-FMNA(1:1) EQUAL "ß" 007700 MOVE "DBNA020" TO H-FEHLER 007800 PERFORM FEHLER 007900 END-IF 008000** PRüFEN LETZTES ZEICHEN BUCHSTABE, PUNKT 008100 IF E3-FMNA(AKTLG:1) NOT FMNAL-ALLG AND AKTLG > ZERO THEN 008200 MOVE "DBNA022" TO H-FEHLER 008300 MOVE 1 TO HFELD-S 008400 END-IF 008500 IF HFELD-S = 1 THEN 008600 PERFORM FEHLER 008700** PERFORM NAT6012 008800 END-IF 008900 PERFORM NAT6012 009000 . 009100 FDBNA010-EXIT. 009200 EXIT. 009300 NAT6012 SECTION. 009400 NAT6012E. 009500** PRüFEN OB MEHR ALS ZWEI ZIFFERN 009510 MOVE 0 TO ZIFF-Z 009600 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 009700 IF ALPHA-ELEM(I) IS ZIFF-ALLG 009800 ADD 1 TO ZIFF-Z 009900 END-IF 010000 END-PERFORM 010100 IF ZIFF-Z > 2 THEN 010200 MOVE "DBNA015" TO H-FEHLER 010300 PERFORM FEHLER 010400 END-IF 010500** PRüFEN ZIFFERN HINTEREINANDER 010600 IF ZIFF-Z = 2 THEN 010700 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) 010800 IS ZIFF-ALLG 010900 CONTINUE 011000 END-PERFORM 011100 IF ALPHA-ELEM(I + 1) NOT ZIFF-ALLG THEN 011200 MOVE "DBNA015" TO H-FEHLER 011300 PERFORM FEHLER 011400 END-IF 011500** PRüFEN OB VOR 1 ZIFFER BLANK UND BUCHSTABE 011600 IF I > 1 AND ALPHA-ELEM(I - 1) = " " THEN 011700 IF I > 2 AND ALPHA-ELEM(I - 2) IS ALPHA-ALLG THEN 011800 CONTINUE 011900 ELSE 012000 MOVE "DBNA018" TO H-FEHLER 012100 PERFORM FEHLER 012200 END-IF 012300 ELSE 012400 MOVE "DBNA018" TO H-FEHLER 012500 PERFORM FEHLER 012600 END-IF 012700 END-IF 012800 IF ZIFF-Z = 1 012900 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) 013000 IS ZIFF-ALLG 013100 CONTINUE 013200 END-PERFORM 013300 IF I > 1 AND ALPHA-ELEM(I - 1) = " " THEN 013400 IF I > 2 AND ALPHA-ELEM(I - 2) IS ALPHA-ALLG THEN 013500 CONTINUE 013600 ELSE 013700 MOVE "DBNA018" TO H-FEHLER 013800 PERFORM FEHLER 013900 END-IF 014000 ELSE 014100 MOVE "DBNA018" TO H-FEHLER 014200 PERFORM FEHLER 014300 END-IF 014400 END-IF 014500 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 014600 OR I > AKTLG 014700 CONTINUE 014800 END-PERFORM 014900 IF ALPHA-ELEM(I) = "." THEN 015000** ---------------------------------------------------------- 015001** T6014 015002** ---------------------------------------------------------- 015003** PRüFEN OB PUNKT LETZTES ZEICHEN 015004** ---------------------------------------------------------- 015005 IF I = AKTLG THEN 015006** ------------------------------------------------------- 015007** PRüFEN OB VOR PUNKT EINE ZIFFER 015008** ------------------------------------------------------- 015009 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ZIFF-ALLG THEN 015010 MOVE "DBNA016" TO H-FEHLER 015011 PERFORM FEHLER 015012 END-IF 015013 ELSE 015014 IF I > 2 015015 COMPUTE IX = I - 2 015016 IF ALPHA-TAB11(IX:2) = "ST" 015017** ------------------------------------------------- 015018** PRÜFEN OB EIN WEITERER PUNKT 015020** ------------------------------------------------- 015021 COMPUTE I = I + 1 015022 PERFORM VARYING I FROM I BY 1 015023 UNTIL ALPHA-ELEM(I) = "." 015024 OR I > AKTLG 015025 CONTINUE 015026 END-PERFORM 015027 IF I > AKTLG THEN 015028 CONTINUE 015029 ELSE 015031 IF I = AKTLG THEN 015032** ------------------------------------------- 015033** PRüFEN OB VOR PUNKT EINE ZIFFER 015034** ------------------------------------------- 015036 IF I > 1 AND ALPHA-ELEM(I - 1) 015037 NOT ZIFF-ALLG THEN 015038 MOVE "DBNA016" TO H-FEHLER 015039 PERFORM FEHLER 015040 END-IF 015041 ELSE 015043 COMPUTE IX = I - 2 015044 IF ALPHA-TAB11(IX:2) = "ST" 015045 CONTINUE 015046 ELSE 015047 MOVE "DBNA016" TO H-FEHLER 015048 PERFORM FEHLER 015049 END-IF 015050 END-IF 015051 END-IF 015054 ELSE 015055 MOVE "DBNA016" TO H-FEHLER 015056 PERFORM FEHLER 015057 END-IF 015059 ELSE 015060 MOVE "DBNA016" TO H-FEHLER 015061 PERFORM FEHLER 015063 END-IF 015070 END-IF 016100 END-IF 016200 . 016300 NAT6012-EXIT. 016400 EXIT. 022717*COPY CDBNA030 REPLACING ==:S2:== BY ==E3==. 000100**---------------------------------------------------------------- 000200** COPY-MEMBER : CDBNA030 000300** PROGRAMMIERER : WERNER KRAUS 000400** ERSTELLUNGSDATUM : 05.05.1998 000500** VERSION : 001 (PGM-NSOERSTELLUNG) 000600** FUNKTION : FEHLERPRüFUNG VORNAME 000700**---------------------------------------------------------------- 000710** PROGRAMMIERER : MICHAEL KLEMKE 000720** ERSTELLUNGSDATUM : 26.10.2003 000730** VERSION : 002 000750**---------------------------------------------------------------- 000760** PROGRAMMIERER : MICHAEL KLEMKE 000770** ERSTELLUNGSDATUM : 24.04.2006 000780** VERSION : 003 000790**---------------------------------------------------------------- 000791** PROGRAMMIERER : MICHAEL KLEMKE 000792** ERSTELLUNGSDATUM : 12.10.2006 000793** VERSION : 004 / 056 000794**---------------------------------------------------------------- 000795** PROGRAMMIERER : MICHAEL KLEMKE 000796** ERSTELLUNGSDATUM : 23.04.2007 000797** VERSION : 005 / 062 000798**---------------------------------------------------------------- 000800 FDBNA030 SECTION. 000900 FDBNA030E. 001000 IF E3-VONA = " " THEN 001100 MOVE "DBNA028" TO H-FEHLER 001300 ELSE 001310** ---------------------------------------------------------- 001400** ERMITTELN TATSäCHLICHE LäNGE VONA 001410** ---------------------------------------------------------- 001500 MOVE 30 TO I 001600 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E3-VONA(I : 1) 001700 NOT = SPACE 001800 COMPUTE I = I - 1 001900 END-PERFORM 002000 MOVE I TO AKTLG 002100 MOVE SPACES TO ALPHA-TAB11 002110** ---------------------------------------------------------- 002200** üBERTRAGEN IN HILFSFELD 002210** ---------------------------------------------------------- 002300 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 002400 MOVE E3-VONA(I : 1) TO ALPHA-ELEM(I) 002401 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 002410 TO GROSSBUCHSTB 002500 END-PERFORM 002510** ---------------------------------------------------------- 002600** PRüFEN MINDESTENS 2 BUCHSTABEN 002610** ---------------------------------------------------------- 002700 MOVE 0 TO ZIFF-Z 002800 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 002900 IF ALPHA-ELEM(I) IS ALPHA-ALLG 003000 ADD 1 TO ZIFF-Z 003100 END-IF 003200 END-PERFORM 003210** ---------------------------------------------------------- 003220** T602 003230** ---------------------------------------------------------- 003300 IF OP-CODE(3:3) = "TRV" OR "TWL" THEN 003400 IF ZIFF-Z < 2 THEN 003500 MOVE "DBNA029" TO H-FEHLER 003700 ELSE 003701** ---------------------------------------------------- 003702** AUFRUF T6021 003703** ---------------------------------------------------- 003710 PERFORM T6021 003800 END-IF 003810 ELSE 003811** ------------------------------------------------------- 003812** AUFRUF T6021 003813** ------------------------------------------------------- 003820 PERFORM T6021 003900 END-IF 003901 END-IF 003910 . 003920 003921 FDBNA030-EXIT. 003922 EXIT. 003930 003940 003941 T6021 SECTION. 003942 T602E. 003943** ------------------------------------------------------------- 003944** T6021 003945** ------------------------------------------------------------- 003946** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 003947** ------------------------------------------------------------- 003948 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 003949 IF ALPHA-ELEM(I) IS SONDERZ THEN 003950 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 003951 MOVE "DBNA030" TO H-FEHLER 003952 PERFORM FEHLER 003953 END-IF 003954 END-IF 003955 END-PERFORM 003956** ------------------------------------------------------------- 003957** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM ANFANG 003958** ------------------------------------------------------------- 003959 IF AKTLG >= 3 AND ALPHA-ELEM(1) IS ALPHA-ALLG AND 003960 (ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND ALPHA-ELEM(1) 003961 EQUAL ALPHA-ELEM(3)) THEN 003962 MOVE "DBNA031" TO H-FEHLER 003963 PERFORM FEHLER 003964 END-IF 003965** ------------------------------------------------------------- 003966** üBERPRüFEN AUF KOMBI BLANK-BINDESTRICHE/SCHRäGSTRICH 003967** ------------------------------------------------------------- 003968 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 003969 IF ALPHA-ELEM(I) = "-" THEN 003970 IF ALPHA-ELEM(I + 1) = " " OR (I > 1 AND 003971 ALPHA-ELEM(I - 1) = " ") THEN 003972 MOVE "DBNA032" TO H-FEHLER 003973 PERFORM FEHLER 003974 END-IF 003975 END-IF 003976 END-PERFORM 003977** ------------------------------------------------------------- 003978** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 003979** ------------------------------------------------------------- 003980 IF E3-VONA(1:AKTLG) NOT VONA-ALPHA AND AKTLG > ZERO THEN 003981 MOVE "DBNA034" TO H-FEHLER 003982 PERFORM FEHLER 003983 END-IF 003984** ------------------------------------------------------------- 003985** PRüFEN 1 ZEICHEN BUCHSTABE 003986** ------------------------------------------------------------- 003987 IF E3-VONA(1:1) NOT ALPHA-ALLG OR E3-VONA(1:1) EQUAL "ß" 003988 MOVE "DBNA036" TO H-FEHLER 003989 PERFORM FEHLER 003990 END-IF 003991** ------------------------------------------------------------- 003992** PRüFEN LETZTES ZEICHEN BUCHSTABE 003993** ------------------------------------------------------------- 003994 IF E3-VONA(AKTLG:1) NOT ALPHA-ALLG AND AKTLG > ZERO THEN 003995 MOVE "DBNA036" TO H-FEHLER 003996 PERFORM FEHLER 003997 END-IF 003998** ------------------------------------------------------------- 003999** T6022 004000** ------------------------------------------------------------- 004001 IF E3-VONA = E3-FMNA 004002 IF E3-VONA = "Storno " OR 004003 E3-VONA = "STORNO " OR 004004 E3-VONA = "Unbekannt " OR 004005 E3-VONA = "UNBEKANNT " OR 004006 E3-VONA = "Gelöscht " OR 004007 E3-VONA = "GELÖSCHT " OR 004008 E3-VONA = "GELOESCHT " OR 004009 E3-VONA = "Ungültig " OR 004010 E3-VONA = "UNGÜLTIG " OR 004011 E3-VONA = "UNGUELTIG " THEN 004012 MOVE "DBNA038" TO H-FEHLER 004013 END-IF 004014 ELSE 004015 IF E3-VONA = "Ohne " OR 004016 E3-VONA = "OHNE " OR 004017 E3-VONA = "Unbekannt " OR 004018 E3-VONA = "UNBEKANNT " OR 004019 E3-VONA = "Herr " OR 004020 E3-VONA = "HERR " OR 004021 E3-VONA = "Frau " OR 004022 E3-VONA = "FRAU " THEN 004023 MOVE "DBNA035" TO H-FEHLER 004024 END-IF 004025 END-IF 004026 . 004027 004028 T6021-EXIT. 004029 EXIT. 004030 004040 004100 022718*COPY CDBNA040 REPLACING ==:S2:== BY ==E3==. 060970**---------------------------------------------------------------- 060980** COPY-MEMBER : CDBNA040 060990** PROGRAMMIERER : WERNER KRAUS 061000** ERSTELLUNGSDATUM : 05.05.1998 061010** VERSION : 001 (PGM-NSOERSTELLUNG) 061020** FUNKTION : FEHLERPRüFUNG VORSATZWORT 061030**---------------------------------------------------------------- 061031** AENDERUNGSDATUM : 25.06.2001 061032** VERSION : 002 061033** AENDERUNG : FELDLÄNGE VON VOSA ALS VARIABLE 061034**---------------------------------------------------------------- 061040 FDBNA040 SECTION. 061050 FDBNA040E. 061060 IF E3-VOSA EQUAL SPACE THEN 061070 GO TO FDBNA040-EXIT 061080 END-IF 061091** ------------------------------------------------------------- 061092** FELDLAENGE ALS VARIABLE (UNTERSCHIED DUEVO / KVDR) 061093** ------------------------------------------------------------- 061094 MOVE DBNA-VOSA-LEN TO I 061095** ------------------------------------------------------------- 061110 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E3-VOSA(I: 1) 061120 NOT = SPACE 061121** ---------------------------------------------------------- 061122** ERMITTELN TATSäCHLICHE LäNGE VOSA 061123** ---------------------------------------------------------- 061130 COMPUTE I = I - 1 END-COMPUTE 061140 END-PERFORM 061150 MOVE I TO AKTLG 061160 MOVE SPACES TO ALPHA-TAB11 061170** üBERTRAGEN IN HILFSFELD 061180 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 061190 MOVE E3-VOSA(I:1) TO ALPHA-ELEM(I) 061200 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 061210 TO GROSSBUCHSTB 061220 END-PERFORM 061230** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 061240 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 061250 OR HFELD-S = 1 061260 IF ALPHA-ELEM(I) IS SONDERZ THEN 061270 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 061280 MOVE "DBNA040" TO H-FEHLER 061290 MOVE 1 TO HFELD-S 061300 END-IF 061310 END-IF 061320 END-PERFORM 061330 IF HFELD-S = 1 THEN 061340 PERFORM FEHLER 061350 END-IF 061500** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 061510 IF E3-VOSA(1:AKTLG) NOT VOSA-ALPHA AND AKTLG > ZERO THEN 061520 MOVE "DBNA044" TO H-FEHLER 061530 PERFORM FEHLER 061540 END-IF 061550** PRüFEN 1 ZEICHEN BUCHSTABE 061560 IF E3-VOSA(1:1) NOT ALPHA-ALLG THEN 061570 MOVE "DBNA046" TO H-FEHLER 061580 PERFORM FEHLER 061590 END-IF 061600** PRüFEN OB PUNKT VORHANDEN 061610 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 061620 OR I > AKTLG 061630 CONTINUE 061640 END-PERFORM 061650 IF ALPHA-ELEM(I) = "." THEN 061660 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ALPHA-ALLG 061670 MOVE "DBNA048" TO H-FEHLER 061680 PERFORM FEHLER 061690 ELSE IF I = 1 THEN 061700 MOVE "DBNA048" TO H-FEHLER 061710 PERFORM FEHLER 061720 END-IF 061730 END-IF 061740 END-IF 061750 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 061760 OR ALPHA-ELEM(I) NOT ALPHA-ALLG 061770 CONTINUE 061780 END-PERFORM 061790 IF I > 1 061800 COMPUTE I = I - 1 END-COMPUTE 061810 MOVE ALPHA-TAB1(3:I) TO VOSA-TAB 061820 IF NOT VOSA-OK THEN 061830 MOVE "DBNA050" TO H-FEHLER 061840 PERFORM FEHLER 061850 END-IF 061860 END-IF 061870 . 061880 FDBNA040-EXIT. 061890 EXIT. 022719*COPY CDBNA060 REPLACING ==:S2:== BY ==E3==. 061910**---------------------------------------------------------------- 061920** COPY-MEMBER : CDBNA060 061930** PROGRAMMIERER : WERNER KRAUS 061940** ERSTELLUNGSDATUM : 05.05.1998 061950** VERSION : 001 (PGM-NSOERSTELLUNG) 061960** FUNKTION : FEHLERPRüFUNG NAMENSZUSATZ 061970**---------------------------------------------------------------- 061980 FDBNA060 SECTION. 061990 FDBNA060E. 062000 IF E3-NAZU EQUAL SPACE THEN 062010 GO TO FDBNA060-EXIT 062020 END-IF 062030** ERMITTELN TATSäCHLICHE LäNGE NAZU 062040 MOVE 20 TO I 062050 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E3-NAZU(I:1) 062060 NOT = SPACE 062070 COMPUTE I = I - 1 END-COMPUTE 062080 END-PERFORM 062090 MOVE I TO AKTLG 062100 MOVE SPACES TO ALPHA-TAB11 062110** üBERTRAGEN IN HILFSFELD 062120 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 062130 MOVE E3-NAZU(I:1) TO ALPHA-ELEM(I) 062140 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 062150 TO GROSSBUCHSTB 062160 END-PERFORM 062170** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 062180 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 062190 OR HFELD-S = 1 062200 IF ALPHA-ELEM(I) IS SONDERZ THEN 062210 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 062220 MOVE "DBNA060" TO H-FEHLER 062230 MOVE 1 TO HFELD-S 062240 END-IF 062250 END-IF 062260 END-PERFORM 062270 IF HFELD-S = 1 062280 PERFORM FEHLER 062290 END-IF 062440** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 062450 IF E3-NAZU(1:AKTLG) NOT VOSA-ALPHA AND AKTLG > ZERO THEN 062460 MOVE "DBNA064" TO H-FEHLER 062470 PERFORM FEHLER 062480 END-IF 062490** PRüFEN 1 ZEICHEN BUCHSTABE 062500 IF E3-NAZU(1:1) NOT ALPHA-ALLG THEN 062510 MOVE "DBNA066" TO H-FEHLER 062520 PERFORM FEHLER 062530 END-IF 062540** PRüFEN OB PUNKT VORHANDEN 062550 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 062560 OR I > AKTLG 062570 CONTINUE 062580 END-PERFORM 062590 IF ALPHA-ELEM(I) = "." THEN 062600 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ALPHA-ALLG 062610 MOVE "DBNA068" TO H-FEHLER 062620 PERFORM FEHLER 062630 ELSE IF I = 1 THEN 062640 MOVE "DBNA068" TO H-FEHLER 062650 PERFORM FEHLER 062660 END-IF 062670 END-IF 062680 END-IF 062690 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 062700 OR ALPHA-ELEM(I) NOT ALPHA-ALLG 062710 CONTINUE 062720 END-PERFORM 062730 IF I > 1 062740 COMPUTE I = I - 1 END-COMPUTE 062750 MOVE ALPHA-TAB1(3:I) TO NAZU-TAB 062760 IF NOT NAZU-OK THEN 062770 MOVE "DBNA070" TO H-FEHLER 062780 PERFORM FEHLER 062790 END-IF 062800 END-IF 062810 . 062820 FDBNA060-EXIT. 062830 EXIT. 022720*COPY CDBNA080 REPLACING ==:S2:== BY ==E3==. 063030**---------------------------------------------------------------- 063040** COPY-MEMBER : CDBNA080 063050** PROGRAMMIERER : WERNER KRAUS 063060** ERSTELLUNGSDATUM : 05.05.1998 063070** VERSION : 001 (PGM-NSOERSTELLUNG) 063080** FUNKTION : FEHLERPRüFUNG NAMENSZUSATZ 063090**---------------------------------------------------------------- 063100 FDBNA080 SECTION. 063110 FDBNA080E. 063120 IF E3-TITEL = SPACE THEN 063130 GO TO FDBNA080-EXIT 063140 END-IF 063150** ERMITTELN TATSäCHLICHE LäNGE TITEL 063160 MOVE 20 TO I 063170 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E3-TITEL(I:1) 063180 NOT = SPACE 063190 COMPUTE I = I - 1 END-COMPUTE 063200 END-PERFORM 063210 MOVE I TO AKTLG 063220 MOVE SPACES TO ALPHA-TAB11 063230** üBERTRAGEN IN HILFSFELD 063240 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 063250 MOVE E3-TITEL(I:1) TO ALPHA-ELEM(I) 063251 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 063252 TO GROSSBUCHSTB 063260 END-PERFORM 063270** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 063280 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 063290 OR HFELD-S = 1 063300 IF ALPHA-ELEM(I) IS SONDERZ THEN 063310 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 063320 MOVE "DBNA080" TO H-FEHLER 063330 MOVE 1 TO HFELD-S 063340 END-IF 063350 END-IF 063360 END-PERFORM 063370 IF HFELD-S = 1 THEN 063380 PERFORM FEHLER 063390 END-IF 063391** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM TITELANFANG 063392 IF AKTLG >= 3 AND ALPHA-ELEM(1) IS ALPHA-ALLG AND 063393 (ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND ALPHA-ELEM(1) 063394 EQUAL ALPHA-ELEM(3)) THEN 063395 MOVE "DBNA081" TO H-FEHLER 063396 PERFORM FEHLER 063397 END-IF 063400** üBERPRüFEN AUF KOMBI BLANK-BINDESTRICHE/SCHRäGSTRICH 063410 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 063420 OR HFELD-S = 1 063430 IF ALPHA-ELEM(I) = "-" THEN 063440 IF ALPHA-ELEM(I + 1) = " " OR (I > 1 AND 063450 ALPHA-ELEM(I - 1) = " ") THEN 063460 MOVE "DBNA082" TO H-FEHLER 063470 MOVE 1 TO HFELD-S 063480 END-IF 063490 END-IF 063500 END-PERFORM 063510 IF HFELD-S = 1 THEN 063520 PERFORM FEHLER 063530 END-IF 063540** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 063550 IF E3-TITEL(1:AKTLG) NOT TITEL-ALPHA AND AKTLG > ZERO THEN 063560 MOVE "DBNA084" TO H-FEHLER 063570 PERFORM FEHLER 063580 END-IF 063590** PRüFEN 1 ZEICHEN BUCHSTABE 063600 IF E3-TITEL(1:1) NOT ALPHA-ALLG THEN 063610 MOVE "DBNA086" TO H-FEHLER 063620 PERFORM FEHLER 063630 END-IF 063640 PERFORM NAT6051 063650 . 063660 FDBNA080-EXIT. 063670 EXIT. 063680 NAT6051 SECTION. 063690 NAT6051E. 063700** PRüFEN OB PUNKT VORHANDEN 063710 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 063720 OR HFELD-S = 1 063730 IF ALPHA-ELEM(I) = "." 063740 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ALPHA-ALLG 063750 MOVE "DBNA088" TO H-FEHLER 063760 MOVE 1 TO HFELD-S 063770 ELSE IF I = 1 THEN 063780 MOVE "DBNA088" TO H-FEHLER 063790 MOVE 1 TO HFELD-S 063800 END-IF 063810 END-IF 063820 END-IF 063830 END-PERFORM 063840 IF HFELD-S = 1 063850 PERFORM FEHLER 063860 GO TO NAT6051-EXIT 063870 END-IF 063880** PRüFEN OB LETZTES ZEICHEN GüLTIG (BUCHST., PUNKT, KLAMMER ZU) 063890 IF E3-TITEL(AKTLG:1) NOT TITELL-ALPH THEN 063900 MOVE "DBNA089" TO H-FEHLER 063910 PERFORM FEHLER 063920 GO TO NAT6051-EXIT 063930 END-IF 063940 . 063950 NAT6051-EXIT. 063960 EXIT. 022721*COPY CDBNA090 REPLACING ==:S2:== BY ==E3==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBNA090 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 05.05.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG NAMENSZUSATZ 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : michael klemke 001620** ERSTELLUNGSDATUM : 12.10.2006 001630** VERSION : 002 / 56 001650**---------------------------------------------------------------- 001700 FDBNA090 SECTION. 001710 FDBNA090E. 001800 IF E3-KENNZAB = " " OR "A" OR "M" THEN 001810 IF E3-KENNZAB = "M" THEN 001820 IF OP-AGDEU 001821 MOVE "DBNA092" TO H-FEHLER 001840 END-IF 001850 END-IF 001910 ELSE 001920 MOVE "DBNA090" TO H-FEHLER 001930 END-IF 003377 . 003378 003379 FDBNA090-EXIT. 003380 EXIT. 022722*COPY CDBGB010 REPLACING ==:S3:== BY ==E4==. 063980**---------------------------------------------------------------- 063990** COPY-MEMBER : CDBGB010 064000** PROGRAMMIERER : WERNER KRAUS 064010** ERSTELLUNGSDATUM : 23.03.1998 064020** VERSION : 001 (PGM-NSOERSTELLUNG) 064030** FUNKTION : FEHLERPRüFUNG GEBURTSNAME 064040**---------------------------------------------------------------- 064041** PROGRAMMIERER : MICHAEL KLEMKE 064042** ERSTELLUNGSDATUM : 26.04.2006 064043** VERSION : 002 / 053 064045**---------------------------------------------------------------- 064046** PROGRAMMIERER : MICHAEL KLEMKE 064047** ERSTELLUNGSDATUM : 12.10.2006 064048** VERSION : 003 / 056 064049**---------------------------------------------------------------- 064050 FDBGB010 SECTION. 064060 FDBGB010E. 064070 IF E4-GBNA = " " THEN 064080 GO TO FDBGB010-EXIT 064090 END-IF 064100** ERMITTELN TATSäCHLICHE LäNGE GBNA 064110 MOVE 30 TO I 064120 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E4-GBNA(I:1) 064130 NOT = SPACE 064140 COMPUTE I = I - 1 END-COMPUTE 064150 END-PERFORM 064160 MOVE I TO AKTLG 064170 MOVE SPACES TO ALPHA-TAB11 064180** üBERTRAGEN IN HILFSFELD 064190 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 064200 MOVE E4-GBNA(I : 1) TO ALPHA-ELEM(I) 064201 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 064202 TO GROSSBUCHSTB 064210 END-PERFORM 064211** PRüFEN MINDESTENS 2 BUCHSTABEN 064212 MOVE 0 TO ZIFF-Z 064213 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 064214 IF ALPHA-ELEM(I) IS ALPHA-ALLG 064215 ADD 1 TO ZIFF-Z 064216 END-IF 064217 END-PERFORM 064218 IF OP-CODE(3:3) = "TRV" OR "TWL" 064219 IF ZIFF-Z < 2 THEN 064220 MOVE "DBGB007" TO H-FEHLER 064221 PERFORM FEHLER 064222 GO TO FDBGB010-EXIT 064223 END-IF 064224 END-IF 064225** PRüFEN AUF GLEICHE SONDERZEICHEN 064230 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 064240 OR HFELD-S = 1 064250 IF ALPHA-ELEM(I) IS SONDERZ THEN 064260 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 064270 MOVE "DBGB010" TO H-FEHLER 064280 MOVE 1 TO HFELD-S 064290 END-IF 064300 END-IF 064310 END-PERFORM 064320 IF HFELD-S = 1 THEN 064330 PERFORM FEHLER 064340 END-IF 064341** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM NAMENSANFANG 064342 IF AKTLG >= 3 AND ALPHA-ELEM(1) IS ALPHA-ALLG AND 064343 (ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND ALPHA-ELEM(1) 064344 EQUAL ALPHA-ELEM(3)) THEN 064345 MOVE "DBGB011" TO H-FEHLER 064346 PERFORM FEHLER 064347 END-IF 064350** PRüFEN AUF KOMBI BLANK-BINDE/SCHRäGSTRICH 064360 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 064370 OR HFELD-S = 1 064380 IF ALPHA-ELEM(I) = "-" THEN 064390 IF ALPHA-ELEM(I + 1) = " " OR (I > 1 AND 064400 ALPHA-ELEM(I - 1) = " ") THEN 064410 MOVE "DBGB012" TO H-FEHLER 064420 MOVE 1 TO HFELD-S 064430 END-IF 064440 END-IF 064450 END-PERFORM 064460 IF HFELD-S = 1 THEN 064470 PERFORM FEHLER 064480 END-IF 064490** PRüFEN AUF GüLTIGE ZEICHEN 064500 IF E4-GBNA(1:AKTLG) NOT FMNA-ALPHA AND AKTLG > ZERO THEN 064510 MOVE "DBGB014" TO H-FEHLER 064520 PERFORM FEHLER 064530 END-IF 064540** PRüFEN 1 ZEICHEN BUCHSTABE 064550 IF E4-GBNA(1:1) NOT ALPHA-ALLG OR E4-GBNA(1:1) EQUAL "ß" 064560 MOVE "DBGB020" TO H-FEHLER 064570 PERFORM FEHLER 064580 END-IF 064590** PRüFEN LETZTES ZEICHEN BUCHSTABE, PUNKT 064600 IF E4-GBNA(AKTLG:1) NOT FMNAL-ALLG AND AKTLG > ZERO THEN 064610 MOVE "DBGB022" TO H-FEHLER 064620 PERFORM FEHLER 064630 END-IF 064640 PERFORM GBT6012 064650 . 064660 FDBGB010-EXIT. 064670 EXIT. 064680 GBT6012 SECTION. 064690 GBT6012E. 064700** PRüFEN OB MEHR ALS ZWEI ZIFFERN 064701 MOVE 0 TO ZIFF-Z 064710 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 064720 IF ALPHA-ELEM(I) IS ZIFF-ALLG 064730 ADD 1 TO ZIFF-Z 064740 END-IF 064750 END-PERFORM 064760 IF ZIFF-Z > 2 THEN 064770 MOVE "DBGB015" TO H-FEHLER 064780 PERFORM FEHLER 064790 END-IF 064800** PRüFEN ZIFFERN HINTEREINANDER 064810 IF ZIFF-Z = 2 THEN 064820 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) 064830 IS ZIFF-ALLG OR I > AKTLG 064840 CONTINUE 064850 END-PERFORM 064860 IF ALPHA-ELEM(I + 1) NOT ZIFF-ALLG THEN 064870 MOVE "DBGB015" TO H-FEHLER 064880 PERFORM FEHLER 064890 END-IF 064900** PRüFEN OB VOR 1 ZIFFER BLANK UND BUCHSTABE 064910 IF I > 1 AND ALPHA-ELEM(I - 1) = " " THEN 064920 IF I > 2 AND ALPHA-ELEM(I - 2) IS ALPHA-ALLG THEN 064930 CONTINUE 064940 ELSE 064950 MOVE "DBGB018" TO H-FEHLER 064960 PERFORM FEHLER 064970 END-IF 064980 ELSE 064990 MOVE "DBGB018" TO H-FEHLER 065000 PERFORM FEHLER 065010 END-IF 065020 END-IF 065030 IF ZIFF-Z = 1 065040 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) 065050 IS ZIFF-ALLG OR I > AKTLG 065060 CONTINUE 065070 END-PERFORM 065080 IF I > 1 AND ALPHA-ELEM(I - 1) = " " THEN 065090 IF I > 2 AND ALPHA-ELEM(I - 2) IS ALPHA-ALLG THEN 065100 CONTINUE 065110 ELSE 065120 MOVE "DBGB018" TO H-FEHLER 065130 PERFORM FEHLER 065140 END-IF 065150 ELSE 065160 MOVE "DBGB018" TO H-FEHLER 065170 PERFORM FEHLER 065180 END-IF 065190 END-IF 065200 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 065210 OR I > AKTLG 065220 CONTINUE 065230 END-PERFORM 065231 IF ALPHA-ELEM(I) = "." THEN 065232** ---------------------------------------------------------- 065233** T6014 065234** ---------------------------------------------------------- 065235** PRüFEN OB PUNKT LETZTES ZEICHEN 065236** ---------------------------------------------------------- 065237 IF I = AKTLG THEN 065238** ------------------------------------------------------- 065239** PRüFEN OB VOR PUNKT EINE ZIFFER 065240** ------------------------------------------------------- 065241 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ZIFF-ALLG THEN 065242 MOVE "DBGB016" TO H-FEHLER 065243 PERFORM FEHLER 065244 END-IF 065245 ELSE 065246 IF I > 2 065247 COMPUTE IX = I - 2 065248 IF ALPHA-TAB11(IX:2) = "ST" 065249** ------------------------------------------------- 065250** PRÜFEN OB EIN WEITERER PUNKT 065251** ------------------------------------------------- 065252 COMPUTE I = I + 1 065253 PERFORM VARYING I FROM I BY 1 065254 UNTIL ALPHA-ELEM(I) = "." 065255 OR I > AKTLG 065256 CONTINUE 065257 END-PERFORM 065258 IF I > AKTLG THEN 065259 CONTINUE 065260 ELSE 065261 IF I = AKTLG THEN 065262** ------------------------------------------- 065263** PRüFEN OB VOR PUNKT EINE ZIFFER 065264** ------------------------------------------- 065265 IF I > 1 AND ALPHA-ELEM(I - 1) 065266 NOT ZIFF-ALLG THEN 065267 MOVE "DBGB016" TO H-FEHLER 065268 PERFORM FEHLER 065269 END-IF 065270 ELSE 065271 COMPUTE IX = I - 2 065272 IF ALPHA-TAB11(IX:2) = "ST" 065273 CONTINUE 065274 ELSE 065275 MOVE "DBGB016" TO H-FEHLER 065276 PERFORM FEHLER 065277 END-IF 065278 END-IF 065279 END-IF 065280 ELSE 065281 MOVE "DBGB016" TO H-FEHLER 065282 PERFORM FEHLER 065283 END-IF 065284 ELSE 065285 MOVE "DBGB016" TO H-FEHLER 065286 PERFORM FEHLER 065287 END-IF 065288 END-IF 065289 END-IF 065290 . 065380 GBT6012-EXIT. 065390 EXIT. 022723*COPY CDBGB040 REPLACING ==:S3:== BY ==E4==. 065410**---------------------------------------------------------------- 065420** COPY-MEMBER : CDBGB040 065430** PROGRAMMIERER : WERNER KRAUS 065440** ERSTELLUNGSDATUM : 05.05.1998 065450** VERSION : 001 (PGM-NSOERSTELLUNG) 065460** FUNKTION : FEHLERPRüFUNG VORSATZWORT 065470**---------------------------------------------------------------- 065480 FDBGB040 SECTION. 065490 FDBGB040E. 065500 IF E4-GBVOSA EQUAL SPACE THEN 065510 GO TO FDBGB040-EXIT 065520 END-IF 065530** ERMITTELN TATSäCHLICHE LäNGE GBVOSA 065540 MOVE 20 TO I 065550 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E4-GBVOSA(I: 1) 065560 NOT = SPACE 065570 COMPUTE I = I - 1 END-COMPUTE 065580 END-PERFORM 065590 MOVE I TO AKTLG 065600 MOVE SPACES TO ALPHA-TAB11 065610** üBERTRAGEN IN HILFSFELD 065620 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 065630 MOVE E4-GBVOSA(I:1) TO ALPHA-ELEM(I) 065640 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 065650 TO GROSSBUCHSTB 065660 END-PERFORM 065670** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 065680 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 065690 OR HFELD-S = 1 065700 IF ALPHA-ELEM(I) IS SONDERZ THEN 065710 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 065720 MOVE "DBGB040" TO H-FEHLER 065730 MOVE 1 TO HFELD-S 065740 END-IF 065750 END-IF 065760 END-PERFORM 065770 IF HFELD-S = 1 THEN 065780 PERFORM FEHLER 065790 END-IF 065940** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 065950 IF E4-GBVOSA(1:AKTLG) NOT VOSA-ALPHA AND AKTLG > ZERO THEN 065960 MOVE "DBGB044" TO H-FEHLER 065970 PERFORM FEHLER 065980 END-IF 065990** PRüFEN 1 ZEICHEN BUCHSTABE 066000 IF E4-GBVOSA(1:1) NOT ALPHA-ALLG THEN 066010 MOVE "DBGB046" TO H-FEHLER 066020 PERFORM FEHLER 066030 END-IF 066040** PRüFEN OB PUNKT VORHANDEN 066050 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 066060 OR I > AKTLG 066070 CONTINUE 066080 END-PERFORM 066090 IF ALPHA-ELEM(I) = "." 066100 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ALPHA-ALLG 066110 MOVE "DBGB048" TO H-FEHLER 066120 MOVE 1 TO HFELD-S 066130 ELSE IF I = 1 THEN 066140 MOVE "DBGB048" TO H-FEHLER 066150 MOVE 1 TO HFELD-S 066160 END-IF 066170 END-IF 066180 END-IF 066190 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 066200 OR ALPHA-ELEM(I) NOT ALPHA-ALLG 066210 CONTINUE 066220 END-PERFORM 066230 IF I > 1 066240 COMPUTE I = I - 1 END-COMPUTE 066250 MOVE ALPHA-TAB1(3:I) TO VOSA-TAB 066260 IF NOT VOSA-OK THEN 066270 MOVE "DBGB050" TO H-FEHLER 066280 PERFORM FEHLER 066290 END-IF 066300 END-IF 066310 . 066320 FDBGB040-EXIT. 066330 EXIT. 022724*COPY CDBGB060 REPLACING ==:S3:== BY ==E4==. 066350**---------------------------------------------------------------- 066360** COPY-MEMBER : CDBGB060 066370** PROGRAMMIERER : WERNER KRAUS 066380** ERSTELLUNGSDATUM : 05.05.1998 066390** VERSION : 001 (PGM-NSOERSTELLUNG) 066400** FUNKTION : FEHLERPRüFUNG NAMENSZUSATZ 066410**---------------------------------------------------------------- 066420 FDBGB060 SECTION. 066430 FDBGB060E. 066440 IF E4-GBNAZU EQUAL SPACE THEN 066450 GO TO FDBGB060-EXIT 066460 END-IF 066470** ERMITTELN TATSäCHLICHE LäNGE GBNAZU 066480 MOVE 20 TO I 066490 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E4-GBNAZU(I:1) 066500 NOT = SPACE 066510 COMPUTE I = I - 1 END-COMPUTE 066520 END-PERFORM 066530 MOVE I TO AKTLG 066540 MOVE SPACES TO ALPHA-TAB11 066550** üBERTRAGEN IN HILFSFELD 066560 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 066570 MOVE E4-GBNAZU(I:1) TO ALPHA-ELEM(I) 066580 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 066590 TO GROSSBUCHSTB 066600 END-PERFORM 066610** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 066620 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 066630 OR HFELD-S = 1 066640 IF ALPHA-ELEM(I) IS SONDERZ THEN 066650 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 066660 MOVE "DBGB060" TO H-FEHLER 066670 MOVE 1 TO HFELD-S 066680 END-IF 066690 END-IF 066700 END-PERFORM 066710 IF HFELD-S = 1 066720 PERFORM FEHLER 066730 END-IF 066880** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 066890 IF E4-GBNAZU(1:AKTLG) NOT VOSA-ALPHA AND AKTLG > ZERO THEN 066900 MOVE "DBGB064" TO H-FEHLER 066910 PERFORM FEHLER 066920 END-IF 066930** PRüFEN 1 ZEICHEN BUCHSTABE 066940 IF E4-GBNAZU(1:1) NOT ALPHA-ALLG THEN 066950 MOVE "DBGB066" TO H-FEHLER 066960 PERFORM FEHLER 066970 END-IF 066980** PRüFEN OB PUNKT VORHANDEN 066990 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 067000 OR I > AKTLG 067010 CONTINUE 067020 END-PERFORM 067030 IF ALPHA-ELEM(I) = "." 067040 IF I > 1 AND ALPHA-ELEM(I - 1) NOT ALPHA-ALLG 067050 MOVE "DBGB068" TO H-FEHLER 067060 MOVE 1 TO HFELD-S 067070 ELSE IF I = 1 THEN 067080 MOVE "DBGB068" TO H-FEHLER 067090 MOVE 1 TO HFELD-S 067100 END-IF 067110 END-IF 067120 END-IF 067130 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 067140 OR ALPHA-ELEM(I) NOT ALPHA-ALLG 067150 CONTINUE 067160 END-PERFORM 067170 IF I > 1 067180 COMPUTE I = I - 1 END-COMPUTE 067190 MOVE ALPHA-TAB1(3:I) TO NAZU-TAB 067200 IF NOT NAZU-OK THEN 067210 MOVE "DBGB070" TO H-FEHLER 067220 PERFORM FEHLER 067230 END-IF 067240 END-IF 067250 . 067260 FDBGB060-EXIT. 067270 EXIT. 022725*COPY CDBGB100 REPLACING ==:S3:== BY ==E4== 022726* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBGB100 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 05.05.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG GEBURTSDATUM 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 13.11.2001 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 13.04.2005 001680** VERSION : 003 / 045 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ERSTELLUNGSDATUM : 24.08.2005 001693** VERSION : 004 / 048 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** ERSTELLUNGSDATUM : 12.10.2006 001697** VERSION : 005 / 056 001698**---------------------------------------------------------------- 001700 FDBGB100 SECTION. 001710 FDBGB100E. 001800 IF E4-GBDT-NUM NOT NUMERIC THEN 001810 MOVE "DBGB100" TO H-FEHLER 001900 GO TO FDBGB100-EXIT 001910 END-IF 001920 IF E1-SASC NOT = "000" THEN 001930 IF E4-GBDT-MM = 0 THEN 001940 IF E4-GBDT-TT = 0 THEN 001950 MOVE E4-GBDT-JHJJ TO HFELD-GEB-JH-JJ 001960 MOVE 07 TO HFELD-GEB-MM 001970 MOVE 01 TO HFELD-GEB-TT 001980 ELSE 001990 MOVE "DBGB102" TO H-FEHLER 002000 GO TO FDBGB100-EXIT 002100 END-IF 002200 ELSE 002210 IF E4-GBDT-TT = 0 THEN 002220 MOVE E4-GBDT-JHJJ TO HFELD-GEB-JH-JJ 002230 MOVE E4-GBDT-MM TO HFELD-GEB-MM 002240 MOVE 15 TO HFELD-GEB-TT 002250 ELSE 002260 MOVE E4-GBDT-NUM TO HFELD-GEB 002270 END-IF 002300 END-IF 002400 ELSE 002500 MOVE E4-GBDT-NUM TO HFELD-GEB 002600 END-IF 002700 DIVIDE 4 INTO HFELD-GEB-JJ GIVING ERG 002800 REMAINDER SCHALTJAHR 002810** ------------------------------------------------------------- 002820** Tabelle T535041 002830** ------------------------------------------------------------- 002900 IF HFELD-GEB-MM > ZERO AND < 13 003000 AND HFELD-GEB-TT > ZERO 003100 AND <= TGT(SCHALTJAHR + 1, HFELD-GEB-MM) THEN 003110** ---------------------------------------------------------- 003120** HFELD-GEB = GEBURTSDATUM (JHJJMMTT) 003121** GEBURTSDATUM LOGISCH RICHTIG 003132** ---------------------------------------------------------- 003133 MOVE P-DATE TO HDATUM 003134 COMPUTE HDATJHJJ = HDATJHJJ - 150 003135 IF HFELD-GEB < HDATUM 003136 MOVE "DBGB106" TO H-FEHLER 003137 GO TO FDBGB100-EXIT 003138 ELSE 003142 IF HFELD-GEB > P-DATE THEN 003143 MOVE "DBGB107" TO H-FEHLER 003144 GO TO FDBGB100-EXIT 003145 END-IF 003146 END-IF 003150** ---------------------------------------------------------- 003202** Tabelle T535042 003203** ---------------------------------------------------------- 003204 MOVE E1-VSNR(1:2) TO HVSNRBNR-TAB1 003205 IF BNR1-OK THEN 003206 MOVE E1-VSNR(3:2) TO HFELD-GEB-TT 003207 MOVE E1-VSNR(5:2) TO HFELD-GEB-MM 003208 MOVE E1-VSNR(7:2) TO HFELD-GEB-JJ 003209 DIVIDE 4 INTO HFELD-GEB-JJ GIVING ERG 003210 REMAINDER SCHALTJAHR 003211 IF HFELD-GEB-MM > ZERO AND < 13 003212 AND HFELD-GEB-TT > ZERO 003213 AND <= TGT(SCHALTJAHR + 1, HFELD-GEB-MM) THEN 003214 IF E4-GBDT-JHJJ(3:2) = E1-VSNR(7:2) AND 003215 E4-GBDT-MM = E1-VSNR(5:2) AND 003216 E4-GBDT-TT = E1-VSNR(3:2) THEN 003217 GO TO FDBGB100-EXIT 003218 ELSE 003219 MOVE "DBGB110" TO H-FEHLER 003220 GO TO FDBGB100-EXIT 003221 END-IF 003222 ELSE 003223 GO TO FDBGB100-EXIT 003224 END-IF 003225 ELSE 003226 GO TO FDBGB100-EXIT 003227 END-IF 003230 ELSE 003300 MOVE "DBGB104" TO H-FEHLER 003400 END-IF 003402 . 003403 FDBGB100-EXIT. 003404 EXIT. 022727*COPY CDBGB120 REPLACING ==:S3:== BY ==E4== 022728* ==:S0:== BY ==E1==. 000300**---------------------------------------------------------------- 000400** COPY-MEMBER : CDBGB120 000500** PROGRAMMIERER : WERNER KRAUS 000501** ERSTELLUNGSDATUM : 05.05.1998 000502** VERSION : 001 (PGM-NSOERSTELLUNG) 000503** FUNKTION : FEHLERPRüFUNG GESCHLECHT 000504**---------------------------------------------------------------- 000505 FDBGB120 SECTION. 000506 FDBGB120E. 000507 IF E4-GE = "M" OR "W" THEN 000508 MOVE E1-VSNR TO HVSNR 000509 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB1 000510 IF BNR1-OK THEN 000511 IF E4-GE = "M" THEN 000512 IF HVSNRSS >= 0 AND <= 49 THEN 000513 GO TO FDBGB120-EXIT 000514 ELSE 000515 MOVE "DBGB122" TO H-FEHLER 000516 GO TO FDBGB120-EXIT 000517 END-IF 000518 ELSE 000519 IF HVSNRSS >= 0 AND <= 49 THEN 000520 MOVE "DBGB124" TO H-FEHLER 000521 GO TO FDBGB120-EXIT 000522 ELSE 000523 GO TO FDBGB120-EXIT 000524 END-IF 000525 END-IF 000526 END-IF 000527 ELSE 000528 MOVE "DBGB120" TO H-FEHLER 000529 END-IF 000530 . 000531 FDBGB120-EXIT. 000532 EXIT. 022730*COPY CDBGB140 REPLACING ==:S3:== BY ==E4== 022731* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBGB140 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 05.05.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG GEBURTSORT 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001602** AENDERUNGSDATUM : 18.05.2004 VERSION 40 001610** VERSION : 002 001630**---------------------------------------------------------------- 001700 FDBGB140 SECTION. 001800 FDBGB140E. 001900 IF E4-GBOT = " " THEN 001901 IF E1-GD NOT = "99" THEN 001910 MOVE "DBGB128" TO H-FEHLER 001911 END-IF 001920 GO TO FDBGB140-EXIT 001921 END-IF 001922** ERMITTELN TATSäCHLICHE LäNGE GBOT 001923 MOVE 0 TO HFELD-ALPHA-Z 001924 MOVE 34 TO I 001925 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E4-GBOT(I:1) 001926 NOT = SPACE 001927 COMPUTE I = I - 1 END-COMPUTE 001928 END-PERFORM 001929 MOVE I TO AKTLG 001930 MOVE SPACES TO ALPHA-TAB11 001931** üBERTRAGEN IN HILFSFELD 001932 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 001933 MOVE E4-GBOT(I:1) TO ALPHA-ELEM(I) 001934 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 001935 TO GROSSBUCHSTB 001936 IF E4-GBOT(I:1) IS ALPHA-ALLG 001937 ADD 1 TO HFELD-ALPHA-Z 001938 END-IF 001940 END-PERFORM 001941** UMWANDELN IN GOSSBUCHSTABEN 001942 MOVE E4-GBOT(1:AKTLG) TO HFELD-PRUEF 001943 INSPECT HFELD-PRUEF CONVERTING KLEINBUCHSTB 001944 TO GROSSBUCHSTB 001945** üBERPRüFEN OB FIKTIVE ANGABEN 001951 MOVE HFELD-PRUEF TO GBOT-TAB 001952 IF GBOT-NOT-OK THEN 001953 MOVE "DBGB140" TO H-FEHLER 001954 GO TO FDBGB140-EXIT 001955 ELSE 001956 IF HFELD-ALPHA-Z >= 2 THEN 001957** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 001958 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 001959 IF ALPHA-ELEM(I) IS SONDERZ THEN 001960 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 001961 MOVE "DBGB130" TO H-FEHLER 001962 GO TO FDBGB140-EXIT 001963 END-IF 001964 END-IF 001965 END-PERFORM 001966** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM NAMENSANFANG 001967 IF AKTLG >= 3 AND ALPHA-ELEM(1) IS ALPHA-ALLG AND 001968 (ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND ALPHA-ELEM(1) 001969 EQUAL ALPHA-ELEM(3)) THEN 001970 MOVE "DBGB131" TO H-FEHLER 001971 GO TO FDBGB140-EXIT 001990 END-IF 003342** PRüFEN AUF GüLTIGE ZEICHEN(BUCHSTABEN, BINDESTRICH, BLANK) 003343 IF E4-GBOT(1:AKTLG) NOT GBOT-ALPHA 003344 MOVE "DBGB134" TO H-FEHLER 003345 GO TO FDBGB140-EXIT 003346 END-IF 003347** PRüFEN 1 ZEICHEN BUCHSTABE 003348 IF E4-GBOT(1:1) NOT ALPHA-ALLG THEN 003349 MOVE "DBGB136" TO H-FEHLER 003350 GO TO FDBGB140-EXIT 003351 END-IF 003352** PRüFEN OB LETZTES ZEICHEN BUCHSTABE, PUNKT, KLAMMER 003353 IF E4-GBOT(AKTLG:1) NOT TITELL-ALPH THEN 003354 MOVE "DBGB142" TO H-FEHLER 003355 GO TO FDBGB140-EXIT 003356 END-IF 003357 ELSE 003358 MOVE "DBGB138" TO H-FEHLER 003359 GO TO FDBGB140-EXIT 003360 END-IF 003400 END-IF 003401 . 003410 FDBGB140-EXIT. 003500 EXIT. 022740*COPY CDBAN010 REPLACING ==:S4:== BY ==E5==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAN010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 05.05.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG WOHNORT 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 12.10.2006 001630** VERSION : 002 / 056 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 23.04.2007 001680** VERSION : 003 / 062 001690**---------------------------------------------------------------- 001700 FDBAN010 SECTION. 001800 FDBAN010E. 003364 IF E5-LDKZ = " " OR "D" OR "OFW" 003365** ---------------------------------------------------------- 003366** T536012 ANFANG 003367** ---------------------------------------------------------- 003368 IF E5-LDKZ = "OFW" 003369 IF OP-KVTWL OR OP-WLTKV OR OP-KVTRV OR 003370 OP-RVTKV OR OP-BATRV OR OP-KTTRV OR 003371 OP-RVTBA OR OP-RVTKT OR OP-DSTBF OR 003372 OP-BFTDS 003373 CONTINUE 003374 ELSE 003375 MOVE "DBAN014" TO H-FEHLER 003379 END-IF 003380 END-IF 003381** ---------------------------------------------------------- 003382** T536012 ENDE 003383** ---------------------------------------------------------- 003384 ELSE 003385 MOVE E5-LDKZ TO LDKZ-TAB 003386 IF LDKZ-OK 003387 IF E5-LDKZ = "YU " OR "SCG" 003388 MOVE "DBAN013" TO H-FEHLER 003389 END-IF 003390 ELSE 003391 MOVE "DBAN012" TO H-FEHLER 003392 END-IF 003400 END-IF 003445 . 003450 FDBAN010-EXIT. 003500 EXIT. 022741*COPY CDBAN020 REPLACING ==:S4:== BY ==E5==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAN020 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 05.05.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG WOHNORT 001600**---------------------------------------------------------------- 001610** AENDERUNGSDATUM : 25.06.2001 001620** VERSION : 002 001630** AENDERUNG : FELDLÄNGE VON PLZ ALS VARIABLE 001640**---------------------------------------------------------------- 001650** AENDERUNGSDATUM : 09.04.2002 001660** VERSION : 003 001670** AENDERUNG : KORREKTUR IN DER NUMERIC-ABFRAGE 001671** :(ZUSÄTZLICHER IF-ZWEIG) 001680**---------------------------------------------------------------- 001690** AENDERUNGSDATUM : 24.07.2003 001691** VERSION : 004 HEINZ STANG 001692** AENDERUNG : KORREKTUR IN DER NUMERIC-ABFRAGE 001693** :< 100000 ENTFERNT 001694**---------------------------------------------------------------- 001695** AENDERUNGSDATUM : 31.10.2005 001696** VERSION : 005 / 050 001697** PROGRAMMIERER : MICHAEL KLEMKE 001699**---------------------------------------------------------------- 001700** AENDERUNGSDATUM : 24.04.2006 001701** VERSION : 006 / 053 001702** PROGRAMMIERER : MICHAEL KLEMKE 001703**---------------------------------------------------------------- 001704** AENDERUNGSDATUM : 16.06.2006 001705** VERSION : 007 / 054 001706** PROGRAMMIERER : MICHAEL KLEMKE 001707**---------------------------------------------------------------- 001708** AENDERUNGSDATUM : 30.10.2006 001709** VERSION : 008 / 056 001710** PROGRAMMIERER : MICHAEL KLEMKE 001711**---------------------------------------------------------------- 001720 FDBAN020 SECTION. 001800 FDBAN020E. 001810** ------------------------------------------------------------- 001820** T53602 001830** ------------------------------------------------------------- 001831 IF E5-PLZ = SPACES 001832 IF E5-LDKZ = " " OR "D " 001833 MOVE "DBAN018" TO H-FEHLER 001850 END-IF 001851 GO TO FDBAN020-EXIT 001852 END-IF 001860 001870 001880** ------------------------------------------------------------- 001890** T536021 001891** ------------------------------------------------------------- 001900 IF E5-LDKZ = " " OR "D " OR "OFW" 001910* 002000 IF E5-PLZ-NUM-1 IS NUMERIC THEN 002010 IF E5-PLZ-NUM-1 >= 01000 AND 002020 E5-PLZ(6:5) = SPACE THEN 002100 GO TO FDBAN020-EXIT 002200 ELSE 002300 MOVE "DBAN020" TO H-FEHLER 002400 GO TO FDBAN020-EXIT 002401 END-IF 002410 ELSE 002420 MOVE "DBAN020" TO H-FEHLER 002430 GO TO FDBAN020-EXIT 002500 END-IF 002600 ELSE 002700 IF E5-PLZ NOT APLZ 002800 MOVE "DBAN022" TO H-FEHLER 002900 GO TO FDBAN020-EXIT 003000 ELSE 003110** ------------------------------------------------------- 003120** FELDLAENGE ALS VARIABLE (UNTERSCHIED DUEVO / KVDR) 003121** ------------------------------------------------------- 003140 MOVE DBAN-PLZ-LEN TO I 003200** MOVE 10 TO I 003300 MOVE SPACES TO ALPHA-TAB11 003400 PERFORM UNTIL I < 1 OR E5-PLZ(I:1) NOT = SPACE 003501** ---------------------------------------------------- 003510** ERMITTELN TATSäCHLICHE LäNGE PLZ 003511** ---------------------------------------------------- 003600 COMPUTE I = I - 1 END-COMPUTE 003700 END-PERFORM 003800 MOVE I TO AKTLG 003900 IF AKTLG > 0 004000** üBERTRAGEN IN HILFSFELD 004100 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 004200 MOVE E5-PLZ(I : 1) TO ALPHA-ELEM(I) 004300 END-PERFORM 004310** ---------------------------------------------------- 004400** PRüFEN AUF GLEICHE SONDERZEICHEN 004410** ---------------------------------------------------- 004500 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 004600 OR H-FEHLER = "DBAN024" 004700 IF ALPHA-ELEM(I) = "-" THEN 004800 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 004900 MOVE "DBAN024" TO H-FEHLER 005000 END-IF 005010 ELSE 005020 IF ALPHA-ELEM(I) = " " THEN 005030 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 005040 MOVE "DBAN024" TO H-FEHLER 005050 END-IF 005060 END-IF 005100 END-IF 005200 END-PERFORM 005201** ---------------------------------------------------- 005202** DBAN026 VORERST NICHT PRÜFEN 005203** ---------------------------------------------------- 005204** GO TO FDBAN020-EXIT 005210 IF H-FEHLER NOT = "DBAN024" 005220** ------------------------------------------------- 005230** T536022 005240** ------------------------------------------------- 005241 IF OP-ZFTRV 005242 CONTINUE 005243 ELSE 005250 EVALUATE E5-LDKZ 005260 WHEN "A " 005261 IF AKTLG = 4 005262 IF E5-PLZ(1:4) NOT NUMERIC 005263 MOVE "DBAN026" TO H-FEHLER 005265 END-IF 005266 ELSE 005267 MOVE "DBAN026" TO H-FEHLER 005268 END-IF 005269 005271 WHEN "B " 005272 IF AKTLG = 4 005273 IF E5-PLZ(1:4) NOT NUMERIC 005274 MOVE "DBAN026" TO H-FEHLER 005275 END-IF 005276 ELSE 005277 MOVE "DBAN026" TO H-FEHLER 005278 END-IF 005279 005280 WHEN "CH " 005281 IF AKTLG = 4 005282 IF E5-PLZ(1:4) NOT NUMERIC 005283 MOVE "DBAN026" TO H-FEHLER 005284 END-IF 005285 ELSE 005286 MOVE "DBAN026" TO H-FEHLER 005287 END-IF 005288 005289 WHEN "DK " 005290 IF AKTLG = 4 005291 IF E5-PLZ(1:4) NOT NUMERIC 005292 MOVE "DBAN026" TO H-FEHLER 005293 END-IF 005294 ELSE 005295 MOVE "DBAN026" TO H-FEHLER 005296 END-IF 005297 005298 WHEN "F " 005299 IF AKTLG = 5 005300 IF E5-PLZ(1:5) NOT NUMERIC 005301 MOVE "DBAN026" TO H-FEHLER 005302 END-IF 005303 ELSE 005304 MOVE "DBAN026" TO H-FEHLER 005305 END-IF 005306 005307 WHEN "NL " 005308 IF AKTLG = 7 005309 IF E5-PLZ(1:4) NOT NUMERIC OR 005310 E5-PLZ(5:1) NOT = " " OR 005311 E5-PLZ(6:2) NOT ALPHABETIC 005312 MOVE "DBAN026" TO H-FEHLER 005313 END-IF 005314 ELSE 005315 MOVE "DBAN026" TO H-FEHLER 005316 END-IF 005317 005318 WHEN "PL " 005319 IF AKTLG = 6 005320 IF E5-PLZ(1:2) NOT NUMERIC OR 005321 E5-PLZ(3:1) NOT = "-" OR 005322 E5-PLZ(4:3) NOT NUMERIC 005323 MOVE "DBAN026" TO H-FEHLER 005324 END-IF 005325 ELSE 005326 MOVE "DBAN026" TO H-FEHLER 005327 END-IF 005328 005329 WHEN "CZ " 005330 IF AKTLG = 6 005331 IF E5-PLZ(1:3) NOT NUMERIC OR 005332 E5-PLZ(4:1) NOT = " " OR 005333 E5-PLZ(5:2) NOT NUMERIC 005334 MOVE "DBAN026" TO H-FEHLER 005335 END-IF 005336 ELSE 005337 MOVE "DBAN026" TO H-FEHLER 005338 END-IF 005339 005340 WHEN "L " 005341 IF AKTLG = 4 005342 IF E5-PLZ(1:4) NOT NUMERIC 005343 MOVE "DBAN026" TO H-FEHLER 005344 END-IF 005345 ELSE 005346 MOVE "DBAN026" TO H-FEHLER 005347 END-IF 005348 005349 WHEN OTHER 005350 CONTINUE 005351 END-EVALUATE 005352 END-IF 005353 END-IF 005360 END-IF 005400 END-IF 005500 END-IF 005600 . 005610 005620 005700 FDBAN020-EXIT. 005800 EXIT. 005900 006000 022742*COPY CDBAN120 REPLACING ==:S4:== BY ==E5==. 069810**OPY CDBAN120 REPLACING ==:S4:== BY ==E5==. 069820**---------------------------------------------------------------- 069830** COPY-MEMBER : CDBAN120 069840** PROGRAMMIERER : WERNER KRAUS 069850** ERSTELLUNGSDATUM : 05.05.1998 069860** VERSION : 001 (PGM-NSOERSTELLUNG) 069870** FUNKTION : FEHLERPRüFUNG WOHNORT 069880**---------------------------------------------------------------- 069881** AENDERUNGSDATUM : 25.06.2001 069882** VERSION : 002 069883** AENDERUNG : FELDLÄNGE VON ORT ALS VARIABLE 069884**---------------------------------------------------------------- 069885** PROGRAMMIERER : MICHAEL KLEMKE 069886** AENDERUNGSDATUM : 12.10.2006 069887** VERSION : 003 / 056 069888**---------------------------------------------------------------- 069890 FDBAN120 SECTION. 069900 FDBAN120E. 069910 IF E5-ORT = " " THEN 069911 IF E5-LDKZ = "OFW" 069912 CONTINUE 069913 ELSE 069914 MOVE "DBAN118" TO H-FEHLER 069915 PERFORM FEHLER 069920 END-IF 069930 GO TO FDBAN120-EXIT 069950 END-IF 069961** ------------------------------------------------------------- 069962** FELDLAENGE ALS VARIABLE (UNTERSCHIED DUEVO / KVDR) 069963** ------------------------------------------------------------- 069964 MOVE DBAN-WHOT-LEN TO I 069970** MOVE 34 TO I 069980 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E5-ORT(I:1) 069990 NOT = SPACE 069991** ---------------------------------------------------------- 069992** ERMITTELN TATSäCHLICHE LäNGE GBOT 069993** ---------------------------------------------------------- 070000 COMPUTE I = I - 1 END-COMPUTE 070010 END-PERFORM 070020 MOVE I TO AKTLG 070030 MOVE SPACES TO ALPHA-TAB11 070040** üBERTRAGEN IN HILFSFELD 070050 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 070060 MOVE E5-ORT(I:1) TO ALPHA-ELEM(I) 070061 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 070062 TO GROSSBUCHSTB 070070 END-PERFORM 070080** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 070090 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG OR 070100 HFELD-BREAK = 1 070110 IF ALPHA-ELEM(I) IS SONDERZ THEN 070120 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 070130 MOVE "DBAN120" TO H-FEHLER 070140 PERFORM FEHLER 070150 MOVE 1 TO HFELD-BREAK 070160 END-IF 070170 END-IF 070180 END-PERFORM 070190 MOVE 0 TO HFELD-BREAK 070191** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM ANFANG 070192 IF AKTLG >= 3 AND ALPHA-ELEM(1) IS ALPHA-ALLG AND 070193 (ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND ALPHA-ELEM(1) 070194 EQUAL ALPHA-ELEM(3)) THEN 070195 MOVE "DBAN121" TO H-FEHLER 070196 PERFORM FEHLER 070197 END-IF 070200** PRüFEN 1. ZEICHEN BUCHSTABE 070210 IF E5-ORT(1:1) NOT ALPHA-ALLG THEN 070220 MOVE "DBAN124" TO H-FEHLER 070230 PERFORM FEHLER 070240 END-IF 070250** PRüFEN MINDESTENS 2 BUCHSTABEN 070260 MOVE 0 TO ZIFF-Z 070270 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 070280 IF ALPHA-ELEM(I) IS ALPHA-ALLG 070290 ADD 1 TO ZIFF-Z 070300 END-IF 070310 END-PERFORM 070320 IF ZIFF-Z < 2 THEN 070330 MOVE "DBAN130" TO H-FEHLER 070340 PERFORM FEHLER 070350 END-IF 070360** PRüFEN OB INLANDSANSCHRIFT 070370 IF E5-LDKZ = " " OR "D" THEN 070380** PRüFEN OB GüLTIGE ZEICHEN 070390 IF E5-ORT(1:AKTLG) NOT ORT-ALPHA THEN 070400 MOVE "DBAN126" TO H-FEHLER 070410 PERFORM FEHLER 070420 END-IF 070430** PRüFEN OB PUNKT VORHANDEN 070440 PERFORM VARYING I FROM 1 BY 1 UNTIL ALPHA-ELEM(I) = "." 070450 OR I > AKTLG 070460 CONTINUE 070470 END-PERFORM 070480 IF ALPHA-ELEM(I) = "." 070490 IF I > 1 AND ALPHA-ELEM(I - 1) 070500 NOT ALPHA-ALLG THEN 070510 MOVE "DBAN128" TO H-FEHLER 070520 PERFORM FEHLER 070530 ELSE IF I = 1 070540 MOVE "DBAN128" TO H-FEHLER 070550 PERFORM FEHLER 070560 END-IF 070570 END-IF 070571 END-IF 070580 IF E5-ORT(AKTLG:1) NOT TITELL-ALPH THEN 070590 MOVE "DBAN132" TO H-FEHLER 070600 PERFORM FEHLER 070610 END-IF 070620 ELSE 070630 IF E5-ORT(1:AKTLG) NOT GBOT-ALPHA THEN 070640 MOVE "DBAN140" TO H-FEHLER 070650 PERFORM FEHLER 070660 END-IF 070670 IF E5-ORT(AKTLG:1) NOT HNRL-ALLG THEN 070680 MOVE "DBAN144" TO H-FEHLER 070690 PERFORM FEHLER 070700 END-IF 070710 END-IF 070720 . 070730 FDBAN120-EXIT. 070740 EXIT. 022750*COPY CDBAN150 REPLACING ==:S4:== BY ==E5==. 070760**---------------------------------------------------------------- 070770** COPY-MEMBER : CDBAN150 070780** PROGRAMMIERER : WERNER KRAUS 070790** ERSTELLUNGSDATUM : 05.05.1998 070800** VERSION : 001 (PGM-NSOERSTELLUNG) 070810** FUNKTION : FEHLERPRüFUNG STRAßE 070820**---------------------------------------------------------------- 070821** PROGRAMMIERER : GERTRAUD SCHUHMACHER 070822** ÄNDERUNG : 001 VOM 15.11.2000 070823**---------------------------------------------------------------- 070824** PROGRAMMIERER : GERTRAUD SCHUHMACHER 070825** ÄNDERUNG : 002 VOM 11.12.2000 1. NACHGANG VERSION 21 070826** FEHLER DBAN162 AUCH DANN AUSGEBEN, WENN 070827** KOMPLETTE STRAßE (AUSLAND) NUMERISCH IST 070828**---------------------------------------------------------------- 070829** PROGRAMMIERER : MICHAEL KLEMKE 070830** ÄNDERUNG : 003 VOM 21.06.2001 VERSION 25 070832** LAENGE DER STRASSE ALS VARIABLE DEFINIERT 070833**---------------------------------------------------------------- 070834** PROGRAMMIERER : MICHAEL KLEMKE 070835** ÄNDERUNG : 004 VOM 25.03.2002 VERSION 27 070837**---------------------------------------------------------------- 070838** PROGRAMMIERER : MICHAEL KLEMKE 070839** ÄNDERUNG : 005 VOM 09.12.2004 VERSION 42 070840**---------------------------------------------------------------- 070841** PROGRAMMIERER : MICHAEL KLEMKE 070842** ÄNDERUNG : 006 VOM 31.10.2005 VERSION 50 070843**---------------------------------------------------------------- 070844** PROGRAMMIERER : MICHAEL KLEMKE 070845** ÄNDERUNG : 007 VOM 28.04.2006 VERSION 53 070846**---------------------------------------------------------------- 070847** PROGRAMMIERER : MICHAEL KLEMKE 070848** ÄNDERUNG : 008 VOM 12.10.2006 VERSION 56 070849**---------------------------------------------------------------- 070850 FDBAN150 SECTION. 070851 FDBAN150E. 070852 IF E5-STR = " " THEN 070860 IF E5-LDKZ = " " OR = "D" OR "OFW" 070870 GO TO FDBAN150-EXIT 070880 ELSE 070890 MOVE "DBAN154" TO H-FEHLER 070900 PERFORM FEHLER 070910 GO TO FDBAN150-EXIT 070920 END-IF 070930 END-IF 070940** ------------------------------------------------------------- 070941** STRASSENLAENGE ALS VARIABLE (UNTERSCHIED DUEVO / KVDR) 070942** ------------------------------------------------------------- 070950 MOVE DBAN-STR-LEN TO I 070951** ------------------------------------------------------------- 070952** ERMITTELN TATSAECHLICHE LAENGE STRASSE 070953** ------------------------------------------------------------- 070960 PERFORM UNTIL I < 1 OR E5-STR(I:1) 070970 NOT = SPACE 070980 COMPUTE I = I - 1 END-COMPUTE 070990 END-PERFORM 071000 MOVE I TO AKTLG 071010 MOVE SPACES TO ALPHA-TAB11 071011** ------------------------------------------------------------- 071020** üBERTRAGEN IN HILFSFELD 071021** ------------------------------------------------------------- 071030 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 071040 MOVE E5-STR(I:1) TO ALPHA-ELEM(I) 071041 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 071042 TO GROSSBUCHSTB 071050 END-PERFORM 071051 IF AKTLG > 1 071052** ---------------------------------------------------------- 071053** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 071054** ---------------------------------------------------------- 071055 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 071056 OR HFELD-S = 1 071057 IF ALPHA-ELEM(I) IS SONDERZ THEN 071058 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 071059 MOVE "DBAN150" TO H-FEHLER 071060 MOVE 1 TO HFELD-S 071061 END-IF 071062 END-IF 071063 END-PERFORM 071064 IF HFELD-S = 1 THEN 071065 PERFORM FEHLER 071068 END-IF 071069** ---------------------------------------------------------- 071070** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM ANFANG 071071** AUSNAHME: STRAßE BEGINNT MIT III. UND 071072** DER PUNKT IST NICHT DAS LETZTE ZEICHEN 071073** ---------------------------------------------------------- 071074 IF AKTLG >= 3 AND 071075 ALPHA-ELEM(1) IS ALPHA-ALLG AND 071076 ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND 071077 ALPHA-ELEM(1) EQUAL ALPHA-ELEM(3) THEN 071078 IF (E5-STR(1:4) NOT = "III.") OR 071079 (E5-STR(1:4) = "III." AND AKTLG = 4) THEN 071080 MOVE "DBAN151" TO H-FEHLER 071081 PERFORM FEHLER 071084 END-IF 071085 END-IF 071086** ---------------------------------------------------------- 071087** PRÜFEN OB GÜLTIGE ZEICHEN ODER HOCHKOMMATA 071088** ---------------------------------------------------------- 071096 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 071097 OR HFELD-S = 1 071098 IF ALPHA-ELEM(I) NOT GBOT-ALPHA 071100 MOVE "DBAN156" TO H-FEHLER 071101 MOVE 1 TO HFELD-S 071102 END-IF 071104 END-PERFORM 071105 IF HFELD-S = 1 THEN 071106 PERFORM FEHLER 071107 END-IF 071110 PERFORM ANT6081 071111 ELSE 071112** ---------------------------------------------------------- 071113** WENIGER ALS 2 ZEICHEN 071114** ---------------------------------------------------------- 071115** IF ALPHA-ELEM(1) NOT GROSSBUCHSTABE 071116 IF E5-STR(1:1) NOT GROSSBUCHSTABE 071117** ------------------------------------------------------- 071118** KEIN GROSSBUCHSTABE 071119** ------------------------------------------------------- 071120 MOVE "DBAN158" TO H-FEHLER 071121 PERFORM FEHLER 071122 END-IF 071130 END-IF 071390 . 071391 071392 071400 FDBAN150-EXIT. 071410 EXIT. 071411 071412 071413 071415 071420 ANT6081 SECTION. 071430 ANT6081E. 071440 IF E5-STR(1:1) ALPHA-ALLG OR 071450 E5-STR(1:1) ZIFF-ALLG OR 071451 E5-STR(1:1) = "'" OR "`" 071452 IF E5-STR(1:1) IS ZIFF-ALLG THEN 071453** ------------------------------------------------------- 071454** ERMITTELN LäNGE DER ZIFFERNFOLGE 071455** ------------------------------------------------------- 071456 PERFORM VARYING I FROM 2 BY 1 UNTIL ALPHA-ELEM(I) 071457 NOT NUMERIC OR I > AKTLG 071458 CONTINUE 071459 END-PERFORM 071460** ------------------------------------------------------- 071461** PRüFEN, OB KOMPLETTE STRASSE NUMERISCH IST 071462** ------------------------------------------------------- 071463 IF I > AKTLG 071464 MOVE "DBAN162" TO H-FEHLER 071465 PERFORM FEHLER 071466 ELSE 071467** ---------------------------------------------------- 071468** PRüFEN, OB GüLTIGES ZEICHEN NACH ZIFFERNFOLGE 071469** ---------------------------------------------------- 071471 IF E5-STR(I:1) NOT ALPHA-ALLG AND 071472 E5-STR(I:1) NOT = "." AND 071473 E5-STR(I:1) NOT = "-" AND 071474 E5-STR(I:1) NOT = "," AND 071475 E5-STR(I:1) NOT = " " THEN 071476 MOVE "DBAN162" TO H-FEHLER 071477 PERFORM FEHLER 071479 END-IF 071480 END-IF 071481 ELSE 071482** ------------------------------------------------------- 071483** PRÜFEN, OB ZIFFER VORHANDEN (AB 2.STELLE) 071484** PRÜFEN, OB ZIFFER VORHANDEN (AB 3.STELLE) 071485** ------------------------------------------------------- 071486 PERFORM VARYING I FROM 2 BY 1 UNTIL ALPHA-ELEM(I) 071487 IS NUMERIC OR I > AKTLG 071488 CONTINUE 071489 END-PERFORM 071490 IF I <= AKTLG THEN 071491 IF ALPHA-ELEM(I - 1) NOT VOSA-ALPHA 071492 MOVE "DBAN164" TO H-FEHLER 071493 PERFORM FEHLER 071495 END-IF 071501 END-IF 071502 END-IF 071503 ELSE 071504 MOVE "DBAN160" TO H-FEHLER 071505 PERFORM FEHLER 071506 END-IF 071507** ------------------------------------------------------------- 071508** PRüFEN, OB PUNKT VORHANDEN 071509** ------------------------------------------------------------- 071510 PERFORM VARYING I FROM 1 BY 1 071511 UNTIL ALPHA-ELEM(I) = "." OR I > AKTLG 071512 CONTINUE 071513 END-PERFORM 071514 IF I = 1 THEN 071515 MOVE "DBAN166" TO H-FEHLER 071516 PERFORM FEHLER 071517 ELSE 071518 IF I <= AKTLG THEN 071519 IF ALPHA-ELEM(I - 1) NOT ALPHA-ALLG AND 071520 ALPHA-ELEM(I - 1) NOT NUMERIC THEN 071521 MOVE "DBAN166" TO H-FEHLER 071522 PERFORM FEHLER 071523 END-IF 071524 END-IF 071525 END-IF 071526** ------------------------------------------------------------- 071527** PRüFEN, OB LETZTES ZEICHEN GüLTIG 071528** ------------------------------------------------------------- 071529 IF E5-STR(AKTLG:1) NOT STRL-ALLG THEN 071530 MOVE "DBAN168" TO H-FEHLER 071531 PERFORM FEHLER 071532 END-IF 071542 . 071600 071700 072130 ANT6081-EXIT. 072140 EXIT. 072141 072142 022760*COPY CDBAN170 REPLACING ==:S4:== BY ==E5==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAN170 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 05.05.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG HAUSNUMMER 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 12.10.2006 001630** VERSION : 002 / 056 001650**---------------------------------------------------------------- 001700 FDBAN170 SECTION. 001800 FDBAN170E. 001900 IF E5-NR = " " THEN 001910 GO TO FDBAN170-EXIT 001920 END-IF 001921** ERMITTELN TATSäCHLICHE LäNGE NR 001923 MOVE 9 TO I 001924 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E5-NR(I:1) 001925 NOT = SPACE 001926 COMPUTE I = I - 1 END-COMPUTE 001927 END-PERFORM 001928 MOVE I TO AKTLG 001929 MOVE SPACES TO ALPHA-TAB11 001930** üBERTRAGEN IN HILFSFELD 001931 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 001932 MOVE E5-NR(I:1) TO ALPHA-ELEM(I) 001940 END-PERFORM 001960** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 002000 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 002010 OR HFELD-S = 1 002020 IF ALPHA-ELEM(I) IS SONDERZ THEN 002030 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 002040 MOVE "DBAN170" TO H-FEHLER 002050 MOVE 1 TO HFELD-S 002060 END-IF 002070 END-IF 002080 END-PERFORM 002090 IF HFELD-S = 1 THEN 002091 PERFORM FEHLER 002094 END-IF 003342** PRüFEN, OB ZULäSSIGE ZEICHEN 003343 IF E5-NR(1:AKTLG) NOT HNR-ALLG THEN 003344 MOVE "DBAN174" TO H-FEHLER 003345 PERFORM FEHLER 003346 END-IF 003355 IF E5-NR(1:1) NOT ALPHA-ALLG AND 003356 E5-NR(1:1) NOT ZIFF-ALLG THEN 003357 MOVE "DBAN176" TO H-FEHLER 003358 PERFORM FEHLER 003359 END-IF 003360 IF E5-NR(AKTLG:1) NOT ALPHA-ALLG AND 003361 E5-NR(AKTLG:1) NOT ZIFF-ALLG THEN 003362 MOVE "DBAN176" TO H-FEHLER 003370 PERFORM FEHLER 003380 END-IF 003445 . 003450 FDBAN170-EXIT. 003500 EXIT. 022770*COPY CDBAN180 REPLACING ==:S4:== BY ==E5==. 072720**---------------------------------------------------------------- 072730** COPY-MEMBER : CDBAN180 072740** PROGRAMMIERER : WERNER KRAUS 072750** ERSTELLUNGSDATUM : 05.05.1998 072760** VERSION : 001 (PGM-NSOERSTELLUNG) 072770** FUNKTION : FEHLERPRüFUNG ANSCHRIFTENZUSATZ 072780**---------------------------------------------------------------- 072781** AENDERUNGSDATUM : 25.06.2001 072782** VERSION : 002 072783** AENDERUNG : FELDLÄNGE VON ADRZU ALS VARIABLE 072784**---------------------------------------------------------------- 072785** PROGRAMMIERER : MICHAEL KLEMKE 072786** AENDERUNGSDATUM : 14.11.2001 072787** VERSION : 003 072788** AENDERUNG : DBAN186 ENTFERNT 072789**---------------------------------------------------------------- 072790** PROGRAMMIERER : MICHAEL KLEMKE 072791** AENDERUNGSDATUM : 23.04.2007 072792** VERSION : 004 / VERSION 62 072794**---------------------------------------------------------------- 072795 FDBAN180 SECTION. 072800 FDBAN180E. 072810 IF E5-ADRZU = SPACE THEN 072820 GO TO FDBAN180-EXIT 072830 END-IF 072841** ------------------------------------------------------------- 072842** FELDLAENGE ALS VARIABLE (UNTERSCHIED DUEVO / KVDR) 072843** ------------------------------------------------------------- 072844 MOVE DBAN-ADRZU-LEN TO I 072850** MOVE 40 TO I 072860 PERFORM WITH TEST BEFORE UNTIL I < 1 OR E5-ADRZU(I:1) 072870 NOT = SPACE 072871** ---------------------------------------------------------- 072872** ERMITTELN TATSäCHLICHE LäNGE ANSCHRIFTENZUSATZ 072873** ---------------------------------------------------------- 072880 COMPUTE I = I - 1 END-COMPUTE 072890 END-PERFORM 072900 MOVE I TO AKTLG 072910 MOVE SPACES TO ALPHA-TAB11 072911 072912** ------------------------------------------------------------- 072920** üBERTRAGEN IN HILFSFELD 072921** ------------------------------------------------------------- 072930 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 072940 MOVE E5-ADRZU(I:1) TO ALPHA-ELEM(I) 072941 INSPECT ALPHA-ELEM(I) CONVERTING KLEINBUCHSTB 072942 TO GROSSBUCHSTB 072950 END-PERFORM 072951 072953** ------------------------------------------------------------- 072960** üBERPRüFEN AUF GLEICHE SONDERZEICHEN HINTEREINANDER 072961** ------------------------------------------------------------- 072970 PERFORM VARYING I FROM 1 BY 1 UNTIL I = AKTLG 072980 OR HFELD-S = 1 072990 IF ALPHA-ELEM(I) IS SONDERZ THEN 073000 IF ALPHA-ELEM(I + 1) = ALPHA-ELEM(I) THEN 073010 MOVE "DBAN180" TO H-FEHLER 073020 PERFORM FEHLER 073030 END-IF 073040 END-IF 073050 END-PERFORM 073056 073057** ------------------------------------------------------------- 073058** PRüFEN AUF DREI GLEICHE BUCHSTABEN AM ANFANG 073059** AUSNAHME: ADRZU BEGINNT MIT III. UND 073060** DER PUNKT IST NICHT DAS LETZTE ZEICHEN 073061** ------------------------------------------------------------- 073062 IF AKTLG >= 3 AND 073063 ALPHA-ELEM(1) IS ALPHA-ALLG AND 073064 ALPHA-ELEM(1) EQUAL ALPHA-ELEM(2) AND 073065 ALPHA-ELEM(1) EQUAL ALPHA-ELEM(3) THEN 073066 IF (E5-ADRZU(1:4) NOT = "III.") OR 073067 (E5-ADRZU(1:4) = "III." AND AKTLG = 4) THEN 073068 MOVE "DBAN181" TO H-FEHLER 073069 PERFORM FEHLER 073070 END-IF 073071 END-IF 073072 073100** ------------------------------------------------------------- 073101** PRÜFEN OB GÜLTIGE ZEICHEN 073102** ------------------------------------------------------------- 073120 IF E5-ADRZU(1:AKTLG) NOT GBOT-ALPHA THEN 073130 MOVE "DBAN184" TO H-FEHLER 073140 PERFORM FEHLER 073150 END-IF 073210 PERFORM ANT6101 073220 . 073221 073222 073230 FDBAN180-EXIT. 073240 EXIT. 073241 073242 073250 ANT6101 SECTION. 073260 ANT6101E. 073261** ----------------------------------------------------------- 073262** T6101 ANFANG 073263** ----------------------------------------------------------- 073270 IF E5-ADRZU(1:1) IS ANZU THEN 073271 CONTINUE 073272 ELSE 073273 MOVE "DBAN185" TO H-FEHLER 073274 PERFORM FEHLER 073275 END-IF 073276 073300** ----------------------------------------------------------- 073400** PRüFEN, OB PUNKT VORHANDEN 073410** ----------------------------------------------------------- 073411 PERFORM VARYING I FROM 1 BY 1 073412 UNTIL ALPHA-ELEM(I) = "." OR I > AKTLG 073414 CONTINUE 073415 END-PERFORM 073416 IF I <= AKTLG THEN 073417** -------------------------------------------------------- 073418** PUNKT VORHANDEN 073419** -------------------------------------------------------- 073420 IF I > 1 073421 IF ALPHA-ELEM(I - 1) IS ANZU THEN 073422** -------------------------------------------------- 073423** PRÜFEN: BUCHSTABE ODER ZIFFER VOR DEM PUNKT 073424** -------------------------------------------------- 073425 CONTINUE 073426 ELSE 073427 MOVE "DBAN188" TO H-FEHLER 073428 PERFORM FEHLER 073430 END-IF 073433 ELSE 073434** ----------------------------------------------------- 073435** PUNKT STEHT AN ERSTER STELLE 073436** ----------------------------------------------------- 073437 MOVE "DBAN188" TO H-FEHLER 073438 PERFORM FEHLER 073440 END-IF 073450 END-IF 073620 . 073621 073630 ANT6101-EXIT. 073640 EXIT. 023800*COPY CDSAE020 REPLACING ==:S11:== BY ==E12==. 000100**---------------------------------------------------------------- 000200** COPY-MEMBER : CDSAE020 000300** PROGRAMMIERER : WERNER KRAUS 000400** ERSTELLUNGSDATUM : 09.02.1998 000500** VERSION : 001 (PGM-NEUERSTELLUNG) 000600** FUNKTION : FEHLERPRüFUNG BBNRAB-NUM IN DSAE 000700**---------------------------------------------------------------- 000800** PROGRAMMIERER : MICHAEL KLEMKE 000900** ERSTELLUNGSDATUM : 17.04.2002 001000** VERSION : 002 001100** FUNKTION : ERWEITERUNG DER BETRIEBSNUMMERN 001200**---------------------------------------------------------------- 001300** PROGRAMMIERER : MICHAEL KLEMKE 001400** ERSTELLUNGSDATUM : 20.10.2002 001500** VERSION : 003 001700**---------------------------------------------------------------- 001800** PROGRAMMIERER : MICHAEL KLEMKE 001900** ERSTELLUNGSDATUM : 14.07.2006 002000** VERSION : 004 / 055 002100**---------------------------------------------------------------- 002200** PROGRAMMIERER : MICHAEL KLEMKE 002300** ERSTELLUNGSDATUM : 10.10.2006 002400** VERSION : 005 / 056 002500**---------------------------------------------------------------- 043900 FDSAE020 SECTION. 043910 FDSAE020E. 043920 IF E12-BBNRAB-NUM-1-8 NUMERIC THEN 043921 IF (E12-BBNRAB-NUM(1:3) >= "001" AND <= "099") OR 043922 (E12-BBNRAB-NUM(1:3) > "110") 043923 043924 MOVE E12-BBNRAB-NUM-1-7 TO ZIFFER-TABELLE 043925 MOVE 0 TO HILFSFELD 043926 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 043927 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 043928 END-COMPUTE 043929 COMPUTE HILFSFELD = HILFSFELD + QUERSUMME-1 043930 + QUERSUMME-2 043931 END-COMPUTE 043932 END-PERFORM 043933 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 043934 COMPUTE RESTB = REST + 5 END-COMPUTE 043935 IF E12-BBNRAB-NUM-8 = REST OR 043936 E12-BBNRAB-NUM-8 = RESTBR2 THEN 043937** ---------------------------------------------------- 043938** BETRIEBSNUMMER DES ABSENDERS FEHLERFREI 043939** ---------------------------------------------------- 043940 IF OP-BATRV 043941 IF E12-BBNRAB-NUM-1-8 = "76641777" 043943 CONTINUE 043944 ELSE 043945 IF E12-BBNRAB-NUM-1-8 = "12621621" 043946 IF ST-DSAE 043947 CONTINUE 043948 ELSE 043949 MOVE "DSAE022" TO H-FEHLER 043950 END-IF 043951 ELSE 043952 MOVE "DSAE022" TO H-FEHLER 043953 END-IF 043956 END-IF 043957 ELSE 043958** --------------------------------------------------- 043959** T52111 043960** --------------------------------------------------- 043961 IF OP-BWTRV 043962 IF E12-BBNRAB-NUM-1-8 = "32349289" THEN 043963 CONTINUE 043964 ELSE 043965 MOVE "DSAE022" TO H-FEHLER 043966 END-IF 043967 ELSE 043968 IF OP-BZTRV 043969 IF E12-BBNRAB-NUM-1-8 = "38065304" THEN 043970 CONTINUE 043971 ELSE 043972 MOVE "DSAE022" TO H-FEHLER 043973 END-IF 043974 ELSE 043975** ----------------------------------------------- 043976** T52112 043977** ----------------------------------------------- 043978 IF OP-PVTRV 043979 IF E12-BBNRAB-NUM(1:3) = "996" THEN 043980 CONTINUE 043981 ELSE 043982 MOVE "DSAE022" TO H-FEHLER 043983 END-IF 043984 ELSE 043985 IF OP-KSTRV 043986 IF E12-BBNRAB-NUM-1-8 = "28180427" 043987 CONTINUE 043988 ELSE 043989 MOVE "DSAE022" TO H-FEHLER 043990 END-IF 043991 ELSE 043992** ------------------------------------------- 043993** T52114 043994** ------------------------------------------- 043995 IF OP-UETBF 043996 IF E12-BBNRAB-NUM-1-8 = "98503184" OR 043997 E12-BBNRAB-NUM-1-8 = "98702232" 043998 CONTINUE 043999 ELSE 044000 MOVE "DSAE022" TO H-FEHLER 044001 END-IF 044002 ELSE 044003** ------------------------------------------ 044004** T52115 044005** ------------------------------------------ 044006 IF OP-ZFTRV 044007 IF E12-BBNRAB-NUM-1-8 = "02998824" 044008 CONTINUE 044009 ELSE 044010 MOVE "DSAE022" TO H-FEHLER 044011 END-IF 044012 END-IF 044013 END-IF 044014 END-IF 044015 END-IF 044017 END-IF 044018 END-IF 044019 END-IF 044020 ELSE 044021 MOVE "DSAE020" TO H-FEHLER 044022 END-IF 044023 ELSE 044024 MOVE "DSAE020" TO H-FEHLER 044025 END-IF 044026 ELSE 044027 MOVE "DSAE020" TO H-FEHLER 044028 END-IF 044029 . 044030 044040 044930 FDSAE020-EXIT. 044940 EXIT. 023810*COPY CDSAE030 REPLACING ==:S11:== BY ==E12==. 044960**---------------------------------------------------------------- 044970** COPY-MEMBER : CDSAE030 044980** PROGRAMMIERER : WERNER KRAUS 044990** ERSTELLUNGSDATUM : 09.02.1998 045000** VERSION : 001 (PGM-NEUERSTELLUNG) 045010** FUNKTION : FEHLERPRüFUNG BBNREP-NUM IN DSAE 045011**---------------------------------------------------------------- 045012** PROGRAMMIERER : GERTRAUD SCHUHMACHER 045013** ÄNDERUNG : 001 VOM 30.04.2001 VERSION 24 045020**---------------------------------------------------------------- 045021** PROGRAMMIERER : MICHAEL KLEMKE 045022** ÄNDERUNG : 002 VOM 20.10.2003 VERSION 36 045023**---------------------------------------------------------------- 045024** PROGRAMMIERER : MICHAEL KLEMKE 045025** ÄNDERUNG : 003 VOM 06.12.2004 VERSION 42 045026**---------------------------------------------------------------- 045027** PROGRAMMIERER : MICHAEL KLEMKE 045028** ÄNDERUNG : 004 VOM 10.10.2006 VERSION 56 045029**---------------------------------------------------------------- 045030** PROGRAMMIERER : MICHAEL KLEMKE 045031** ÄNDERUNG : 005 VOM 28.02.2007 VERSION 60 045032**---------------------------------------------------------------- 045033 FDSAE030 SECTION. 045040 FDSAE030E. 045041 045042 IF E12-BBNREP-NUM-1-8 NUMERIC THEN 045043 045044 MOVE E12-BBNREP-NUM-1-7 TO ZIFFER-TABELLE 045045 MOVE 0 TO HILFSFELD 045046 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 045047 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 045048 END-COMPUTE 045049 COMPUTE HILFSFELD = HILFSFELD 045050 + QUERSUMME-1 045051 + QUERSUMME-2 045052 END-COMPUTE 045053 END-PERFORM 045054 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 045055 COMPUTE RESTB = REST + 5 END-COMPUTE 045056 IF E12-BBNREP-NUM-8 = REST OR 045057 E12-BBNREP-NUM-8 = RESTBR2 THEN 045058* ----------------------------------------------------- 045059* T52121 045060* ----------------------------------------------------- 045061 IF OP-KVTWL OR OP-KVTRV THEN 045062 IF E12-BBNREP-NUM-1-8 NOT = "66667777" 045063 AND NOT = "98094032" 045064 MOVE "DSAE032" TO H-FEHLER 045065 END-IF 045066 ELSE 045067* -------------------------------------------------- 045068* ÄNDERUNG VOM 20.10.2003 / VERSION 36 045069* -------------------------------------------------- 045070 IF OP-ZFTRV THEN 045071 IF E12-BBNREP-NUM-1-8 NOT = "90209055" THEN 045072 MOVE "DSAE032" TO H-FEHLER 045073 END-IF 045074 END-IF 045075* -------------------------------------------------- 045076 END-IF 045077 IF H-FEHLER NOT = "DSAE032" 045078* -------------------------------------------------- 045079* T52122 045080* -------------------------------------------------- 045081 IF OP-BATRV OR OP-KTTRV 045082 IF E12-BBNREP-NUM-1-8 NOT = "66667777" 045083 MOVE "DSAE032" TO H-FEHLER 045084 END-IF 045085 ELSE 045086 IF OP-RVTBA THEN 045087 IF E12-BBNREP-NUM-1-8 NOT = "76641777" THEN 045088 MOVE "DSAE032" TO H-FEHLER 045089 END-IF 045090 END-IF 045091 END-IF 045092 END-IF 045093* ----------------------------------------------------- 045094 ELSE 045095 MOVE "DSAE030" TO H-FEHLER 045096 END-IF 045097 ELSE 045098 MOVE "DSAE030" TO H-FEHLER 045099 END-IF 045100 . 045101 045102 045293 FDSAE030-EXIT. 045300 EXIT. 023900*COPY CDSAE040 REPLACING ==:S11:== BY ==E12==. 045310**---------------------------------------------------------------- 045320** COPY-MEMBER : CDSAE040 045330** PROGRAMMIERER : WERNER KRAUS 045340** ERSTELLUNGSDATUM : 09.02.1998 045350** VERSION : 001 (PGM-NEUERSTELLUNG) 045360** FUNKTION : FEHLERPRüFUNG VERSINSNUMMER 045370**---------------------------------------------------------------- 045380 FDSAE040 SECTION. 045390 FDSAE040E. 045400 IF E12-VERNR NOT NUMERIC 045410 MOVE "DSAE040" TO H-FEHLER 045420 ELSE IF 045430 E12-VERNR NOT EQUAL 01 045440 MOVE "DSAE042" TO H-FEHLER 045450 END-IF 045460 . 045470 FDSAE040-EXIT. 045480 EXIT. 024000*COPY CDSAE050 REPLACING ==:S11:== BY ==E12==. 045680**---------------------------------------------------------------- 045690** COPY-MEMBER : CDSAE050 045700** PROGRAMMIERER : WERNER KRAUS 045710** ERSTELLUNGSDATUM : 09.02.1998 045720** VERSION : 001 (PGM-NEUERSTELLUNG) 045730** FUNKTION : FEHLERPRüFUNG DATUM-ERSTELLUNG 045740** DATENDEFINITION IM COPYMEMBER DDSAE050 045750**---------------------------------------------------------------- 045752** PROGRAMMIERER : GERTRAUD SCHUHMACHER 045753** ÄNDERUNG : 001 VOM 30.04.2001 VERSION 24 045754**---------------------------------------------------------------- 046000** PROGRAMMIERER : MICHAEL KLEMKE 046100** ÄNDERUNG : 002 VOM 11.10.2004 VERSION 41 046200**---------------------------------------------------------------- 046300 FDSAE050 SECTION. 046400 FDSAE050E. 046500 SET NOT-DSME05X-VOR TO TRUE 046600 IF E12-ED NUMERIC THEN 046700 DIVIDE 4 INTO E12-HJJ GIVING ERG REMAINDER SCHALTJAHR 046800 IF E12-HMM > ZERO AND < 13 046900 AND E12-HTT > ZERO 047000 AND <= TGT(SCHALTJAHR + 1, E12-HMM) THEN 047100 IF E12-HDAT > P-DATE 047200 MOVE "DSAE054" TO H-FEHLER 047300 SET DSME05X-VORH TO TRUE 047400 PERFORM FEHLER 047500 END-IF 047600 ELSE 047700 MOVE "DSAE052" TO H-FEHLER 047800 SET DSME05X-VORH TO TRUE 047900 PERFORM FEHLER 048000 END-IF 048100 IF E12-HSTD > 23 OR 048200 E12-HMIN >= 60 OR 048300 E12-HSEK >= 60 THEN 048400 MOVE "DSAE056" TO H-FEHLER 048500 SET DSME05X-VORH TO TRUE 048600 PERFORM FEHLER 048700 END-IF 048800 IF NOT-DSME05X-VOR 048900 IF OP-AGDEU OR OP-WLTKV 049000 CONTINUE 049100 ELSE 049200 IF E12-HDAT = P-DATE THEN 049300 IF NOT ST-DSKO 049400 IF E12-HUHR >= P-TIME THEN 049500 MOVE "DSAE058" TO H-FEHLER 049600 PERFORM FEHLER 049700 END-IF 049800 END-IF 049900 END-IF 050000 END-IF 050100 END-IF 050200 ELSE 050300 MOVE "DSAE050" TO H-FEHLER 050400 END-IF 050500 . 050600 050700 050800 FDSAE050-EXIT. 050900 EXIT. 051000 051100 024100*COPY CDSAE060 REPLACING ==:S11:== BY ==E12==. 045920**---------------------------------------------------------------- 045930** COPY-MEMBER : CDSAE060 045940** PROGRAMMIERER : WERNER KRAUS 045950** ERSTELLUNGSDATUM : 10.02.1998 045960** VERSION : 001 (PGM-NEUERSTELLUNG) 045970** FUNKTION : FEHLERPRüFUNG FEHLERKENNZEICHEN 045980** DATENDEFINITION IM COPYMEMBER DDSAE060 045990**---------------------------------------------------------------- 045991** PROGRAMMIERER : MICHAEL KLEMKE 045992** ÄNDERUNG : 11.10.2004 045993** VERSION : 002 / VERSION 41 045994**---------------------------------------------------------------- 046000 FDSAE060 SECTION. 046010 FDSAE060E. 046160 IF E12-FEKZ NUMERIC THEN 046161 IF E12-FEAN NUMERIC THEN 046162 IF E12-FEAN = 0 046163 IF E12-FEKZ = 0 OR 1 OR 2 046164 CONTINUE 046165 ELSE 046166 MOVE "DSAE062" TO H-FEHLER 046167 END-IF 046168 ELSE 046169 MOVE "DSAE072" TO H-FEHLER 046170 END-IF 046171 ELSE 046172 MOVE "DSAE070" TO H-FEHLER 046173 END-IF 046174 ELSE 046175 MOVE "DSAE060" TO H-FEHLER 046176 END-IF 046177 . 046178 046179 046184 FDSAE060-EXIT. 046190 EXIT. 024200*COPY CDSAE080 REPLACING ==:S11:== BY ==E12==. 046210**---------------------------------------------------------------- 046220** COPY-MEMBER : CDSAE080 046230** PROGRAMMIERER : WERNER KRAUS 046240** ERSTELLUNGSDATUM : 10.02.1998 046250** VERSION : 001 (PGM-NEUERSTELLUNG) 046260** FUNKTION : FEHLERPRüFUNG VSNR 046270**---------------------------------------------------------------- 046271** PROGRAMMIERER : MICHAEL KLEMKE 046272** ERSTELLUNGSDATUM : 20.10.2003 046273** VERSION : 002 046275**---------------------------------------------------------------- 046276** PROGRAMMIERER : MICHAEL KLEMKE 046277** ERSTELLUNGSDATUM : 16.10.2006 046278** VERSION : 003 / VERSION 056 046279**---------------------------------------------------------------- 046280** PROGRAMMIERER : MICHAEL KLEMKE 046281** ERSTELLUNGSDATUM : 18.04.2007 046282** VERSION : 003 / VERSION 062 046283**---------------------------------------------------------------- 046284 FDSAE080 SECTION. 046290 FDSAE080E. 046300 MOVE E12-VSNR TO HVSNR 046400 IF E12-VSNR = SPACE THEN 046500 IF ST-DSAE THEN 046600 MOVE "DSAE082" TO H-FEHLER 046700 MOVE "N" TO HFELD-P-GBDT 046800 GO TO FDSAE080-EXIT 046900 ELSE 047000 IF OP-AGDEU OR OP-KVDEU OR OP-WLTKV OR OP-KSTKV THEN 047100 MOVE "N" TO HFELD-P-GBDT 047200 GO TO FDSAE080-EXIT 047300 ELSE 047400 MOVE "DSAE080" TO H-FEHLER 047500 MOVE "N" TO HFELD-P-GBDT 047600 GO TO FDSAE080-EXIT 047700 END-IF 047800 END-IF 047900 ELSE 048000 IF HVSNRNUM1 NOT NUMERIC OR HVSNRNUM2 NOT NUMERIC OR 048100 HVSNR2 NOT VSNRBUCHSTABE 048200 MOVE "DSAE082" TO H-FEHLER 048300 MOVE "N" TO HFELD-P-GBDT 048400 GO TO FDSAE080-EXIT 048500 ELSE 048501* ----------------------------------------------------- 048502* T52210 048510* ----------------------------------------------------- 048511 SET PRUEF-T52212 TO TRUE 048512 IF ST-DSME THEN 048513* -------------------------------------------------- 048514* KANN NICHT DURCHLAUFEN WERDEN, DA DSAE 048515* -------------------------------------------------- 048516 CONTINUE 048517 ELSE 048518 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB0 048519 IF BNR-TAB0-OK THEN 048520 SET PRUEF-T52211 TO TRUE 048521 ELSE 048522 MOVE "DSAE084" TO H-FEHLER 048523 MOVE "N" TO HFELD-P-GBDT 048525 GO TO FDSAE080-EXIT 048526 END-IF 048527 END-IF 048528* ----------------------------------------------------- 048529* T52210 ENDE 048530* ----------------------------------------------------- 048531 048532 IF PRUEF-T52211 THEN 048533* -------------------------------------------------- 048534* T52211 048535* -------------------------------------------------- 048800 IF ST-DSME THEN 048810* ----------------------------------------------- 048820* KANN NICHT DURCHLAUFEN WERDEN, DA DSAE 048830* ----------------------------------------------- 048900 CONTINUE 050400 ELSE 050500 PERFORM T522111-E12 050600 END-IF 050601* -------------------------------------------------- 050602* T52211 - ENDE 050610* -------------------------------------------------- 050700 END-IF 063200 END-IF 063300 END-IF 063400 . 063410 063420 063500 FDSAE080-EXIT. 063600 EXIT. 063610 063620 063700 T522111-E12 SECTION. 063800 T522111-E12E. 063900 IF HVSNRGEBMM < 00 OR > 12 THEN 064000 MOVE "DSAE086" TO H-FEHLER 064100 MOVE "N" TO HFELD-P-GBDT 064200 GO TO T522111-E12-EXIT 064300 END-IF 064400 IF HVSNRGEBTT > 95 AND NOT EQUAL 97 THEN 064500 MOVE "DSAE086" TO H-FEHLER 064600 MOVE "N" TO HFELD-P-GBDT 064700 GO TO T522111-E12-EXIT 064800 END-IF 064900 IF HVSNRGEBTT = 97 AND 065000 HVSNRGEBMM < 01 OR > 12 THEN 065100 MOVE "DSAE086" TO H-FEHLER 065200 MOVE "N" TO HFELD-P-GBDT 065300 GO TO T522111-E12-EXIT 065400 END-IF 065410** 065411 IF (HVSNRGEBTT > ZERO AND HVSNRGEBTT <= 31) AND 065412 (HVSNRGEBMM > ZERO AND HVSNRGEBMM <= 12) THEN 065420 MOVE 0 TO HFELD-GEB 065430 MOVE HVSNRGEBJJ TO HFELD-GEB-JJ 065440 MOVE HVSNRGEBMM TO HFELD-GEB-MM 065450 MOVE HVSNRGEBTT TO HFELD-GEB-TT 065460 DIVIDE 4 INTO HFELD-GEB-JJ GIVING ERG 065470 REMAINDER SCHALTJAHR 065480 IF HFELD-GEB-MM > ZERO AND < 13 065490 AND HFELD-GEB-TT > ZERO 065491 AND <= TGT(SCHALTJAHR + 1, HFELD-GEB-MM) THEN 065492 CONTINUE 065493 ELSE 065494 MOVE "DSAE086" TO H-FEHLER 065495 MOVE "N" TO HFELD-P-GBDT 065496 GO TO T522111-E12-EXIT 065497 END-IF 065498 END-IF 065499** 065500 MOVE HVSNRNUM1 TO ZIFF-1-8 065600 MOVE HVSNRSS TO ZIFF-11-12 065700 MOVE 1 TO I 065800 MOVE 0 TO SX-BUCHSTABE 065900 PERFORM UNTIL I > 26 066000 OR BUCHSTABE-GEFUNDEN 066100 IF HVSNR2 = ALPHA-B(I) 066200 MOVE I TO ZIFF-9-A2 066300 MOVE 1 TO SX-BUCHSTABE 066400 END-IF 066500 ADD 1 TO I 066600 END-PERFORM 066700 MOVE 0 TO HILFSFELD 066800 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 12 066900 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR-VSNR(I) 067000 END-COMPUTE 067100 COMPUTE HILFSFELD = QUERSUMME-1 + QUERSUMME-2 + 067200 HILFSFELD 067300 END-COMPUTE 067400 END-PERFORM 067500 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER 067600 REST 067700 IF REST NOT EQUAL HVSNRPR 067800 MOVE "DSAE088" TO H-FEHLER 067900 MOVE "N" TO HFELD-P-GBDT 068000 GO TO T522111-E12-EXIT 068100 ELSE 068101* -------------------------------------------------------- 068102* ÄNDERUNG VOM 20.10.2003 / VERSION 36 068103* -------------------------------------------------------- 068104* T522112 068105* -------------------------------------------------------- 068106 IF HVSNR1(1:2) = "40" AND NOT OP-ZFTRV AND NOT OP-RVTZF 068108 GO TO T522111-E12-EXIT 068109 ELSE 068110* ----------------------------------------------------- 068111* T522113 068112* ----------------------------------------------------- 068113 IF HVSNR = "12140421E115" OR "10140441E119" OR 068114 "39180607P581" OR "39180607S584" OR 068115 "65010166L519" OR "13010181R009" OR 068116 "13010481R002" OR "13160481R002" OR 068117 "13010581R003" OR "13130681R007" OR 068118 "12140461E114" OR "12140481E118" THEN 068119 MOVE "DSAE089" TO H-FEHLER 068120 GO TO T522111-E12-EXIT 068121 END-IF 068130 END-IF 068200* -------------------------------------------------------- 068300 END-IF 068400 . 068500 T522111-E12-EXIT. 068600 EXIT. 024210*COPY CDSAE120 REPLACING ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSAE120 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG PERSGR 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 20.10.2003 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 06.12.2004 001680** VERSION : 003 / 42 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ERSTELLUNGSDATUM : 10.10.2006 001693** VERSION : 004 / 56 001694**---------------------------------------------------------------- 001700 FDSAE120 SECTION. 001710 FDSAE120E. 001711 IF E12-VSTR = "0A" OR "0B" OR "0C" OR "0G" OR "AB" OR "AC" 001712 OR "AG" OR "BA" OR "BB" OR "BC" OR "BG" THEN 001713 CONTINUE 001760 ELSE 001770 MOVE "DSAE120" TO H-FEHLER 001780 GO TO FDSAE120-EXIT 001790 END-IF 001791** ------------------------------------------------------------- 001792** T52221 001793** ------------------------------------------------------------- 001800 IF OP-AGDEU OR OP-WLTKV THEN 001900 EVALUATE E12-VSTR 002000 WHEN "0A" GO TO FDSAE120-EXIT 002010 WHEN "0B" GO TO FDSAE120-EXIT 002011 WHEN "0C" GO TO FDSAE120-EXIT 002012 WHEN "0G" GO TO FDSAE120-EXIT 002020 WHEN " " GO TO FDSAE120-EXIT 002030 WHEN OTHER 002050 MOVE "DSAE122" TO H-FEHLER 002060 GO TO FDSAE120-EXIT 002070 END-EVALUATE 002071 ELSE 002080 IF OP-KVTWL OR OP-KVTRV OR OP-PVTRV OR 002090 OP-BATRV OR OP-BWTRV OR OP-BZTRV OR 002091 OP-KTTRV 002092 EVALUATE E12-VSTR 002093 WHEN "0A" GO TO FDSAE120-EXIT 002094 WHEN "0B" GO TO FDSAE120-EXIT 002095 WHEN "0C" GO TO FDSAE120-EXIT 002096 WHEN "0G" GO TO FDSAE120-EXIT 002097 WHEN OTHER 002098 MOVE "DSAE124" TO H-FEHLER 002099 GO TO FDSAE120-EXIT 002100 END-EVALUATE 002110 ELSE 003199 IF OP-DSTBF 003201 IF E12-VSTR = "BA" OR "BB" OR "BC" OR "BG" 003203 GO TO FDSAE120-EXIT 003204 ELSE 003205 MOVE "DSAE132" TO H-FEHLER 003207 GO TO FDSAE120-EXIT 003212 END-IF 003213 END-IF 003214 END-IF 003215 END-IF 003223 . 003224 003225 003230 FDSAE120-EXIT. 003300 EXIT. 024211*COPY CDSAE140 REPLACING ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSAE140 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001601** PROGRAMMIERER : MICHAEL KLEMKE 001602** ERSTELLUNGSDATUM : 17.04.2002 001603** VERSION : 002 001604** FUNKTION : ERWEITERUNG DER BETRIEBSNUMMERN 001610**---------------------------------------------------------------- 001620** PROGRAMMIERER : MICHAEL KLEMKE 001630** ERSTELLUNGSDATUM : 20.10.2003 001640** VERSION : 003 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ERSTELLUNGSDATUM : 11.10.2006 001690** VERSION : 004 / VERSION 56 001691**---------------------------------------------------------------- 001700 FDSAE140 SECTION. 001710 FDSAE140E. 001800 IF E12-BBNRVU EQUAL SPACE 002330 MOVE "DSAE142" TO H-FEHLER 002340 GO TO FDSAE140-EXIT 002500 ELSE 002510 IF E12-BBNRVU-NUM-1-8 NOT NUMERIC 002600 MOVE "DSAE142" TO H-FEHLER 002800 GO TO FDSAE140-EXIT 002900 ELSE 002910** ------------------------------------------------------ 002920** VERSION 27 VOM 17.04.2002 002921** ------------------------------------------------------ 003000** (:S11:-BBNRVU-NUM(1:3) >= "010" AND <= "099") OR 003010 IF (E12-BBNRVU-NUM(1:3) >= "001" AND <= "099") OR 003100 (E12-BBNRVU-NUM(1:3) > 110) 003101 MOVE E12-BBNRVU-NUM-1-7 TO ZIFFER-TABELLE 003102 MOVE 0 TO HILFSFELD 003103 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 7 003104 COMPUTE QUERSUMME = ZIFFER(I) * FAKTOR(I) 003105 END-COMPUTE 003106 COMPUTE HILFSFELD = HILFSFELD + QUERSUMME-1 003107 + QUERSUMME-2 003108 END-COMPUTE 003109 END-PERFORM 003110 DIVIDE 10 INTO HILFSFELD GIVING ERG REMAINDER REST 003111 COMPUTE RESTB = REST + 5 END-COMPUTE 003112 IF E12-BBNRVU-NUM-8 = REST OR 003113 E12-BBNRVU-NUM-8 = RESTBR2 THEN 003114** ------------------------------------------------ 003115** ÄNDERUNG VOM 20.10.2003 / VERSION 36 003116** ------------------------------------------------ 003117 IF E12-BBNRVU-NUM-1-8 = 15000002 OR 003118 33333330 OR 003119 80000008 OR 003120 80000031 OR 003121 99999993 003122 MOVE "DSAE141" TO H-FEHLER 003123 GO TO FDSAE140-EXIT 003124 END-IF 003125** ------------------------------------------------ 003126 ELSE 003127 MOVE "DSAE142" TO H-FEHLER 003128 GO TO FDSAE140-EXIT 003129 END-IF 003131 ELSE 003140 MOVE "DSAE142" TO H-FEHLER 003150 GO TO FDSAE140-EXIT 003160 END-IF 003170 END-IF 003180 END-IF 003181** ------------------------------------------------------------- 003182** T52231 003190** ------------------------------------------------------------- 003203 IF OP-BWTRV THEN 003204 IF E12-BBNRVU = "32349289" THEN 003220 GO TO FDSAE140-EXIT 003230 ELSE 003240 MOVE "DSAE146" TO H-FEHLER 003251 GO TO FDSAE140-EXIT 003252 END-IF 003253 END-IF 003254 IF OP-BZTRV THEN 003255 IF E12-BBNRVU = "38065304" THEN 003256 GO TO FDSAE140-EXIT 003257 ELSE 003258 MOVE "DSAE148" TO H-FEHLER 003259 GO TO FDSAE140-EXIT 003260 END-IF 003266 END-IF 003267** ------------------------------------------------------------- 003268** T52232 003269** ------------------------------------------------------------- 003270 IF OP-PVTRV THEN 003271 IF E12-BBNRVU(1:3) = "996" THEN 003272 GO TO FDSAE140-EXIT 003273 ELSE 003274 MOVE "DSAE150" TO H-FEHLER 003275 GO TO FDSAE140-EXIT 003276 END-IF 003277 END-IF 003278** ------------------------------------------------------------- 003279** T52233 003280** ------------------------------------------------------------- 003284 IF OP-KSTRV OR OP-KSTKV THEN 003285 IF E12-BBNRVU = "01085914" OR "28180427" THEN 003286 GO TO FDSAE140-EXIT 003287 ELSE 003288 MOVE "DSAE154" TO H-FEHLER 003289 GO TO FDSAE140-EXIT 003290 END-IF 003291 END-IF 003292** ------------------------------------------------------------- 003293** T52234 003294** ------------------------------------------------------------- 003304 IF OP-AGDEU OR OP-WLTKV 003311 IF E12-VSTR = "0C" OR "0G" 003312 IF E12-BBNRVU(1:3) = "098" OR "980" 003313 GO TO FDSAE140-EXIT 003314 ELSE 003315 MOVE "DSAE143" TO H-FEHLER 003316 GO TO FDSAE140-EXIT 003317 END-IF 003318 ELSE 003319 GO TO FDSAE140-EXIT 003320 END-IF 003322 END-IF 003342** ------------------------------------------------------------- 003343** T52236 003344** ------------------------------------------------------------- 003345 IF OP-UETBF THEN 003346 IF E12-BBNRVU = "98503184" 003347 OR E12-BBNRVU = "98702232" 003348 GO TO FDSAE140-EXIT 003349 ELSE 003350 MOVE "DSAE158" TO H-FEHLER 003351 GO TO FDSAE140-EXIT 003352 END-IF 003353 END-IF 003354** ------------------------------------------------------------- 003355** ÄNDERUNG VOM 20.10.2003 / VERSION 36 003356** ------------------------------------------------------------- 003357** T52237 003358** ------------------------------------------------------------- 003359 IF OP-ZFTRV THEN 003360 IF E12-BBNRVU = "02998824" 003361 GO TO FDSAE140-EXIT 003362 ELSE 003363 MOVE "DSAE155" TO H-FEHLER 003364 GO TO FDSAE140-EXIT 003365 END-IF 003366 ELSE 003367 IF OP-RVTZF THEN 003368 IF E12-BBNRVU NOT = "90209055" 003369 MOVE "DSAE159" TO H-FEHLER 003370 GO TO FDSAE140-EXIT 003371 END-IF 003372 END-IF 003373 END-IF 003374** ------------------------------------------------------------- 003375 . 003376 003377 003380 FDSAE140-EXIT. 003400 EXIT. 024220*COPY CDSAE160 REPLACING ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSAE160 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001620** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001630** ÄNDERUNG : 001 VOM 21.03.2001 VERSION 23 001640**---------------------------------------------------------------- 001650** PROGRAMMIERER : MICHAEL KLEMKE 001660** ÄNDERUNG : 002 VOM 08.06.2004 VERSION 40 001670**---------------------------------------------------------------- 001700 FDSAE160 SECTION. 001701 FDSAE160E. 001710 IF OP-BATRV THEN 001711 IF E12-AZ-VU-NUM1 NUMERIC AND 001712 E12-AZ-VU-NUM2 GROSSBUCHSTABE AND 001713 E12-AZ-VU-NUM3 NUMERIC THEN 001714 IF E12-AZ-VU-NUM1 = 0 OR 001715 E12-AZ-VU-NUM3 = 0 THEN 001716 MOVE "DSAE160" TO H-FEHLER 001717 END-IF 001718 ELSE 001719 MOVE "DSAE160" TO H-FEHLER 001720 END-IF 001721 END-IF 001722 001800 . 003310 FDSAE160-EXIT. 003400 EXIT. 024230*COPY CDSAE400 REPLACING ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSAE400 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 10.02.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : PRüFUNG KZ FüR DB-EUROPäISCHE VSNR 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 22.10.2003 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** AENDERUNGSDATUM : 18.05.2004 VERSION 40 001680** VERSION : 003 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** AENDERUNGSDATUM : 12.10.2004 VERSION 41 001693** VERSION : 004 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** AENDERUNGSDATUM : 07.12.2004 VERSION 42 001697** VERSION : 005 001698**---------------------------------------------------------------- 001699** PROGRAMMIERER : MICHAEL KLEMKE 001700** AENDERUNGSDATUM : 14.07.2006 VERSION 55 001701** VERSION : 006 001702**---------------------------------------------------------------- 001703** PROGRAMMIERER : MICHAEL KLEMKE 001704** AENDERUNGSDATUM : 11.10.2006 VERSION 56 001705** VERSION : 007 001706**---------------------------------------------------------------- 001707 FDSAE400 SECTION. 001710 FDSAE400E. 001711** ------------------------------------------------------------- 001712** T5251 001713** ------------------------------------------------------------- 001714 IF E12-RESERVE NOT = " " THEN 001715 MOVE "DSAE390" TO H-FEHLER 001716 PERFORM FEHLER 001717 END-IF 001720 001721** ------------------------------------------------------------- 001722** T5252 001723** ------------------------------------------------------------- 001800 IF E12-MMAZ NOT = "J" AND NOT = "N" THEN 001810 MOVE "DSAE400" TO H-FEHLER 001811 PERFORM FEHLER 001830 END-IF 001831 IF E12-MMEZ NOT = "J" AND NOT = "N" THEN 001832 MOVE "DSAE410" TO H-FEHLER 001833 PERFORM FEHLER 001835 END-IF 001838 001840 IF E12-MMAZ = "J" THEN 001850 IF E12-MMEZ = "J" THEN 001860 MOVE "DSAE402" TO H-FEHLER 001861 PERFORM FEHLER 001880 END-IF 001890 END-IF 002000 IF E12-MMAZ = "N" THEN 002100 IF E12-MMEZ = "N" THEN 002300 MOVE "DSAE412" TO H-FEHLER 002310 PERFORM FEHLER 002700 END-IF 002800 END-IF 002810 002811** ------------------------------------------------------------- 002812** T5253 002830** ------------------------------------------------------------- 002840 IF OP-CODE = "KTTRV" OR "SOTBF" OR "UETBF" 002900 IF E12-MMAZ = "N" THEN 003317 CONTINUE 003318 ELSE 003319 MOVE "DSAE406" TO H-FEHLER 003320 PERFORM FEHLER 003340 END-IF 003350 END-IF 003352 003353** ------------------------------------------------------------- 003354** T5254 003355** ------------------------------------------------------------- 003356 IF OP-CODE = "KTTRV" OR "SOTBF" OR "UETBF" 003500 IF E12-MMEZ = "J" THEN 003600 CONTINUE 003700 ELSE 004800 MOVE "DSAE416" TO H-FEHLER 004810 PERFORM FEHLER 005300 END-IF 005400 END-IF 005401 005402** ------------------------------------------------------------- 005403** T5255 005404** ------------------------------------------------------------- 005405 IF E12-RESERVE-2 NOT = " " AND NOT = "W " 005406 MOVE "DSAE420" TO H-FEHLER 005407 PERFORM FEHLER 005408 END-IF 005409 005410** ------------------------------------------------------------- 005411** T5256 005412** ------------------------------------------------------------- 005413 IF E12-KENNZUE = " " OR "1" OR "2" OR 005414 "3" OR "4" OR "5" OR "6" OR "7" OR "8" 005415 OR "9" 005416 IF E12-KENNZUE = "1" OR "2" OR 005417 "3" OR "4" OR "5" OR "6" OR "7" 005418 OR "9" 005419 IF OP-CODE = "BATRV" OR "DSTBF" OR "BFTDS" THEN 005420 CONTINUE 005421 ELSE 005422 MOVE "DSAE362" TO H-FEHLER 005423 PERFORM FEHLER 005424 END-IF 005425 ELSE 005426 IF OP-CODE = "BATRV" 005427 MOVE "DSAE362" TO H-FEHLER 005428 PERFORM FEHLER 005429 ELSE 005430** ---------------------------------------------------- 005431** T52562 005432** ---------------------------------------------------- 005433 IF E12-KENNZUE = "8" 005434 IF OP-CODE = "KTTRV" OR "DSTBF" OR 005435 "RVTKT" OR "BFTDS" THEN 005436 CONTINUE 005437 ELSE 005438 MOVE "DSAE365" TO H-FEHLER 005439 PERFORM FEHLER 005440 END-IF 005441 ELSE 005442 IF OP-CODE = "KTTRV" 005443 MOVE "DSAE365" TO H-FEHLER 005444 PERFORM FEHLER 005445 END-IF 005446 END-IF 005447 END-IF 005448 END-IF 005449 ELSE 005450 MOVE "DSAE360" TO H-FEHLER 005451 PERFORM FEHLER 005452 END-IF 005453 005454** ------------------------------------------------------------- 005455** T5257 005456** ------------------------------------------------------------- 005457 IF E12-RESERVE-3 NOT = " " THEN 005458 MOVE "DSAE430" TO H-FEHLER 005459 PERFORM FEHLER 005460 END-IF 005461 005462 . 005463 005464 005465 FDSAE400-EXIT. 005466 EXIT. 005467 005470 024500*COPY CDBME010 REPLACING ==:S0:== BY ==E1== 024510* ==:S1:== BY ==E2==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN STORNIERUNG 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001620** ÄNDERUNG : 001 VOM 15.11.2000 001621** KORREKTUR : 002 VOM 08.01.2001 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 06.12.2001 001670**---------------------------------------------------------------- 001680** PROGRAMMIERER : MICHAEL KLEMKE 001690** ÄNDERUNG : 004 VOM 30.10.2002 001691**---------------------------------------------------------------- 001692** PROGRAMMIERER : MICHAEL KLEMKE 001693** ÄNDERUNG : 005 VOM 22.10.2003 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** ÄNDERUNG : 006 VOM 12.10.2004 / Version 41 001697**---------------------------------------------------------------- 001698** PROGRAMMIERER : MICHAEL KLEMKE 001699** ÄNDERUNG : 007 VOM 13.12.2004 / Version 42 001700**---------------------------------------------------------------- 001701** PROGRAMMIERER : MICHAEL KLEMKE 001702** ÄNDERUNG : 008 VOM 02.06.2005 / Version 46 001703**---------------------------------------------------------------- 001704** PROGRAMMIERER : MICHAEL KLEMKE 001705** ÄNDERUNG : 009 VOM 12.10.2006 / Version 56 001706**---------------------------------------------------------------- 001707** PROGRAMMIERER : MICHAEL KLEMKE 001708** ÄNDERUNG : 010 VOM 23.04.2007 / Version 62 001709**---------------------------------------------------------------- 001710 FDBME010 SECTION. 001711 FDBME010E. 001712 SET T5330101-NOT-AUSF TO TRUE 001800 IF E2-KENNZST = "J" OR "N" THEN 001804 IF E2-KENNZST = "J" THEN 001810 MOVE "N" TO HFELD-P-BBG 001814 ELSE 001818 IF E1-PERSGR = "202" THEN 001819 IF E1-GD = "40" THEN 001820 SET T5330101-AUSF TO TRUE 001821 ELSE 001822 MOVE "DBME012" TO H-FEHLER 001823 END-IF 001824 ELSE 001825 IF E1-GD = "40" 001826 IF E1-PERSGR = "205" 001827 MOVE "DBME013" TO H-FEHLER 001828 END-IF 001829 ELSE 001830 IF E1-GD = "59" 001831 IF E1-PERSGR = "205" 001832 SET T5330101-AUSF TO TRUE 001833 ELSE 001834 MOVE "DBME013" TO H-FEHLER 001837 END-IF 001838 ELSE 001839 IF E1-PERSGR = "205" 001840 MOVE "DBME013" TO H-FEHLER 001841 ELSE 001842 IF E1-GD = "10" AND 001843 E1-KENNZSTA = "1" AND 001844 OP-KVTRV 001845 MOVE "DBME015" TO H-FEHLER 001846 ELSE 001847 SET T5330101-AUSF TO TRUE 001848 END-IF 001849 END-IF 001850 END-IF 001851 END-IF 001852 END-IF 001856** ------------------------------------------------------- 001860 END-IF 002500 ELSE 002600 MOVE "DBME010" TO H-FEHLER 002700 END-IF 002800 IF T5330101-AUSF 002801** ---------------------------------------------------------- 002802** T5330101 002803** ---------------------------------------------------------- 002810 IF E1-KENNZUE = "A" THEN 002820 IF P-DATE < 20050101 THEN 002830 CONTINUE 002840 ELSE 002850 MOVE "DBME017" TO H-FEHLER 002860 PERFORM FEHLER 002900 END-IF 003000 END-IF 003010** ---------------------------------------------------------- 003020** T5330102 003030** ---------------------------------------------------------- 003040 IF E1-SASC = "138" OR "132" 003041 IF E1-GD = "10" OR "11" OR "12" OR "13" 003042 MOVE "DBME018" TO H-FEHLER 003100 END-IF 003110 END-IF 003200 END-IF 003300 . 003301 003302 003310 FDBME010-EXIT. 003400 EXIT. 003500 003600 024600*COPY CDBME020 REPLACING ==:S1:== BY ==E2== 024601* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME020 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN STORNIERUNG 001600**---------------------------------------------------------------- 001601** DATUM : 09.04.2003 001610** VERSION : 002 001620** ÄNDERUNG : ERWEITERTE ABFRAGE AUF KENNZANK 001630**---------------------------------------------------------------- 001640** DATUM : 07.05.2003 001650** VERSION : 003 001660** ÄNDERUNG : ERWEITERTE ABFRAGE AUF KENNZANK 001670**---------------------------------------------------------------- 001671** PROGRAMMIERER : MICHAEL KLEMKE 001680** DATUM : 22.10.2003 001690** VERSION : 004 001692**---------------------------------------------------------------- 001693** PROGRAMMIERER : MICHAEL KLEMKE 001694** DATUM : 20.07.2005 001695** VERSION : 005 / Version-47 001696**---------------------------------------------------------------- 001697** PROGRAMMIERER : MICHAEL KLEMKE 001698** DATUM : 31.10.2005 001699** VERSION : 006 / Version-50 001700**---------------------------------------------------------------- 001701** PROGRAMMIERER : MICHAEL KLEMKE 001702** DATUM : 05.02.2007 001703** VERSION : 007 / Version-59 001704**---------------------------------------------------------------- 001705 FDBME020 SECTION. 001710 FDBME020E. 001711 SET NOT-T53302-01 TO TRUE 001720** ------------------------------------------------------------- 001730** VERSION 33 (13.05.2003) 001740** ------------------------------------------------------------- 001800 IF E2-KENNZGLE = "J" OR "N" OR "0" OR 001810 "1" OR "2" OR " " THEN 001900 IF E2-KENNZGLE = "N" OR "J" THEN 001901** ------------------------------------------------------- 001902** ÄNDERUNG VOM 05.02.2007 / VERSION 59 001903** ------------------------------------------------------- 001904 IF OP-AGDEU OR OP-KVDEU OR OP-KVTRV OR OP-RVTKV 001910** ---------------------------------------------------- 001911** ÄNDERUNG VOM 22.10.2003 / VERSION 36 001912** ---------------------------------------------------- 001914 IF E2-KENNZST = "J" THEN 001915 CONTINUE 001916 ELSE 001917 IF P-DATE < 20070101 THEN 001920 CONTINUE 001930 ELSE 002100 MOVE "DBME022" TO H-FEHLER 002300 END-IF 002310 END-IF 002311 ELSE 002312 SET T53302-01 TO TRUE 002313 END-IF 002320 ELSE 002321 SET T53302-01 TO TRUE 002322 END-IF 002323 IF T53302-01 002324** ------------------------------------------------------- 002325** T5330201 ANFANG 002326** ------------------------------------------------------- 002327 IF E2-KENNZGLE = " " THEN 002328 IF E2-KENNZST = "J" THEN 002329 CONTINUE 002330 ELSE 002331 IF E1-GD = "10" OR "11" OR "12" OR "13" THEN 002332 CONTINUE 002333 ELSE 002334 IF E1-PERSGR-NUM = 207 OR 208 002335 CONTINUE 002336 ELSE 002337 MOVE "DBME021" TO H-FEHLER 002338 END-IF 002339 END-IF 002340 END-IF 002341** ------------------------------------------------------- 002342** T5330201 ENDE 002343** ------------------------------------------------------- 002344 ELSE 002345** ---------------------------------------------------- 002346** T5330202 ANFANG 002347** ---------------------------------------------------- 002348 IF E2-KENNZGLE = "1" OR "2" THEN 002349 IF E1-PERSGR-NUM = 102 OR 103 OR 105 OR 107 OR 002350 109 OR 110 OR 111 OR 141 OR 002351 142 OR 143 OR 202 OR 209 OR 002352 210 OR 002353** ---------------------------- 002354** ÄNDERUNG VOM 22.10.2003 002355** ---------------------------- 002356 203 OR 207 OR 208 OR 301 OR 002357 302 OR 303 OR 304 THEN 002358 MOVE "DBME024" TO H-FEHLER 002359 END-IF 002360 END-IF 002361** ---------------------------------------------------- 002362** T5330202 ENDE 002363** ---------------------------------------------------- 002364 END-IF 002365** ------------------------------------------------------- 002366** T533021 ENDE 002370** ------------------------------------------------------- 002400 END-IF 002500 ELSE 002600 MOVE "DBME020" TO H-FEHLER 002700 END-IF 003300 . 003301 003302 003310 FDBME020-EXIT. 003400 EXIT. 003500 003600 024610*COPY CDBME030 REPLACING ==:S1:== BY ==E2== 024620* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME030 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ZEITRAUMBEGINN 001600**---------------------------------------------------------------- 001700** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001710** ÄNDERUNG : 002 VOM 22.11.2000 1. NACHGANG VERSION 21 001711**---------------------------------------------------------------- 001712** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001713** ÄNDERUNG : 003 VOM 30.04.2001 VERSION 24 001714**---------------------------------------------------------------- 001715** PROGRAMMIERER : MICHAEL KLEMKE 001716** ÄNDERUNG : 004 VOM 13.12.2001 VERSION 26 NACHGANG 03 001717**---------------------------------------------------------------- 001718** PROGRAMMIERER : MICHAEL KLEMKE 001719** ÄNDERUNG : 005 VOM 24.02.2003 VERSION 31 001720**---------------------------------------------------------------- 001721** PROGRAMMIERER : MICHAEL KLEMKE 001722** ÄNDERUNG : 006 VOM 12.03.2003 VERSION 31 NACHGANG 01 001723**---------------------------------------------------------------- 001724** PROGRAMMIERER : MICHAEL KLEMKE 001725** ÄNDERUNG : 007 VOM 13.05.2003 VERSION 33 001726**---------------------------------------------------------------- 001727** PROGRAMMIERER : WERNER MECKELEIN 001728** ÄNDERUNG : 008 VOM 03.06.2003 VERSION 34 001729**---------------------------------------------------------------- 001730** PROGRAMMIERER : MICHAEL KLEMKE 001731** ÄNDERUNG : 009 VOM 23.10.2003 VERSION 36 001732**---------------------------------------------------------------- 001733** PROGRAMMIERER : MICHAEL KLEMKE 001734** ÄNDERUNG : 010 VOM 12.10.2004 VERSION 41 001735**---------------------------------------------------------------- 001736** PROGRAMMIERER : MICHAEL KLEMKE 001737** ÄNDERUNG : 011 VOM 14.12.2004 VERSION 42 001738**---------------------------------------------------------------- 001739** PROGRAMMIERER : MICHAEL KLEMKE 001740** ÄNDERUNG : 012 VOM 03.02.2005 001741** ÄNDERUNG : INITIALISIERUNG GEB-DAT 001742**---------------------------------------------------------------- 001743** PROGRAMMIERER : MICHAEL KLEMKE 001744** ÄNDERUNG : 013 VOM 23.04.2007 001746**---------------------------------------------------------------- 001747 FDBME030 SECTION. 001748 FDBME030E. 001750 IF E2-ZRBG-NUM NUMERIC THEN 001794** ---------------------------------------------------------- 001795** T533031 ANFANG 001796** ---------------------------------------------------------- 001808 DIVIDE 4 INTO E2-ZRBG-JJ GIVING ERG 001809 REMAINDER SCHALTJAHR 001810 IF E2-ZRBG-MM > ZERO AND < 13 001811 AND E2-ZRBG-TT > ZERO 001812 AND <= TGT(SCHALTJAHR + 1, E2-ZRBG-MM) THEN 001813 IF E2-ZRBG-NUM < 19730101 THEN 001814 MOVE "DBME036" TO H-FEHLER 001815 MOVE "N" TO HFELD-P-BBG 001817 ELSE 001818** ---------------------------------------------------- 001819** T533032 AUFRUF 001820** ---------------------------------------------------- 001830 PERFORM T533032 001887 END-IF 001888 ELSE 001889 MOVE "DBME034" TO H-FEHLER 001890 MOVE "N" TO HFELD-P-BBG 001892 END-IF 001893** ---------------------------------------------------------- 001894** T533031 ENDE 001895** ---------------------------------------------------------- 001897 ELSE 001898 MOVE "DBME030" TO H-FEHLER 001899 MOVE "N" TO HFELD-P-BBG 001900 END-IF 001901 . 001902 001903 001904 FDBME030-EXIT. 001905 EXIT. 001906 001907 001908 001912 T533032 SECTION. 001913 T533032E. 001914** ------------------------------------------------------------- 001915** T533032 001916** ------------------------------------------------------------- 001920 IF E1-GD = "00" OR "01" OR "10" OR "11" 001921 OR "12" OR "13" OR "40" THEN 001922 MOVE P-DATE TO HDATUM 001923 IF HDATMM <= 10 THEN 001924 MOVE HDATMM TO MON-ENDE-IND 001925 ADD 2 TO MON-ENDE-IND 001926 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001927 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001928 ELSE 001929 IF HDATMM = 11 THEN 001930 MOVE 1 TO MON-ENDE-IND 001931 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001932 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001933 ADD 1 TO HDATJHJJ 001934 ELSE 001935 MOVE 2 TO MON-ENDE-IND 001936 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001937 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001938 ADD 1 TO HDATJHJJ 001939 END-IF 001940 END-IF 001941 IF E2-ZRBG < HDATUM THEN 001942 PERFORM T533033 001943 ELSE 001944 MOVE "DBME038" TO H-FEHLER 001945 MOVE "N" TO HFELD-P-BBG 001947 END-IF 001948 ELSE 001949 IF E1-GD = "08" OR "70" OR "72" THEN 001950 MOVE P-DATE TO HDATUM 001951 MOVE 12 TO HDATMM 001952 MOVE 31 TO HDATTT 001953 ADD 2 TO HDATJHJJ 001954 IF E2-ZRBG < HDATUM THEN 001955 PERFORM T533033 001956 ELSE 001957 MOVE "DBME042" TO H-FEHLER 001958 MOVE "N" TO HFELD-P-BBG 001960 END-IF 001961 ELSE 001962 MOVE P-DATE TO HDATUM 001963 IF HDATMM <= 11 THEN 001964 MOVE HDATMM TO MON-ENDE-IND 001965 ADD 1 TO MON-ENDE-IND 001966 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001967 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001968 ELSE 001969 IF HDATMM = 12 THEN 001970 MOVE 1 TO MON-ENDE-IND 001971 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001972 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001973 ADD 1 TO HDATJHJJ 001974 END-IF 001975 END-IF 001976 IF E2-ZRBG-NUM < HDATUM THEN 001977 PERFORM T533033 001978 ELSE 001979 MOVE "DBME040" TO H-FEHLER 001980 MOVE "N" TO HFELD-P-BBG 001982 END-IF 001983 END-IF 001984 END-IF 001985 . 001986 001987 001988 T533032-EXIT. 001989 EXIT. 001990 001991 002073 002074 T533033 SECTION. 002075 T533033E. 002076** ------------------------------------------------------------- 002077** T533033 002078** ------------------------------------------------------------- 002079 IF E1-GD = "05" OR "54" OR "55" THEN 002080 IF E2-ZRBG-TT NOT = 01 THEN 002081 MOVE "DBME044" TO H-FEHLER 002082 MOVE "N" TO HFELD-P-BBG 002083 ELSE 002084 PERFORM T5330331 002089 END-IF 002090 ELSE 002091 IF E1-PERSGR = "207" OR "208" THEN 002092 IF E2-ZRBG-NUM < 19950401 THEN 002093 MOVE "DBME046" TO H-FEHLER 002094 MOVE "N" TO HFELD-P-BBG 002096 ELSE 002097 PERFORM T5330331 002129 END-IF 002130 ELSE 002131 IF E1-PERSGR = "201" THEN 002132 IF (E2-ZRBG-NUM < 19970101 OR 002136 E2-ZRBG-NUM > 20030331) AND 002137** ------------------------------------------------- 002138** ÄNDERUNG VOM 12.10.2004 - VERSION 41 002139** ------------------------------------------------- 002140 E2-KENNZST = "N" 002141 MOVE "DBME048" TO H-FEHLER 002142 MOVE "N" TO HFELD-P-BBG 002143 ELSE 002144 PERFORM T5330331 002172 END-IF 002173 ELSE 002174 PERFORM T5330331 002206 END-IF 002207 END-IF 002208 END-IF 002209 . 002210 T533033-EXIT. 002211 EXIT. 002212 002213 002214 T5330331 SECTION. 002215 T5330331E. 002216** ------------------------------------------------------------- 002217** T5330331 002218** ------------------------------------------------------------- 002219 IF E1-GD = "55" OR "56" THEN 002220 IF E2-ZRBG-NUM < 19990101 THEN 002221 MOVE "DBME032" TO H-FEHLER 002222** ------------------------------------------------------- 002223** ÄNDERUNG VOM 23.10.2003 / VERSION 36 002224** ------------------------------------------------------- 002225 MOVE "N" TO HFELD-P-BBG 002226** ------------------------------------------------------- 002227 ELSE 002228 PERFORM T533034 002229 END-IF 002230 ELSE 002231 PERFORM T533034 002232 END-IF 002233 . 002234 002235 002236 T5330331-EXIT. 002237 EXIT. 002238 002239 002240 T533034 SECTION. 002241 T533034E. 002242** ------------------------------------------------------------- 002243** T533034 002244** ------------------------------------------------------------- 002245 IF E1-PERSGR = "120" 002246 IF E2-ZRBG-NUM < 19990101 002247 MOVE "DBME045" TO H-FEHLER 002248 MOVE "N" TO HFELD-P-BBG 002249 ELSE 002250 PERFORM T533035 002251 END-IF 002252 ELSE 002253** ---------------------------------------------------------- 002254** ÄNDERUNG VOM 23.10.2003 / VERSION 36 002255** ---------------------------------------------------------- 002256* IF :S0:-PERSGR = "209" OR "210" THEN 002257 IF E1-PERSGR = "209" OR "210" OR 002258 "109" OR "110" OR "202" THEN 002259** ---------------------------------------------------------- 002260 IF E2-ZRBG-NUM < 19990401 002261 MOVE "DBME041" TO H-FEHLER 002262 MOVE "N" TO HFELD-P-BBG 002263 ELSE 002264 PERFORM T533035 002265 END-IF 002266 ELSE 002267 PERFORM T533035 002268 END-IF 002269 END-IF 002270 . 002271 002272 002273 T533034-EXIT. 002274 EXIT. 002276 002277 002279 T533035 SECTION. 002280 T533035E. 002281** ------------------------------------------------------------- 002282** T533035 002283** ------------------------------------------------------------- 002285 IF OP-AGDEU 002286 MOVE P-DATE TO HDATUM 002287 COMPUTE HDATJHJJ = HDATJHJJ - 5 002288 IF E2-ZRBG < HDATUM THEN 002289 MOVE "DBMEH10" TO H-FEHLER 002290 PERFORM FEHLER 002292 END-IF 002295 END-IF 002296** ------------------------------------------------------------- 002297** T533036 002298** ------------------------------------------------------------- 002299 IF HFELD-P-GBDT = "N" 002300 PERFORM T533037 002301 ELSE 002303 IF E1-PERSGR = "301" OR "302" THEN 002304 MOVE SIC-GEB TO HFELD-GEB 002305 COMPUTE HFELD-GEB-JHJJ = HFELD-GEB-JHJJ + 17 002306 IF E2-ZRBG < HFELD-GEB 002307 MOVE "DBME047" TO H-FEHLER 002308 MOVE "N" TO HFELD-P-BBG 002309 ELSE 002310 PERFORM T533037 002311 END-IF 002312 ELSE 002313 IF E1-PERSGR = "303" OR "304" THEN 002314 MOVE SIC-GEB TO HFELD-GEB 002315 COMPUTE HFELD-GEB-JHJJ = HFELD-GEB-JHJJ + 16 002316 IF E2-ZRBG < HFELD-GEB 002317 MOVE "DBME035" TO H-FEHLER 002318 MOVE "N" TO HFELD-P-BBG 002319 ELSE 002320 PERFORM T533037 002321 END-IF 002322 ELSE 002323 PERFORM T533037 002324 END-IF 003300 END-IF 003600 END-IF 003700 . 003800 T533036-EXIT. 003900 EXIT. 003910 003920 004000 T533037 SECTION. 004100 T533037E. 004110** ------------------------------------------------------------- 004120** T533037 004130** ------------------------------------------------------------- 004200 IF E1-KENNZUE = "A" THEN 004300 IF E2-ZRBG-NUM < 20000101 THEN 004310 PERFORM T533038 004500 ELSE 004600 MOVE "DBME043" TO H-FEHLER 004800 END-IF 004810 ELSE 004820 PERFORM T533038 005800 END-IF 005900 . 006000 T533037-EXIT. 006100 EXIT. 006110 006120 006200 T533038 SECTION. 006300 T533038E. 006310** ------------------------------------------------------------- 006320** T533038 006330** ------------------------------------------------------------- 006400 IF E1-PERSGR-NUM = 109 OR 110 OR 202 OR 209 OR 210 THEN 006500 IF E2-ZRBG-NUM < 20030401 THEN 006510 CONTINUE 006520 ELSE 006600 IF E1-MMKS = "J" 006800 MOVE "DBME029" TO H-FEHLER 006900 PERFORM FEHLER 006901 END-IF 007000 END-IF 007200 END-IF 007901* ------------------------------------------------------------- 007902* T533039 007903* ------------------------------------------------------------- 007912 IF E1-VSNR = " " 007913 IF E1-GD-NUM = 40 008100 IF E2-ZRBG-NUM > 20030331 THEN 008110 CONTINUE 008120 ELSE 008200 MOVE "DBME049" TO H-FEHLER 008300 PERFORM FEHLER 009502 END-IF 009503 END-IF 009510 END-IF 009513* ------------------------------------------------------------- 009520* T5330310 ANFANG 009530* ------------------------------------------------------------- 009540* IF :S1:-KENNZGLE = "0" OR "1" OR "2" THEN 009541 IF E2-KENNZGLE = "1" OR "2" THEN 009542 IF E2-KENNZST NOT = "J" THEN 009543 IF E2-ZRBG-NUM > 20021231 THEN 009550 CONTINUE 009560 ELSE 009561 MOVE "DBME039" TO H-FEHLER 009562 PERFORM FEHLER 009563 END-IF 009564 END-IF 009565 END-IF 009567* ------------------------------------------------------------- 009568* T5330311 ANFANG 009569* ------------------------------------------------------------- 009570 IF E1-PERSGR-NUM = 304 THEN 009571 IF E2-ZRBG-NUM > 20020731 THEN 009572 CONTINUE 009573 ELSE 009590 MOVE "DBME051" TO H-FEHLER 009591 PERFORM FEHLER 009592 END-IF 009593 END-IF 009594* ------------------------------------------------------------- 009595* T5330312 ANFANG 009596* ------------------------------------------------------------- 009597 SET NOT-DBME05X-VOR TO TRUE 009598 IF E2-KENNZST NOT = "J" THEN 009599 IF E1-PERSGR-NUM = 103 OR 142 THEN 009600 IF E2-ZRBG-NUM < 19890101 THEN 009601 MOVE "DBME053" TO H-FEHLER 009602 PERFORM FEHLER 009603 SET DBME05X-VOR TO TRUE 009604 END-IF 009605 MOVE SIC-GEB TO HFELD-GEB 009606 COMPUTE HFELD-GEB-JHJJ = HFELD-GEB-JHJJ + 55 009607 IF E2-ZRBG < HFELD-GEB 009608 MOVE "DBME055" TO H-FEHLER 009609 PERFORM FEHLER 009610 SET DBME05X-VOR TO TRUE 009611 END-IF 009612 END-IF 009613 END-IF 009614 IF NOT-DBME05X-VOR 009615* ---------------------------------------------------------- 009616* T5330313 ANFANG 009617* ---------------------------------------------------------- 009618 IF E2-KENNZST = "N" AND 009619 E2-ZRBG-NUM < 20050101 AND 009621 E1-GD = "10" AND 009622 E1-KENNZSTA NOT = " " 009623 MOVE "DBME028" TO H-FEHLER 009624 PERFORM FEHLER 009625 ELSE 009626* ------------------------------------------------------- 009627* T53303-14 ANFANG 009629* ------------------------------------------------------- 009630 IF E2-KENNZST = "N" AND 009631 E2-ZRBG-NUM > 20041231 AND 009632 E1-VSTR = "0B" 009633 MOVE "DBME031" TO H-FEHLER 009634 PERFORM FEHLER 009639 END-IF 009640* ------------------------------------------------------- 009641* T53303-14 ENDE 009642* ------------------------------------------------------- 009643 END-IF 009644 END-IF 009645 009646 009647 009648 . 009649 009650 009700 T533038-EXIT. 009800 EXIT. 009900 010000 024700*COPY CDBME050 REPLACING ==:S1:== BY ==E2== 024701* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME050 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ZEITRAUMENDE 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001620** ÄNDERUNG : 001 VOM 15.11.2000 001621**---------------------------------------------------------------- 001622** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001623** ÄNDERUNG : 002 VOM 30.04.2001 VERSION 24 001624**---------------------------------------------------------------- 001625** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001626** ÄNDERUNG : 003 VOM 15.05.2001 VERSION 24 NACHGANG 01 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 004 VOM 28.06.2001 VERSION 25 001651** H-FEHLER AUF SPACES (KORREKTUR) 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ÄNDERUNG : 005 VOM 24.02.2003 VERSION 31 001691**---------------------------------------------------------------- 001692** PROGRAMMIERER : MICHAEL KLEMKE 001693** ÄNDERUNG : 006 VOM 12.03.2003 VERSION 31 NACHGANG 01 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** ÄNDERUNG : 007 VOM 13.05.2003 VERSION 33 001697**---------------------------------------------------------------- 001698** PROGRAMMIERER : MICHAEL KLEMKE 001699** ÄNDERUNG : 008 VOM 23.10.2003 VERSION 36 001700**---------------------------------------------------------------- 001701** PROGRAMMIERER : MICHAEL KLEMKE 001702** ÄNDERUNG : 009 VOM 13.10.2004 VERSION 41 001703**---------------------------------------------------------------- 001704 FDBME050 SECTION. 001705 FDBME050E. 001706** ------------------------------------------------------------- 001707** T53304 001708** ------------------------------------------------------------- 001709 IF E2-ZREN-NUM NOT NUMERIC THEN 001710 MOVE "DBME050" TO H-FEHLER 001711 PERFORM FEHLER 001712 MOVE "N" TO HFELD-P-BBG 001713 ELSE 001714 IF E1-GD = "00" OR "01" OR "10" OR "11" OR "12" OR "13" 001715 IF E2-ZREN-NUM = ZERO THEN 001716** ---------------------------------------------------- 001717** ÄNDERUNG VOM 23.10.2003 / VERSION 36 001718** ---------------------------------------------------- 001719 MOVE "N" TO HFELD-P-BBG 001720 ELSE 001721 MOVE "N" TO HFELD-P-BBG 001722 MOVE "DBME054" TO H-FEHLER 001723 PERFORM FEHLER 001724 END-IF 001725 ELSE 001726 IF E2-ZREN-NUM = ZERO THEN 001727 MOVE "N" TO HFELD-P-BBG 001728 MOVE "DBME052" TO H-FEHLER 001729 PERFORM FEHLER 001731 ELSE 001732 DIVIDE 4 INTO E2-ZREN-JJ GIVING ERG 001733 REMAINDER SCHALTJAHR 001734 IF E2-ZREN-MM > ZERO AND < 13 001735 AND E2-ZREN-TT > ZERO 001736 AND <= TGT(SCHALTJAHR + 1, E2-ZREN-MM) THEN 001737* ----------------------------------------------- 001738* T533041 ANFANG 001739* ----------------------------------------------- 001740 IF E2-ZRBG-NUM NOT NUMERIC OR 001741 E2-ZRBG-NUM EQUAL ZERO 001742 MOVE "N" TO HFELD-P-BBG 001743 PERFORM T533042 001744 ELSE 001745 IF E2-ZREN-NUM >= 001746 E2-ZRBG-NUM THEN 001748* ----------------------------------------- 001749** ÄNDERUNG VOM 23.10.2003 / VERSION 36 001750* ----------------------------------------- 001751 IF E2-ZREN(1:4) = E2-ZRBG(1:4) 001752 PERFORM T533042 001753 ELSE 001754 MOVE "N" TO HFELD-P-BBG 001755 MOVE "DBME057" TO H-FEHLER 001756 PERFORM FEHLER 001757 END-IF 001758 ELSE 001759 MOVE "N" TO HFELD-P-BBG 001760 MOVE "DBME056" TO H-FEHLER 001761 PERFORM FEHLER 001762 END-IF 001765 END-IF 001766* ----------------------------------------------- 001767* T533041 ENDE 001768* ----------------------------------------------- 001769 ELSE 001770 MOVE "N" TO HFELD-P-BBG 001771 MOVE "DBME052" TO H-FEHLER 001772 PERFORM FEHLER 001774 END-IF 001775 END-IF 001776 END-IF 001777 END-IF 001778 . 001779 FDBME050-EXIT. 001780 EXIT. 001781 001782 001783 T533042 SECTION. 001784 T533042E. 001785** ------------------------------------------------------------- 001786** T533042 001787** ------------------------------------------------------------- 001788 IF E1-GD = "08" OR "70" OR "72" THEN 001789 MOVE P-DATE TO HDATUM 001790 MOVE 12 TO HDATMM 001791 MOVE 31 TO HDATTT 001792 ADD 2 TO HDATJHJJ 001793 IF E2-ZREN-NUM <= HDATUM THEN 001794 PERFORM T533043 001795 ELSE 001796 MOVE "N" TO HFELD-P-BBG 001797 MOVE "DBME058" TO H-FEHLER 001798 PERFORM FEHLER 001801 END-IF 001802 ELSE 001803 MOVE P-DATE TO HDATUM 001804 IF HDATMM <= 11 THEN 001805 MOVE HDATMM TO MON-ENDE-IND 001806 ADD 1 TO MON-ENDE-IND 001807 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001808 DIVIDE 4 INTO HDATJHJJ GIVING ERG 001809 REMAINDER SCHALTJAHR 001810 IF MON-ENDE-IND = 2 AND SCHALTJAHR = 0 001811 MOVE 29 TO HDATTT 001812 ELSE 001813 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001814 END-IF 001815 ELSE 001816 IF HDATMM = 12 THEN 001817 MOVE 1 TO MON-ENDE-IND 001818 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 001819 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 001820 ADD 1 TO HDATJHJJ 001821 END-IF 001822 END-IF 001823 IF E2-ZREN-NUM > HDATUM THEN 001824 MOVE "N" TO HFELD-P-BBG 001825 MOVE "DBME059" TO H-FEHLER 001826 PERFORM FEHLER 001829 ELSE 001830 IF E1-GD = "09" OR "49" THEN 001831 IF E2-ZREN-NUM < P-DATE 001832 PERFORM T533043 001833 ELSE 001834 MOVE "N" TO HFELD-P-BBG 001835 MOVE "DBME060" TO H-FEHLER 001836 PERFORM FEHLER 001839 END-IF 001840 ELSE 001841 PERFORM T533043 001842 END-IF 001843 END-IF 001844 END-IF 001845 . 001846 T533042-EXIT. 001847 EXIT. 001848 001849 001850 T533043 SECTION. 001851 T533043E. 001852** ------------------------------------------------------------- 001853** T533043 001854** ------------------------------------------------------------- 001855 IF E1-GD = "50" OR "70" THEN 001856 IF E1-BBNRVU = "01085914" OR "28180427" 001857 CONTINUE 001858 ELSE 001859 IF E2-ZREN-MM = 12 AND 001860 E2-ZREN-TT = 31 THEN 001861 CONTINUE 001862 ELSE 001863 MOVE "N" TO HFELD-P-BBG 001864 MOVE "DBME061" TO H-FEHLER 001865 PERFORM FEHLER 001867 GO TO T533043-EXIT 001868 END-IF 001869 END-IF 001870 END-IF 001872** ------------------------------------------------------------- 001873** T533044 001874** ------------------------------------------------------------- 001876 IF E1-GD = "05" OR "54" OR "55" THEN 001877 IF E2-ZREN-MM NOT = E2-ZRBG-MM THEN 001878 MOVE "N" TO HFELD-P-BBG 001879 MOVE "DBME062" TO H-FEHLER 001880 PERFORM FEHLER 001883 ELSE 001884 DIVIDE 4 INTO E2-ZREN-JJ GIVING ERG 001885 REMAINDER SCHALTJAHR 001886 IF E2-ZREN-TT NOT = 001887 TGT(SCHALTJAHR + 1, E2-ZREN-MM) THEN 001888 MOVE "N" TO HFELD-P-BBG 001889 MOVE "DBME063" TO H-FEHLER 001890 PERFORM FEHLER 001893 ELSE 001894 PERFORM T533045 001895 END-IF 001896 END-IF 001897 ELSE 001898 PERFORM T533045 001899 END-IF 001900 . 001901 T533043-EXIT. 001902 EXIT. 001903 001904 004800 T533045 SECTION. 004900 T533045E. 004910** ------------------------------------------------------------- 004920** T533045 004930** ------------------------------------------------------------- 004940 IF E2-ZREN-NUM > 19990331 OR 004950 E2-ZREN-NUM = ZERO AND 004960 E2-ZRBG-NUM IS NUMERIC AND 004970 E2-ZRBG-NUM > 19990331 THEN 004971 IF E1-PERSGR = "110" OR "202" OR "210" THEN 004972 IF E1-GD = "50" OR "51" OR "52" OR "53" OR "54" THEN 004975 MOVE "DBME065" TO H-FEHLER 004976 PERFORM FEHLER 004977 ELSE 004978 PERFORM T533046 004979 END-IF 004980 ELSE 004981 PERFORM T533046 004982 END-IF 004983 ELSE 004984 PERFORM T533046 004985 END-IF 004986 . 004987 T533045-EXIT. 004988 EXIT. 004989 004990 004991 T533046 SECTION. 004992 T533046E. 004993** ------------------------------------------------------------- 004994** T533046 004995** ------------------------------------------------------------- 004996 IF E1-KENNZUE = "A" THEN 004997 IF E2-ZREN-NUM < 20000101 THEN 004998** ------------------------------------------------------- 004999** 13.05.2003 VERSION-33 005000** ------------------------------------------------------- 005001 PERFORM T533047 005002 ELSE 005003 MOVE "DBME068" TO H-FEHLER 005004 PERFORM FEHLER 005005 END-IF 005006 ELSE 005007** ---------------------------------------------------------- 005008** 13.05.2003 VERSION-33 005009** ---------------------------------------------------------- 005010 PERFORM T533047 005011 END-IF 005012 . 005013 T533046-EXIT. 005014 EXIT. 005015 005016 005017 005021 T533047 SECTION. 005022 T533047E. 005023** ------------------------------------------------------------- 005024** T533047 005025** ------------------------------------------------------------- 005026 IF E1-PERSGR = "201" THEN 005027 IF E2-ZREN-NUM > 20030331 AND 005028 E2-KENNZST = "N" 005029 MOVE "N" TO HFELD-P-BBG 005030 MOVE "DBME037" TO H-FEHLER 005031 PERFORM FEHLER 005032 ELSE 005033 PERFORM T533048 005034 END-IF 005035 ELSE 005036 PERFORM T533048 005037 END-IF 005038 . 005041 T533047-EXIT. 005042 EXIT. 005043 005044 005045 005046 T533048 SECTION. 005047 T533048E. 005048** ------------------------------------------------------------- 005049** T533048 005050** ------------------------------------------------------------- 005051 IF E1-PERSGR = "109" OR "110" OR "202" OR 005052 "209" OR "210" THEN 005053 IF E2-ZREN-NUM > 20030331 THEN 005054 IF E1-MMKS = "J" 005055 MOVE "DBME033" TO H-FEHLER 005056 PERFORM FEHLER 005057 ELSE 005058 PERFORM T533049 005059 END-IF 005060 ELSE 005061 PERFORM T533049 005062 END-IF 005063 ELSE 005064 PERFORM T533049 005065 END-IF 005069 . 005070 T533048-EXIT. 005071 EXIT. 005072 005073 005074 005075 005080 010214 T533049 SECTION. 010220 T533049E. 010221** ------------------------------------------------------------- 010222** T533049 010223** ------------------------------------------------------------- 010224 IF E2-KENNZGLE = "1" OR "2" THEN 010225 IF E2-KENNZST NOT = "J" THEN 010226 IF E2-ZREN-NUM > 20030331 THEN 010227 CONTINUE 010228 ELSE 010229 MOVE "DBME069" TO H-FEHLER 010230 PERFORM FEHLER 010231 END-IF 010232 END-IF 010233 END-IF 010300** ------------------------------------------------------------- 010400** T5330410 010500** ------------------------------------------------------------- 010510 IF E1-PERSGR = "304" 010800 IF E2-ZREN-NUM > 20041231 THEN 011100 MOVE "DBME064" TO H-FEHLER 011200 PERFORM FEHLER 011400 END-IF 011500 END-IF 011600 . 011601 011602 011610 T533049-EXIT. 011800 EXIT. 011900 012000 024710*COPY CDBME070 REPLACING ==:S1:== BY ==E2== 024720* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME070 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ANZAHL DER TAGE 001600**---------------------------------------------------------------- 001700 FDBME070 SECTION. 001800 FDBME070E. 003000 IF E2-ZLTG-NUM NOT NUMERIC THEN 003100 MOVE "DBME070" TO H-FEHLER 003200 GO TO FDBME070-EXIT 003210 ELSE 003220 IF E1-PERSGR = "202" THEN 003230 IF E2-ZLTG-NUM >= 1 AND <= 6 THEN 003240 GO TO FDBME070-EXIT 003250 ELSE 003260 MOVE "DBME074" TO H-FEHLER 003270 GO TO FDBME070-EXIT 003280 END-IF 003290 ELSE 003291 IF E2-ZLTG-NUM NOT = 0 003292 MOVE "DBME072" TO H-FEHLER 003293 END-IF 003294 END-IF 003295 END-IF 003300 . 003310 FDBME070-EXIT. 003400 EXIT. 024800*COPY CDBME080 REPLACING ==:S1:== BY ==E2==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME080 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG WäHRUNGSKENNZEICHEN 001600**---------------------------------------------------------------- 001700 FDBME080 SECTION. 001710 FDBME080E. 001720 IF E2-WG NOT = "D" AND NOT = "E" AND NOT = " " THEN 001730 MOVE "N" TO HFELD-P-BBG 001740 MOVE "DBME082" TO H-FEHLER 001750 ELSE 001760 IF E2-ZRBG-NUM NOT NUMERIC THEN 001770 GO TO FDBME080-EXIT 001780 ELSE 001790 IF E2-ZREN-NUM NOT NUMERIC THEN 001791 GO TO FDBME080-EXIT 001792 ELSE 001793 IF E2-WG = "D" THEN 001794 IF (E2-ZRBG-NUM EQUAL ZERO 001795 AND E2-ZREN-NUM > 20011231) OR 001796 E2-ZRBG-NUM > 20011231 THEN 001797 MOVE "DBME086" TO H-FEHLER 001798 MOVE "N" TO HFELD-P-BBG 001799 GO TO FDBME080-EXIT 001800 ELSE 001806 GO TO FDBME080-EXIT 001807 END-IF 001808 ELSE 001809 IF E2-WG = "E" THEN 001810 IF (E2-ZRBG-NUM EQUAL ZERO AND 001811 E2-ZREN-NUM < 19990101) OR 001812 (E2-ZRBG-NUM > ZERO AND E2-ZRBG-NUM 001813 < 19990101) THEN 001814 MOVE "DBME084" TO H-FEHLER 001815 MOVE "N" TO HFELD-P-BBG 001816 GO TO FDBME080-EXIT 001817 ELSE 001818 GO TO FDBME080-EXIT 001826 END-IF 001827 ELSE 001828 GO TO FDBME080-EXIT 001830 END-IF 001831 END-IF 001832 END-IF 001833 END-IF 001834 END-IF 001835 . 001836 FDBME080-EXIT. 001840 EXIT. 024900*COPY CDBME090 REPLACING ==:S1:== BY ==E2== 024910* ==:S0:== BY ==E1==. 000110**---------------------------------------------------------------- 000120** COPY-MEMBER : CDBME090 000130** PROGRAMMIERER : WERNER KRAUS 000140** ERSTELLUNGSDATUM : 23.03.1998 000150** VERSION : 1.05 000160** FUNKTION : FEHLERPRüFUNG ENTGELD 000170**---------------------------------------------------------------- 000180** PROGRAMMIERER : GERTRAUD SCHUHMACHER 000190** ÄNDERUNG : 001 VOM 15.11.2000 000191**---------------------------------------------------------------- 000192** PROGRAMMIERER : GERTRAUD SCHUHMACHER 000193** ÄNDERUNG : 002 VOM 30.04.2001 VERSION 24 000194**---------------------------------------------------------------- 000195** PROGRAMMIERER : GERTRAUD SCHUHMACHER 000196** ÄNDERUNG : 003 VOM 15.05.2001 VERSION 24 NACHGANG 01 000197**---------------------------------------------------------------- 000198** PROGRAMMIERER : MICHAEL KLEMKE 000199** ÄNDERUNG : 004 VOM 13.11.2001 VERSION 26 000200**---------------------------------------------------------------- 000201** PROGRAMMIERER : MICHAEL KLEMKE 000202** ÄNDERUNG : 005 VOM 20.03.2002 VERSION 27 000203**---------------------------------------------------------------- 000204** PROGRAMMIERER : MICHAEL KLEMKE 000205** ÄNDERUNG : 006 VOM 30.10.2002 VERSION 29 000206**---------------------------------------------------------------- 000207** PROGRAMMIERER : MICHAEL KLEMKE 000208** ÄNDERUNG : 007 VOM 24.10.2003 VERSION 36 000209**---------------------------------------------------------------- 000210** PROGRAMMIERER : MICHAEL KLEMKE 000211** ÄNDERUNG : 008 VOM 18.05.2004 VERSION 40 000212**---------------------------------------------------------------- 000213 FDBME090 SECTION. 000214 FDBME090E. 000215 IF E2-EG-NUM NUMERIC THEN 000216 IF E2-EG-NUM > 0 THEN 000217 IF E1-GD = "55" THEN 000218 MOVE "N" TO HFELD-P-BBG 000219 ELSE 000220** ---------------------------------------------------- 000221** AUFRUF T533071 000222** ---------------------------------------------------- 000223 PERFORM T533071 000224 END-IF 000225 ELSE 000226 MOVE "N" TO HFELD-P-BBG 000227** ------------------------------------------------------- 000228** AUFRUF T533074 000229** ------------------------------------------------------- 000230 PERFORM T533074 000231 END-IF 000232 ELSE 000233 MOVE "N" TO HFELD-P-BBG 000234 MOVE "DBME090" TO H-FEHLER 000235 END-IF 000236 . 000237 FDBME090-EXIT. 000238 EXIT. 000239 000240 000241 000242 T533071 SECTION. 000243 T533071E. 000244** ------------------------------------------------------------- 000245** T533071 000246** ------------------------------------------------------------- 000247 IF E1-PERSGR = "302" THEN 000248 IF E2-ZREN-NUM < 19900101 THEN 000249 MOVE "N" TO HFELD-P-BBG 000250 MOVE "DBME091" TO H-FEHLER 000251 ELSE 000252** ------------------------------------------------------- 000253** AUFRUF T533072 000254** ------------------------------------------------------- 000255 PERFORM T533072 000256 END-IF 000257 ELSE 000258** ---------------------------------------------------------- 000259** AUFRUF T533072 000260** ---------------------------------------------------------- 000261 PERFORM T533072 000262 END-IF 000263 . 000264 T533071-EXIT. 000265 EXIT. 000266 000267 000268 000269 T533072 SECTION. 000270 T533072E. 000271** ------------------------------------------------------------- 000272** T533072 000273** ------------------------------------------------------------- 000274 IF E1-GD = "00" OR "01" OR "10" OR "11" OR 000275 "12" OR "13" OR "94" OR "95" THEN 000276 MOVE "DBME092" TO H-FEHLER 000277 MOVE "N" TO HFELD-P-BBG 000278 ELSE 000279 IF E1-PERSGR = "110" OR "202" OR "210" OR 000280 "301" OR "303" OR "304" THEN 000281 MOVE "DBME092" TO H-FEHLER 000282 MOVE "N" TO HFELD-P-BBG 000283 ELSE 000284 IF E2-WG EQUAL SPACE THEN 000285 MOVE "DBME095" TO H-FEHLER 000286 MOVE "N" TO HFELD-P-BBG 000287 ELSE 000288** ---------------------------------------------------- 000289** AUFRUF T533073 000290** ---------------------------------------------------- 000291 PERFORM T533073 000292 END-IF 000293 END-IF 000294 END-IF 000295 . 000296 T533072-EXIT. 000297 EXIT. 000298 000299 000300 000301 T533073 SECTION. 000302 T533073E. 000303** ------------------------------------------------------------- 000304** T533073 000305** ------------------------------------------------------------- 000306 IF E2-EG-NUM = 1 THEN 000307 IF OP-AGDEU OR OP-WLTKV OR OP-KVTWL THEN 000308 CONTINUE 000309 ELSE 000310 IF E2-KENNZST NOT = "J" THEN 000311 MOVE "DBME097" TO H-FEHLER 000312 MOVE "N" TO HFELD-P-BBG 000313 END-IF 000314 END-IF 000315 END-IF 000316 . 000317 T533073-EXIT. 000318 EXIT. 000319 000320 000321 T533074 SECTION. 000322 T533074E. 000323** ------------------------------------------------------------- 000324** T533074 000325** ------------------------------------------------------------- 000326 IF E1-GD = "03" OR "05" OR 000327 "50" OR "51" OR "52" OR "53" OR "54" OR 000328 "59" OR "70" THEN 000329 IF E1-PERSGR = "110" OR "120" OR "202" OR 000330 "203" OR "210" THEN 000331 CONTINUE 000332 ELSE 000333 IF E1-PERSGR = "140" AND E1-SASC NOT = "000" 000334 CONTINUE 000335 ELSE 000338 IF E1-GD = "51" OR "52" OR "53" THEN 000339 IF E2-ZRBG(5:2) = E2-ZREN(5:2) THEN 000340 CONTINUE 000341 ELSE 000342 MOVE "DBME093" TO H-FEHLER 000343 END-IF 000344 ELSE 000345 MOVE "DBME094" TO H-FEHLER 000346 END-IF 000347 END-IF 000348 END-IF 000349 END-IF 000350 . 000351 T533074-EXIT. 000352 EXIT. 000353 000354 000360 025000*COPY CDBME110 REPLACING ==:S1:== BY ==E2== 025010* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME110 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 001300** FUNKTION : FEHLERPRüFUNG BEITRAGSGRUPPE 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001620** ÄNDERUNG : 001 VOM 15.11.2000 001621**---------------------------------------------------------------- 001622** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001623** ÄNDERUNG : 002 VOM 30.04.2001 VERSION 24 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 16.04.2002 VERSION 27 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ÄNDERUNG : 004 VOM 31.10.2002 VERSION 29 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ÄNDERUNG : 005 VOM 03.02.2003 VERSION 30 001693**---------------------------------------------------------------- 001694** PROGRAMMIERER : MICHAEL KLEMKE 001695** ÄNDERUNG : 006 VOM 06.02.2003 VERSION 30 NACHGANG 01 001696**---------------------------------------------------------------- 001697** PROGRAMMIERER : MICHAEL KLEMKE 001698** ÄNDERUNG : 007 VOM 12.03.2003 VERSION 31 NACHGANG 01 001699**---------------------------------------------------------------- 001700** PROGRAMMIERER : MICHAEL KLEMKE 001701** ÄNDERUNG : 008 VOM 17.07.2003 VERSION 35 001702**---------------------------------------------------------------- 001703** PROGRAMMIERER : MICHAEL KLEMKE 001704** ÄNDERUNG : 009 VOM 24.10.2003 VERSION 36 001705**---------------------------------------------------------------- 001706** PROGRAMMIERER : MICHAEL KLEMKE 001707** ÄNDERUNG : 010 VOM 18.05.2004 VERSION 40 001708**---------------------------------------------------------------- 001709** PROGRAMMIERER : MICHAEL KLEMKE 001710** ÄNDERUNG : 011 VOM 14.10.2004 VERSION 41 001711**---------------------------------------------------------------- 001712** PROGRAMMIERER : MICHAEL KLEMKE 001713** ÄNDERUNG : 012 VOM 08.12.2004 VERSION 42 001714**---------------------------------------------------------------- 001715** PROGRAMMIERER : MICHAEL KLEMKE 001716** ÄNDERUNG : 013 VOM 03.02.2005 001717** : INITIALISIERUNG GEB-DAT 001718**---------------------------------------------------------------- 001719** PROGRAMMIERER : MICHAEL KLEMKE 001720** ÄNDERUNG : 014 VOM 07.02.2005 001722**---------------------------------------------------------------- 001723** PROGRAMMIERER : MICHAEL KLEMKE 001724** ÄNDERUNG : 015 VOM 13.04.2005 001725**---------------------------------------------------------------- 001726** PROGRAMMIERER : MICHAEL KLEMKE 001727** ÄNDERUNG : 016 VOM 30.10.2006 VERSION 56 001728**---------------------------------------------------------------- 001729** PROGRAMMIERER : MICHAEL KLEMKE 001730** ÄNDERUNG : 017 VOM 13.03.2007 VERSION 61 001731**---------------------------------------------------------------- 001740 FDBME110 SECTION. 001800 FDBME110E. 001900 IF E2-BYGR-NUM NUMERIC THEN 001910 IF (E2-BYGR-NUM-1 >= 0 AND <= 6 OR = 9) AND 001920 (E2-BYGR-NUM-2 >= 0 AND <= 6 OR = 9) AND 001930 (E2-BYGR-NUM-3 >= 0 AND <= 2 OR = 9) AND 001940 (E2-BYGR-NUM-4 >= 0 AND <= 2 OR = 9) THEN 001941 IF E1-KENNZUE NOT = "A" THEN 001942 IF E1-PERSGR(1:1) = "1" 001943** ------------------------------------------------- 001944** VERSION-29 (31.10.2002) 001945** ------------------------------------------------- 001946 IF E2-KENNZST = "J" THEN 001947 PERFORM T533081 001948 ELSE 001952** ---------------------------------------------- 001953** KOMBINATION PERSGR / BYGR PRUEFEN 001954** ---------------------------------------------- 001956 SET BYGR-PERSGR-OK TO TRUE 001957 PERFORM VARYING IX FROM 1 BY 1 UNTIL IX > 22 001958 OR E1-PERSGR-NUM = TAB-PERSGR(IX) 001959 CONTINUE 001960 END-PERFORM 001962 IF IX < 23 001963** ------------------------------------------- 001964** DURCHLAUFEN DER 4 BEITRAGSGRUPPEN 001965** NUR WENN PERSGR GEFUNDEN 001966** ------------------------------------------- 001967 PERFORM VARYING L FROM 1 BY 1 UNTIL L > 4 001968 OR BYGR-PERSGR-NOK 001969 SET BYGR-PERSGR-NOK TO TRUE 001970** ---------------------------------------- 001971** VERGLEICH DER ZUL.WERTE DER BEITRAGSGR. 001972** ---------------------------------------- 001973 PERFORM VARYING M FROM 1 BY 1 001974 UNTIL M > 10 OR BYGR-PERSGR-OK 001976 IF TAB-BYGR(IX, L, M) = E2-BYGR(L:1) 001977 SET BYGR-PERSGR-OK TO TRUE 001978 END-IF 001979 END-PERFORM 001980 END-PERFORM 001981* ELSE 001982* SET BYGR-PERSGR-NOK TO TRUE 001983 END-IF 001984 IF BYGR-PERSGR-OK 001985 PERFORM T533081 001986 ELSE 001987** ------------------------------------------- 001988** VERSION 29 NACHGANG 01 001989** ------------------------------------------- 001990** PERFORM T533081 001991 MOVE "DBME108" TO H-FEHLER 001992 PERFORM FEHLER 001993 END-IF 001994 END-IF 001995 ELSE 001996 PERFORM T533081 001997 END-IF 001998 ELSE 001999 PERFORM T533081 002000 END-IF 002001 ELSE 002002 MOVE "DBME111" TO H-FEHLER 002010 PERFORM FEHLER 002100 END-IF 002300 ELSE 002400 MOVE "DBME110" TO H-FEHLER 002500 PERFORM FEHLER 007800 END-IF 007900 . 007910 007920 008000 FDBME110-EXIT. 008100 EXIT. 008110 008111 008112 008113 T533081 SECTION. 008114 T533081E. 008115** ------------------------------------------------------------- 008116** TABELLE 533081 008117** ------------------------------------------------------------- 008118 IF E2-BYGR-NUM-2 = 9 008119 IF E1-GD = "00" OR "01" OR "10" OR "13" 008120** IF :S0:-KENNZUE = "A" OR "K" THEN 008121 IF E1-KENNZUE = "A" THEN 008122 PERFORM T533082 008123 ELSE 008124 MOVE "DBME113" TO H-FEHLER 008125 PERFORM FEHLER 008127 END-IF 008128 ELSE 008129 MOVE "DBME113" TO H-FEHLER 008130 PERFORM FEHLER 008132 END-IF 008133 ELSE 008134 IF E2-BYGR-NUM-3 = 9 OR E2-BYGR-NUM-4 = 9 008135 MOVE E1-GD TO GDDBME-TAB 008136 IF NOT GDDBME-OK THEN 008137 MOVE "DBME112" TO H-FEHLER 008138 PERFORM FEHLER 008140 ELSE 008141* IF :S0:-KENNZUE = "A" OR "K" THEN 008142 IF E1-KENNZUE = "A" THEN 008143 PERFORM T533082 008144 ELSE 008145 MOVE "DBME112" TO H-FEHLER 008146 PERFORM FEHLER 008148 END-IF 008149 END-IF 008150 ELSE 008151 PERFORM T533082 008152 END-IF 008153 END-IF 008154 . 008155** ------------------------------------------------------------- 008156** ENDE TABELLE 533081 008157** ------------------------------------------------------------- 008158 T533081-EXIT. 008159 EXIT. 008160 008161 008170 008200 T533082 SECTION. 008300 T533082E. 008310** ------------------------------------------------------------- 008320** TABELLE 533082 008330** ------------------------------------------------------------- 008400 IF E1-VSTR = "0A" OR "0C" OR "AC" OR "BA" OR "BC" THEN 008500 IF E2-BYGR-NUM-2 NOT = 0 AND NOT = 1 AND 008600 NOT = 3 AND NOT = 5 AND NOT = 9 THEN 008700 MOVE "DBME130" TO H-FEHLER 008800 PERFORM FEHLER 008900 END-IF 009000 END-IF 009100 IF E1-VSTR = "0B" OR "0G" OR "AB" OR "AG" OR "BB" OR 009200 "BG" THEN 009300 IF E2-BYGR-NUM-2 NOT = 0 AND NOT = 2 AND NOT = 4 009400 AND NOT = 6 AND NOT = 9 THEN 009500 MOVE "DBME132" TO H-FEHLER 009600 PERFORM FEHLER 009700 END-IF 009800 END-IF 009900 IF E2-BYGR-NUM-1 = 5 THEN 010000 IF (E2-ZRBG-NUM IS NUMERIC AND E2-ZRBG-NUM > ZERO AND 010100 E2-ZRBG-NUM < 19950101) OR (E2-ZREN-NUM IS NUMERIC 010200 AND E2-ZREN-NUM > ZERO AND E2-ZREN-NUM < 19950101) 010300 MOVE "DBME122" TO H-FEHLER 010400 PERFORM FEHLER 010500 END-IF 010600 END-IF 010700 IF E2-BYGR-NUM-4 = 1 OR 2 THEN 010800 IF (E2-ZRBG-NUM IS NUMERIC AND E2-ZRBG-NUM > ZERO AND 010900 E2-ZRBG-NUM < 19950101) OR (E2-ZREN-NUM IS NUMERIC 011000 AND E2-ZREN-NUM > ZERO AND E2-ZREN-NUM < 19950101) 011100 MOVE "DBME124" TO H-FEHLER 011200 PERFORM FEHLER 011300 END-IF 011400 END-IF 011401** ------------------------------------------------------------- 011402** 533082a 011403** ------------------------------------------------------------- 011410 IF E2-BYGR = "0000" THEN 011411 IF E1-PERSGR = "106" 011412 PERFORM T533083 011420 ELSE 011421 IF E1-PERSGR = "110" OR "202" OR "210" OR "304" THEN 011422 PERFORM T533083 011423 ELSE 011424 IF E1-PERSGR = "140" AND 011425 E1-SASC NOT = "000" THEN 011426 PERFORM T533083 011492 ELSE 011499 IF E1-PERSGR = "205" AND 011500 E2-KENNZST = "J" THEN 011501 PERFORM T533083 011503 ELSE 011504 MOVE "DBME107" TO H-FEHLER 011505 PERFORM FEHLER 011507 END-IF 011508 END-IF 011509 END-IF 011510 END-IF 011511 ELSE 011512 IF E1-PERSGR = "110" OR "202" OR "210" OR "304" THEN 011513 MOVE "DBME114" TO H-FEHLER 011514 PERFORM FEHLER 011515 ELSE 011516 PERFORM T533083 011517 END-IF 011518 END-IF 011519 . 011520** ------------------------------------------------------------- 011521** ENDE TABELLE 533082 011522** ------------------------------------------------------------- 011523 T533082-EXIT. 011524 EXIT. 011525 011527 011528 011529 T533083 SECTION. 011530 T533083E. 011534** ------------------------------------------------------------- 011535** 533083 ANFANG 011536** ------------------------------------------------------------- 011540 IF E2-BYGR-NUM-2 = 5 OR 6 THEN 011600 IF E1-PERSGR = "109" OR "209" THEN 011601 CONTINUE 011602 ELSE 011603 MOVE "DBME115" TO H-FEHLER 011604 PERFORM FEHLER 011605 END-IF 011606 END-IF 011607** ------------------------------------------------------------- 011608** 533083 ENDE 011609** ------------------------------------------------------------- 011610** 533085 ANFANG 011611** ------------------------------------------------------------- 011612 IF HFELD-P-GBDT = "N" THEN 011613 CONTINUE 011614 ELSE 011615 IF E2-ZRBG-NUM NOT NUMERIC 011616 CONTINUE 011617 ELSE 011618 IF E2-ZREN-NUM NOT NUMERIC THEN 011619 CONTINUE 011620 ELSE 011621 MOVE SIC-GEB TO HFELD-GEB 011622 IF E2-BYGR-NUM-3 = 1 THEN 011623** ------------------------------------------------- 011624** T533086a - ANFANG 011625** ------------------------------------------------- 011626 IF E1-GD = "00" OR "01" OR "10" OR "11" 011627 OR "12" OR "13" OR "40" THEN 011628 IF HFELD-GEB-TT = 01 THEN 011629** ------------------------------------------- 011631 COMPUTE HFELD-GEB-JHJJ = 011632 HFELD-GEB-JHJJ + 64 END-COMPUTE 011633 IF HFELD-GEB-MM = 01 011634 COMPUTE HFELD-GEB-MM = HFELD-GEB-MM 011635 + 11 END-COMPUTE 011636 ELSE 011637 COMPUTE HFELD-GEB-MM = HFELD-GEB-MM 011638 - 1 END-COMPUTE 011639 COMPUTE HFELD-GEB-JHJJ = 011640 HFELD-GEB-JHJJ + 1 END-COMPUTE 011641 END-IF 011642 ELSE 011643 COMPUTE HFELD-GEB-JHJJ = 011644 HFELD-GEB-JHJJ + 65 011645 END-COMPUTE 011646 END-IF 011647 IF E2-ZRBG-JHJJMM <= HFELD-GEB-JHJJMM 011648 CONTINUE 011649 ELSE 011650 MOVE "DBME126" TO H-FEHLER 011651 PERFORM FEHLER 011652 END-IF 011653 ELSE 011654 IF HFELD-GEB-TT = 01 THEN 011655 COMPUTE HFELD-GEB-JHJJ = 011656 HFELD-GEB-JHJJ + 64 END-COMPUTE 011657 IF HFELD-GEB-MM = 01 011658 COMPUTE HFELD-GEB-MM = HFELD-GEB-MM 011659 + 11 END-COMPUTE 011660 ELSE 011661 COMPUTE HFELD-GEB-MM = HFELD-GEB-MM 011662 - 1 END-COMPUTE 011663 COMPUTE HFELD-GEB-JHJJ = 011664 HFELD-GEB-JHJJ + 1 END-COMPUTE 011665 END-IF 011666 ELSE 011667 COMPUTE HFELD-GEB-JHJJ = 011668 HFELD-GEB-JHJJ + 65 011669 END-COMPUTE 011670 END-IF 011671 IF E2-ZREN-JHJJMM <= HFELD-GEB-JHJJMM 011672 CONTINUE 011673 ELSE 011674 MOVE "DBME126" TO H-FEHLER 011675 PERFORM FEHLER 011676 END-IF 011677 END-IF 011678** ------------------------------------------------- 011679** T533086a - ENDE 011680** ------------------------------------------------- 011681 ELSE 011682 IF E2-BYGR-NUM-3 = 2 THEN 011684** ---------------------------------------------- 011685** T533086b - ANFANG 011686** ---------------------------------------------- 011687 IF E2-KENNZST NOT = "J" 011700 COMPUTE HFELD-GEB-JHJJ = 011701 HFELD-GEB-JHJJ + 55 011704 IF E2-ZRBG-NUM < HFELD-GEB 011705 MOVE "DBME128" TO H-FEHLER 011706 PERFORM FEHLER 011707 END-IF 011708 END-IF 011730** ---------------------------------------------- 011731** T533086b - ENDE 011732** ---------------------------------------------- 011733 END-IF 011734 END-IF 011735 END-IF 011736 END-IF 011737 END-IF 011738** ------------------------------------------------------------- 011739** 533085 ENDE 011740** ------------------------------------------------------------- 025420** T533087 ANFANG 025430** ------------------------------------------------------------- 025500 IF E1-PERSGR = "108" THEN 025600 IF (E2-BYGR-NUM-1 = 0 OR 3 OR 4 OR 9) AND 025700 (E2-BYGR-NUM-2 = 0 OR 1 OR 2 OR 9) AND 025800 (E2-BYGR-NUM-3 = 0 OR 9) AND 025900 (E2-BYGR-NUM-4 = 0 OR 1 OR 2 OR 9) THEN 026000** ------------------------------------------------------- 026001** AUFRUF T533087a 026002** ------------------------------------------------------- 026010 PERFORM T533087a 026100 ELSE 026200 MOVE "DBME116" TO H-FEHLER 026300 PERFORM FEHLER 026500 END-IF 026600 ELSE 026700 IF E1-PERSGR = "116" THEN 026800 IF (E2-BYGR-NUM-1 = 0 OR 3 OR 9) AND 026900 (E2-BYGR-NUM-2 = 0 OR 1 OR 2 OR 9) AND 027000 (E2-BYGR-NUM-3 = 0 OR 9) AND 027100 (E2-BYGR-NUM-4 = 0 OR 1 OR 2 OR 9) THEN 027110** ---------------------------------------------------- 027120** AUFRUF T533087a 027130** ---------------------------------------------------- 027200 PERFORM T533087a 027300 ELSE 027400 MOVE "DBME118" TO H-FEHLER 027500 PERFORM FEHLER 027700 END-IF 027701 ELSE 027702** ------------------------------------------------------- 027703** AUFRUF T533087a 027704** ------------------------------------------------------- 027710 PERFORM T533087a 027800 END-IF 027801 END-IF 027802** ------------------------------------------------------------- 027803** T533087 ENDE 027804** ------------------------------------------------------------- 027805 . 027809 T533083-EXIT. 027810 EXIT. 027811 027812 027813 027814 T533087a SECTION. 027815 T533087aE. 027816** ------------------------------------------------------------- 027817** 533087a ANFANG 027818** ------------------------------------------------------------- 027824 IF E1-PERSGR = "109" OR "209" THEN 027825** ---------------------------------------------------------- 027826** ÄNDERUNG VOM 17.07.2003 / VERSION 35 027827** ---------------------------------------------------------- 027828 IF E2-BYGR-NUM-3 = 0 OR 1 OR 2 THEN 027830 CONTINUE 027840 ELSE 027850 MOVE "DBME119" TO H-FEHLER 027860 PERFORM FEHLER 027870 END-IF 027880 END-IF 027890** ------------------------------------------------------------- 027891** T533087a ENDE 027892** ------------------------------------------------------------- 027893** T533088 ANFANG 027894** ------------------------------------------------------------- 027900 IF E1-PERSGR = "205" THEN 028000 IF E2-BYGR-NUM-2 = 0 OR 1 OR 2 OR 028010 3 OR 4 OR 9 THEN 028040** ------------------------------------------------------- 028060 PERFORM T533089 028200 ELSE 028300 MOVE "DBME134" TO H-FEHLER 028400 PERFORM FEHLER 028600 END-IF 028700 ELSE 028800 IF E1-PERSGR = "119" THEN 028900 IF E2-BYGR-NUM-2 = 3 OR 4 OR 9 THEN 028910 PERFORM T533089 029100 ELSE 029200 MOVE "DBME120" TO H-FEHLER 029300 PERFORM FEHLER 029500 END-IF 029510 ELSE 029520 PERFORM T533089 029600 END-IF 029601 END-IF 029602** ------------------------------------------------------------- 029603** T533088 ENDE 029604** ------------------------------------------------------------- 029605 . 029610 T533088-EXIT. 029620 EXIT. 029621 029622 029623 029624 T533089 SECTION. 029625 T533089E. 029626** ------------------------------------------------------------- 029627** 533089 ANFANG 029628** ------------------------------------------------------------- 029629 IF E1-PERSGR = "203" THEN 029630 IF OP-KSTRV 029631 IF E2-ZRBG-NUM < 20050101 029632 IF E2-ZREN-NUM < 20050101 029633 IF E2-BYGR = "0200" THEN 029634 PERFORM T5330810 029635 ELSE 029636 MOVE "DBME136" TO H-FEHLER 029637 PERFORM FEHLER 029639 END-IF 029640 END-IF 029641 ELSE 029642 IF E2-BYGR = "0200" THEN 029643 MOVE "DBME139" TO H-FEHLER 029644 PERFORM FEHLER 029645 ELSE 029647 IF E2-BYGR = "0100" THEN 029648 PERFORM T5330810 029650 ELSE 029651 MOVE "DBME139" TO H-FEHLER 029652 PERFORM FEHLER 029655 END-IF 029656 END-IF 029657 END-IF 029669 ELSE 029670** ------------------------------------------------------- 029671** 533089a 029672** ------------------------------------------------------- 029673 IF OP-KSTKV 029674 IF E2-BYGR(1:3) = "100" OR "200" OR "300" THEN 029675** ------------------------------------------------- 029676** AUFRUF T5330810 029677** ------------------------------------------------- 029678 PERFORM T5330810 029679 ELSE 029680 MOVE "DBME137" TO H-FEHLER 029681 PERFORM FEHLER 029682 END-IF 029683 ELSE 029684** ---------------------------------------------------- 029685** AUFRUF T5330810 029686** ---------------------------------------------------- 029687 PERFORM T5330810 029688 END-IF 029689 END-IF 029690 ELSE 029691** ---------------------------------------------------------- 029692** AUFRUF T5330810 029693** ---------------------------------------------------------- 029694 PERFORM T5330810 029695 END-IF 029696** ------------------------------------------------------------- 029697** T533089 ENDE 029698** ------------------------------------------------------------- 029699 . 029700 T533089-EXIT. 029701 EXIT. 029702 029703 029710 029800 029900 T5330810 SECTION. 030000 T5330810E. 030100** ------------------------------------------------------------- 030200** 5330810 ANFANG 030300** ------------------------------------------------------------- 030400 IF E1-PERSGR = "207" OR "208" 030600 IF E2-BYGR = "0100" OR "0200" THEN 030610** ------------------------------------------------------- 030620** AUFRUF T5330811 030630** ------------------------------------------------------- 030700 PERFORM T5330811 030800 ELSE 030900 MOVE "DBME138" TO H-FEHLER 031000 PERFORM FEHLER 031100 END-IF 031200 ELSE 031210** ---------------------------------------------------------- 031220** AUFRUF T5330811 031230** ---------------------------------------------------------- 031300 PERFORM T5330811 031400 END-IF 032006** ------------------------------------------------------------- 032007** T5330810 ENDE 032008** ------------------------------------------------------------- 032009 . 032010 T5330810-EXIT. 032011 EXIT. 032012 032013 033600 033610 T5330811 SECTION. 033620 T5330811E. 033630** ------------------------------------------------------------- 033640** TABELLE 5330811 033650** ------------------------------------------------------------- 033660 IF E2-KENNZST = "J" THEN 033670 PERFORM T5330815 033800 ELSE 033810 IF E2-ZRBG-NUM > 20030331 THEN 033820 PERFORM T5330812 033900 ELSE 033910 IF E2-ZREN-NUM > 20030331 THEN 033920 PERFORM T5330812 034000 ELSE 034001 PERFORM T5330815 034002 END-IF 034010 END-IF 034020 END-IF 034100 . 034310 T5330811-EXIT. 034320 EXIT. 034330 034340 034350 034360 T5330812 SECTION. 034370 T5330812E. 034380** ------------------------------------------------------------- 034390** TABELLE 5330812 034391** ------------------------------------------------------------- 034392 IF E1-PERSGR = "110" OR "202" OR "210" THEN 034400 IF E1-BBNRKK-NUM-1-8 = "98000006" OR "98094032" THEN 034410 CONTINUE 034411 ELSE 034412 MOVE "DBME133" TO H-FEHLER 034413 PERFORM FEHLER 034415 END-IF 034420 ELSE 034421** ---------------------------------------------------------- 034422** PAUSCHALBEITRÄGE ZUR KV 034423** ---------------------------------------------------------- 034430 IF E2-BYGR-NUM-1 = 6 034431 IF E1-BBNRKK-NUM-1-8 = "98000006" OR "98094032" 034432 CONTINUE 034433 ELSE 034434 MOVE "DBME133" TO H-FEHLER 034435 PERFORM FEHLER 034436 END-IF 034440 ELSE 034441** ------------------------------------------------------- 034442** PAUSCHALBEITRÄGE ZUR RV 034443** ------------------------------------------------------- 034444 IF E2-BYGR-NUM-2 = 5 OR 6 034445 IF E1-BBNRKK-NUM-1-8 = "98000006" OR "98094032" 034446 CONTINUE 034447 ELSE 034448 MOVE "DBME133" TO H-FEHLER 034449 PERFORM FEHLER 034450 END-IF 034451 ELSE 034452** ---------------------------------------------------- 034453** MELDUNG FÜR GERINGFÜGIG ENTLOHNTE BESCHÄFTIGTE 034454** ---------------------------------------------------- 034455 IF E1-PERSGR = "109" OR "209" 034456 IF E2-BYGR-NUM-2 = 1 OR 2 034457 IF E1-BBNRKK-NUM-1-8 = "98000006" OR 034458 "98094032" 034459 CONTINUE 034460 ELSE 034461 MOVE "DBME133" TO H-FEHLER 034462 PERFORM FEHLER 034463 END-IF 034464 END-IF 034465 END-IF 034466 END-IF 034467 END-IF 034468 END-IF 034469** ------------------------------------------------------------- 034470** 13.05.2003 VERSION-33 034471** ------------------------------------------------------------- 034472** T5330813 ANFANG 034473** ------------------------------------------------------------- 034474 IF E2-ZRBG-NUM > 20041231 THEN 034475 IF E2-BYGR-NUM-2 = 2 OR 4 OR 6 THEN 034476 MOVE "DBME106" TO H-FEHLER 034477 PERFORM FEHLER 034478 ELSE 034479 PERFORM T5330814 034486 END-IF 034487 ELSE 034488 PERFORM T5330814 034497 END-IF 034504** ------------------------------------------------------------- 034505** T5330813 ENDE 034506** ------------------------------------------------------------- 034507 . 034508 T5330812-EXIT. 034509 EXIT. 034510 034600 034610 034700 T5330814 SECTION. 034800 T5330814E. 034810 IF E2-KENNZGLE = "1" OR "2" THEN 034820 IF E2-BYGR-NUM-2 = 5 OR 6 THEN 034830 MOVE "DBME109" TO H-FEHLER 034840 PERFORM FEHLER 034851 ELSE 034852 PERFORM T5330815 034853 END-IF 034854 ELSE 034855 PERFORM T5330815 034860 END-IF 034900** ------------------------------------------------------------- 035100** T5330814 ENDE 035200** ------------------------------------------------------------- 035300 . 035400 T5330814-EXIT. 035500 EXIT. 035510 035520 035600 T5330815 SECTION. 035700 T5330815E. 035710 IF E1-PERSGR = "301" OR "302" OR "303" 035711 IF E2-BYGR = "0100" OR "0110" OR "0200" THEN 035712** ------------------------------------------------------- 035713** T5330816 035714** ------------------------------------------------------- 035715 IF E2-ZRBG-NUM > 20061231 THEN 035716 IF E2-BYGR = "0100" 035731 MOVE "DBME117" TO H-FEHLER 035732 PERFORM FEHLER 035743 END-IF 035744 ELSE 035745 IF E2-ZRBG-NUM < 20060201 THEN 035746 IF E2-BYGR = "0110" 035747 MOVE "DBME121" TO H-FEHLER 035748 PERFORM FEHLER 035749 END-IF 035752 END-IF 035753 END-IF 035754** ------------------------------------------------------- 035755** T5330816 ENDE 035756** ------------------------------------------------------- 035760 ELSE 036000 MOVE "DBME135" TO H-FEHLER 036100 PERFORM FEHLER 036200 END-IF 036300 END-IF 036400** ------------------------------------------------------------- 036500** T5330815 ENDE 036600** ------------------------------------------------------------- 036700 . 036710 036720 036800 T5330815-EXIT. 036900 EXIT. 025100*COPY CDBME140 REPLACING ==:S1:== BY ==E2== 025110* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME140 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG TäTIGKEITSSCHLüSSEL 001400**---------------------------------------------------------------- 001500** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001510** ÄNDERUNG : 001 VOM 30.04.2001 VERSION 24 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄNDERUNG : 002 VOM 24.10.2003 VERSION 36 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 08.12.2004 VERSION 42 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ÄNDERUNG : 004 VOM 28.02.2007 VERSION 60 001690**---------------------------------------------------------------- 001700 FDBME140 SECTION. 001710 FDBME140E. 001711 IF OP-AGDEU AND 001712 E1-MMKS = "J" AND 001713 (E1-PERSGR NOT = "140" AND NOT = "141" AND 001715 NOT = "142" AND NOT = "143" AND 001716 NOT = "149" ) 001717** ---------------------------------------------------------- 001718** AENDERUNG VOM 28.02.2007 001719** ---------------------------------------------------------- 001720 OR 001721 (E1-BBNRVU(1:3) = "098" OR "980") 001722** ---------------------------------------------------------- 001725 GO TO FDBME140-EXIT 001726 END-IF 001727 IF E2-TTSC(1:3) = "996" OR "999" THEN 001728* IF :S0:-KENNZUE = "A" OR "K" THEN 001729 IF E1-KENNZUE NOT = "A" THEN 001730 MOVE "DBME141" TO H-FEHLER 001731 GO TO FDBME140-EXIT 001732 ELSE 001733 IF E2-TTSC(4:1) < 0 OR > 9 THEN 001734 MOVE "DBME148" TO H-FEHLER 001735 GO TO FDBME140-EXIT 001736 ELSE 001737 IF E2-TTSC(5:1) < 1 OR > 7 AND NOT = 9 001738 MOVE "DBME150" TO H-FEHLER 001739 GO TO FDBME140-EXIT 001740 ELSE 001750 IF E2-TTSC(6:3) NOT = " " THEN 001760 MOVE "DBME152" TO H-FEHLER 001770 GO TO FDBME140-EXIT 001771 ELSE 001772 GO TO FDBME140-EXIT 001780 END-IF 001790 END-IF 001791 END-IF 001795 END-IF 001796 ELSE 001797* -------------------------------------------------------- 001798* ÄNDERUNG VOM 24.10.2003 / VERSION 36 001799* -------------------------------------------------------- 001800* IF :S0:-PERSGR = "205" OR "301" OR "302" OR "303" 001900 IF E1-PERSGR = "205" OR "301" OR 001910 "302" OR "303" OR "304" THEN 002000 IF E2-TTSC = " " THEN 002200 GO TO FDBME140-EXIT 002300 ELSE 002310 MOVE "DBME140" TO H-FEHLER 002400 GO TO FDBME140-EXIT 002500 END-IF 002600 ELSE 002700 IF E2-TTSC(1:5) = "88880" THEN 002800 IF E2-TTSC(6:3) = " " THEN 002810 GO TO FDBME140-EXIT 002820 ELSE 002830 MOVE "DBME152" TO H-FEHLER 002840 GO TO FDBME140-EXIT 002850 END-IF 002860 ELSE 002870 MOVE E2-TTSC(1:3) TO TTSC-TAB 002880 IF NOT TTSC-OK THEN 002890 MOVE "DBME146" TO H-FEHLER 002891 GO TO FDBME140-EXIT 002892 ELSE 002893 IF E2-TTSC(4:1) < 0 OR > 9 002894 MOVE "DBME148" TO H-FEHLER 002895 GO TO FDBME140-EXIT 002896 END-IF 002897 IF E2-TTSC(5:1) < 1 OR > 7 002898 MOVE "DBME150" TO H-FEHLER 002899 GO TO FDBME140-EXIT 002900 END-IF 002901 IF E2-TTSC(6:3) NOT = " " 002902 MOVE "DBME152" TO H-FEHLER 002903 GO TO FDBME140-EXIT 002904 END-IF 002910 IF OP-KSTRV OR OP-KSTKV THEN 003000 IF E2-TTSC(1:5) = "99147" 003100 GO TO FDBME140-EXIT 003200 ELSE 003300 MOVE "DBME143" TO H-FEHLER 003310 GO TO FDBME140-EXIT 003320 END-IF 003330 END-IF 003369 END-IF 003370 END-IF 003372 END-IF 003373 END-IF 003374 . 003380 FDBME140-EXIT. 003400 EXIT. 025200*COPY CDBME160 REPLACING ==:S1:== BY ==E2== 025210* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME160 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN RECHTSKREIS 001400**---------------------------------------------------------------- 001500** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001510** ÄNDERUNG : 001 VOM 15.05.2001 VERSION 24 NACHGANG 01 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄNDERUNG : 002 VOM 16.04.2002 VERSION 27 NACHGANG 02 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 24.10.2003 VERSION 36 001660**---------------------------------------------------------------- 001700 FDBME160 SECTION. 001710 FDBME160E. 001720 IF E2-KENNZRK = "9" THEN 001730 IF (OP-AGDEU OR OP-WLTKV OR OP-KVTWL) AND 001740 (E1-KENNZUE = "A") THEN 001741** (:S0:-KENNZUE = "A" OR "K") THEN 001750 CONTINUE 001760 ELSE 001770 MOVE "DBME161" TO H-FEHLER 001791 END-IF 001792 ELSE 001793 IF E2-KENNZRK = "W" OR "O" OR " " THEN 001794** ------------------------------------------------------- 001795** T533101 001796** ------------------------------------------------------- 001798 IF E2-KENNZRK = " " THEN 001799 IF E1-PERSGR = "304" THEN 001800 MOVE "N" TO HFELD-P-BBG 001801 ELSE 001802 MOVE "DBME163" TO H-FEHLER 001803 MOVE "N" TO HFELD-P-BBG 001804 END-IF 001805 ELSE 001806 IF E1-PERSGR = "304" THEN 001807 MOVE "DBME165" TO H-FEHLER 001808 MOVE "N" TO HFELD-P-BBG 001809 ELSE 001811 PERFORM T533102 001812 END-IF 001813 001814 END-IF 001815 ELSE 001816 MOVE "DBME160" TO H-FEHLER 001817 MOVE "N" TO HFELD-P-BBG 001818 END-IF 001819 END-IF 001820 . 001821 001822 FDBME160-EXIT. 001823 EXIT. 001824 001825 001826 T533102 SECTION. 001827 T533102E. 001828** ------------------------------------------------------------- 001829** T533102 001830** ------------------------------------------------------------- 001831 IF (E2-ZREN-NUM IS NUMERIC AND E2-ZREN-NUM > ZERO 001832 AND E2-ZREN-NUM < 19990101) OR 001833 (E2-ZREN-NUM IS NUMERIC AND E2-ZREN-NUM = ZERO AND 001834 E2-ZRBG-NUM IS NUMERIC AND E2-ZRBG-NUM > ZERO AND 001835 E2-ZRBG-NUM < 19990101) THEN 001836 IF E1-PERSGR = "205" OR "207" OR "208" 001837 OR "301" OR "302" OR "303" 001838 CONTINUE 001839 ELSE 001840 MOVE E1-BBNRVU(1:3) TO HFELD-LG3 001841 IF E2-KENNZRK = "O" THEN 001842 IF HFELD-LG3 IS NUMERIC AND ((HFELD-LG3-NUM >= 1 001843 AND <= 99) OR HFELD-LG3-NUM = 987) THEN 001844 CONTINUE 001845 ELSE 001846 MOVE "DBME164" TO H-FEHLER 001847 MOVE "N" TO HFELD-P-BBG 001848 PERFORM FEHLER 001849 END-IF 001850 ELSE 001851 IF HFELD-LG3 IS NUMERIC AND ((HFELD-LG3-NUM >= 1 001852 AND <= 99) OR HFELD-LG3-NUM = 987) THEN 001853 MOVE "DBME162" TO H-FEHLER 001854 MOVE "N" TO HFELD-P-BBG 001855 PERFORM FEHLER 001856 ELSE 001857 CONTINUE 001858 END-IF 001859 END-IF 001860 END-IF 001861 END-IF 001862** ------------------------------------------------------------- 001863** T533103 001864** ------------------------------------------------------------- 001865 IF E1-PERSGR = "301" OR "302" OR "303" THEN 001866 IF E2-KENNZRK = "O" THEN 001867 IF E2-ZRBG-NUM > 19901002 THEN 001868 CONTINUE 001869 ELSE 001870 MOVE "DBME167" TO H-FEHLER 001871 MOVE "N" TO HFELD-P-BBG 001872 END-IF 001873 END-IF 001874 END-IF 001877 . 001879 T533102-EXIT. 001880 EXIT. 001881 001882 001883 001890 025300*COPY CDBME170 REPLACING ==:S1:== BY ==E2==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBME170 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN 001400** MEHRFACHBESCHäFTIGTER 001600**---------------------------------------------------------------- 001700 FDBME170 SECTION. 001710 FDBME170E. 001800 IF E2-KENNZMF = "J" OR "N" THEN 001900 IF E2-KENNZMF = "J" THEN 001910 IF OP-BWTRV OR OP-BZTRV THEN 001920 MOVE "DBME172" TO H-FEHLER 001930 GO TO FDBME170-EXIT 001940 ELSE 001950 GO TO FDBME170-EXIT 001960 END-IF 001970 END-IF 002000 ELSE 002100 MOVE "DBME170" TO H-FEHLER 002200 END-IF 003385 . 003390 FDBME170-EXIT. 003400 EXIT. 025301*COPY CDBMEBBG REPLACING ==:S1:== BY ==E2== 025302* ==:S0:== BY ==E1==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBMEBBG 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN STORNIERUNG 001400**---------------------------------------------------------------- 001500** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001510** ÄNDERUNG : 001 VOM 30.04.2001 VERSION 24 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄNDERUNG : 002 VOM 15.10.2001 VERSION 25 / 01 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 003 VOM 18.04.2005 VERSION 45 / 01 001660**---------------------------------------------------------------- 001700 FDBMEBBG SECTION. 001710 FDBMEBBGE. 001800 IF HFELD-P-BBG = "N" THEN 001900 GO TO FDBMEBBG-EXIT 002500 ELSE 002600 IF E2-ZRBG < 19910101 THEN 002900 IF E2-KENNZRK = "O" THEN 003000 GO TO FDBMEBBG-EXIT 003110 END-IF 003200 END-IF 003210 END-IF 003220 MOVE E2-ZRBG TO HFELD-BE 003230 MOVE E2-ZREN TO HFELD-EN 003240 MOVE E2-EG TO HFELD-EG 003241 MOVE E2-WG TO HFELD-WG 003250 MOVE E2-KENNZRK TO HFELD-OST-WEST 003260 MOVE E1-PERSGR TO HFELD-PERSGR 003270 MOVE E1-VSTR TO HFELD-VSTR 003271 MOVE E1-KE TO HFELD-KENN 003272 MOVE E1-BBNRVU(1:3) TO HFELD-BBNRVU-1-3 003273 IF E1-PERSGR = "118" OR "205" THEN 003274** HFELD-EN-TT AUF LETZTEN TAG DES ANGEGEBENEN MONATS SETZEN 003275 IF HFELD-EN-MM NOT = 2 THEN 003276 MOVE TB-TG (HFELD-EN-MM) TO HFELD-EN-TT 003277 ELSE 003279 MOVE 28 TO HFELD-EN-TT 003280** PRUEFEN AUF SCHALTJAHR : 003281 IF HFELD-BE-JJ = 0 THEN 003282 MOVE HFELD-BE-JHJJ TO HFELD-BE-R 003283 DIVIDE HFELD-BE-R BY 400 GIVING 003284 RFELD1 REMAINDER REST1 003286 IF REST1 = 0 THEN 003288 MOVE 29 TO HFELD-EN-TT 003289 END-IF 003290 ELSE 003291 DIVIDE HFELD-BE-JJ BY 4 GIVING 003292 RFELD1 REMAINDER REST1 003294 IF REST1 = 0 THEN 003296 MOVE 29 TO HFELD-EN-TT 003297 END-IF 003298 END-IF 003299 END-IF 003300 END-IF 003301 PERFORM FBBG-PRUEF 003302 IF HFELD-FE = "F1" THEN 003303 MOVE "DBME096" TO H-FEHLER 003304 GO TO FDBMEBBG-EXIT 003305 ELSE 003306 IF HFELD-FE = "F2" THEN 003307 MOVE "DBME100" TO H-FEHLER 003308 GO TO FDBMEBBG-EXIT 003309 ELSE 003310 IF HFELD-FE = "F3" THEN 003311 MOVE "DBME098" TO H-FEHLER 003312 GO TO FDBMEBBG-EXIT 003315 ELSE 003316 IF HFELD-FE = "F4" THEN 003317 MOVE "DBME105" TO H-FEHLER 003318 GO TO FDBMEBBG-EXIT 003319 END-IF 003320 END-IF 003321 END-IF 003322 END-IF 003323 . 003330 FDBMEBBG-EXIT. 003400 EXIT. 025310*COPY CDBEU010 REPLACING ==:S5:== BY ==E6==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEU010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG DBEU 001600**---------------------------------------------------------------- 001700 FDBEU010 SECTION. 001710 FDBEU010E. 001800 IF E6-GBLD-NUM NOT NUMERIC THEN 001900 MOVE "DBEU010" TO H-FEHLER 002000 GO TO FDBEU010-EXIT 002100 ELSE 002200 MOVE E6-GBLD-NUM TO SA-TAB 002300 IF NOT SA-OK THEN 002400 MOVE "DBEU012" TO H-FEHLER 002500 END-IF 002600 END-IF 003300 . 003310 FDBEU010-EXIT. 003400 EXIT. 025400*COPY CDBSO010 REPLACING ==:S6:== BY ==E7==. 025500*COPY CDBSO020 REPLACING ==:S6:== BY ==E7==. 025600*COPY CDBSO030 REPLACING ==:S6:== BY ==E7==. 025700*COPY CDBSO040 REPLACING ==:S6:== BY ==E7==. 025800*COPY CDBKS010 REPLACING ==:S7:== BY ==E8==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBKS010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 14.06.1999 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN SEE-KNAPPSCHAFT 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄnderungsDATUM : 22.03.2002 001630** VERSION : 002 001640** ÄNDERUNG : VERSION 27 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ÄnderungsDATUM : 31.10.2002 001680** VERSION : 003 001690** ÄNDERUNG : VERSION 29 001691**---------------------------------------------------------------- 001692** PROGRAMMIERER : MICHAEL KLEMKE 001693** ÄnderungsDATUM : 08.12.2004 001694** VERSION : 004 001695** ÄNDERUNG : VERSION 42 001696**---------------------------------------------------------------- 001700 FDBKS010 SECTION. 001710 FDBKS010E. 001720 IF E8-KENNZKS = "K" OR "S" THEN 001721 IF E8-KENNZKS = "S" THEN 001722** ------------------------------------------------------- 001723** TABELLE 53091 001724** ------------------------------------------------------- 001725 IF OP-KVTRV OR OP-DSTBF OR OP-BFTDS THEN 001726 IF E8-SEE(46:2) = "36" OR "38" OR 001727 "96" OR "98" THEN 001728** ------------------------------------------------- 001729** TABELLE 53092 001730** ------------------------------------------------- 001731 IF E8-SEE(46:2) = "36" OR "38" THEN 001732 IF E1-PERSGR-NUM = 142 THEN 001733 IF E1-MMME = "J" 001734 IF E2-ZRBG-NUM > 19960731 001735 CONTINUE 001736 ELSE 001737 MOVE "DBKS210" TO H-FEHLER 001738 PERFORM FEHLER 001739 END-IF 001740 END-IF 001742 ELSE 001743 MOVE "DBKS210" TO H-FEHLER 001744 PERFORM FEHLER 001745 END-IF 001746 ELSE 001747** ---------------------------------------------- 001748** TABELLE 53093 001749** ---------------------------------------------- 001750 IF E8-SEE(46:2) = "96" OR "98" THEN 001751 IF E1-PERSGR-NUM = 140 OR 141 OR 149 OR 143 001752 CONTINUE 001753 ELSE 001754 MOVE "DBKS220" TO H-FEHLER 001755 PERFORM FEHLER 001758 END-IF 001759 END-IF 001760** ---------------------------------------------- 001761** ENDE TABELLE 53093 001762** ---------------------------------------------- 001763 END-IF 001764** ------------------------------------------------- 001765** ENDE TABELLE 53092 001766** ------------------------------------------------- 001767 ELSE 001768 MOVE "DBKS200" TO H-FEHLER 001769 PERFORM FEHLER 001770 END-IF 001771 END-IF 001772** ------------------------------------------------------- 001773** ENDE TABELLE 53091 001774** ------------------------------------------------------- 001775 END-IF 001776 ELSE 001777 MOVE "DBKS010" TO H-FEHLER 001778 PERFORM FEHLER 001780 END-IF 003300 . 003301 003302 003310 FDBKS010-EXIT. 003400 EXIT. 025810*COPY CDBSV010 REPLACING ==:S8:== BY ==E9==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBSV010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN 001400** KONTROLLMELDUNG 001600**---------------------------------------------------------------- 001700 FDBSV010 SECTION. 001710 FDBSV010E. 001800 IF E9-KENNZSVA NOT = "J" THEN 001900 MOVE "DBSV010" TO H-FEHLER 002000 END-IF 003300 . 003310 FDBSV010-EXIT. 003400 EXIT. 025900*COPY CDBVR010 REPLACING ==:S9:== BY ==E10== 025910* ==:S0:== BY ==E1== 025920* ==:S3:== BY ==E4==. 094990**---------------------------------------------------------------- 095000** COPY-MEMBER : CDBVR010 095010** PROGRAMMIERER : WERNER KRAUS 095020** ERSTELLUNGSDATUM : 23.03.1998 095030** VERSION : 001 (PGM-NSOERSTELLUNG) 095040** FUNKTION : FEHLERPRüFUNG KENNZEICHEN 095050** KONTROLLMELDUNG 095060**---------------------------------------------------------------- 095061** PROGRAMMIERER : MICHAEL KLEMKE 095062** ERSTELLUNGSDATUM : 13.11.2001 095063** VERSION : 002 095066**---------------------------------------------------------------- 095067** PROGRAMMIERER : MICHAEL KLEMKE 095068** ERSTELLUNGSDATUM : 22.03.2002 095069** VERSION : 003 FÜR VERSION 27 095070**---------------------------------------------------------------- 095071** PROGRAMMIERER : MICHAEL KLEMKE 095072** ERSTELLUNGSDATUM : 24.10.2003 095073** VERSION : 004 FÜR VERSION 36 095074**---------------------------------------------------------------- 095075** PROGRAMMIERER : MICHAEL KLEMKE 095076** ERSTELLUNGSDATUM : 18.05.2004 095077** VERSION : 005 FÜR VERSION 40 095078**---------------------------------------------------------------- 095079** PROGRAMMIERER : MICHAEL KLEMKE 095080** ERSTELLUNGSDATUM : 08.12.2004 095081** VERSION : 006 FÜR VERSION 42 095082**---------------------------------------------------------------- 095083** PROGRAMMIERER : MICHAEL KLEMKE 095084** ERSTELLUNGSDATUM : 25.04.2005 095085** VERSION : 007 FÜR VERSION 45 095086**---------------------------------------------------------------- 095087** PROGRAMMIERER : MICHAEL KLEMKE 095088** ERSTELLUNGSDATUM : 02.06.2005 095089** VERSION : 008 FÜR VERSION 46 095090**---------------------------------------------------------------- 095091** PROGRAMMIERER : MICHAEL KLEMKE 095092** ERSTELLUNGSDATUM : 12.10.2006 095093** VERSION : 009 FÜR VERSION 56 095094**---------------------------------------------------------------- 095095** PROGRAMMIERER : MICHAEL KLEMKE 095096** ERSTELLUNGSDATUM : 23.02.2007 095097** VERSION : 010 FÜR VERSION 60 095098**---------------------------------------------------------------- 095099 FDBVR010 SECTION. 095100 FDBVR010E. 095110 IF E10-GDMQ-NUM NUMERIC THEN 095130 IF E10-GDMQ-NUM >= 1 AND <= 5 OR 095131 >= 80 AND <= 85 OR = 99 THEN 095135** ------------------------------------------------------- 095136** ÄNDERUNG VOM 24.10.2003 / VERSION 36 095137** ------------------------------------------------------- 095141 IF OP-KVTRV OR OP-ZFTRV OR OP-BATRV OR OP-KTTRV 095142 IF E10-GDMQ-NUM = 01 OR 04 OR 80 OR 99 THEN 095143 PERFORM T5311011 095144 ELSE 095145 MOVE "DBVR014" TO H-FEHLER 095146 END-IF 095147 ELSE 095148 IF OP-BWTRV OR OP-BZTRV OR 095149 OP-PVTRV OR OP-KSTRV 095150 IF E10-GDMQ-NUM NOT = 1 AND NOT = 99 THEN 095151 MOVE "DBVR016" TO H-FEHLER 095152 ELSE 095153 PERFORM T5311011 095154 END-IF 095155 ELSE 095156 PERFORM T5311011 095157 END-IF 095362 END-IF 095770 ELSE 095780 MOVE "DBVR012" TO H-FEHLER 095800 END-IF 095801 ELSE 095802 MOVE "DBVR010" TO H-FEHLER 095810 END-IF 095820 . 095830 FDBVR010-EXIT. 095840 EXIT. 095841 095842 095843 095844 T5311011 SECTION. 095845 T5311011E. 095890 IF E1-VSNR(1 : 2) = "00" OR "77" OR "83" 095900 OR "84" OR "85" OR "86" 095910 OR "87" OR "88" 095920** ------------------------------------------ 095930** ÄNDERUNG VOM 24.10.2003 / VERSION 36 095931** ------------------------------------------ 095932 OR "41" 095933** ------------------------------------------ 096000 OR "91" OR "92" OR "94" THEN 096150 IF E10-GDMQ-NUM = 1 OR 2 OR 4 OR 5 OR 99 THEN 096160 PERFORM T5311012 096300 ELSE 096400 MOVE "DBVR020" TO H-FEHLER 096600 END-IF 096700 ELSE 096715** ---------------------------------------------------------- 096716** VERSION 27 (25.03.2002) 096717** ---------------------------------------------------------- 096718 IF E10-GDMQ-NUM = 1 OR 2 OR 4 OR 5 OR 99 THEN 096719 MOVE "DBVR020" TO H-FEHLER 096720 ELSE 096721 PERFORM T5311012 096760 END-IF 096900 END-IF 097010 . 097100 T5311011-EXIT. 097200 EXIT. 097300 097400 097500 097600 T5311012 SECTION. 097700 T5311012E. 097710 IF E1-MMGB = "J" THEN 097720 IF E4-GBOT = " " THEN 097721 IF (E10-GDMQ-NUM = 80 OR 81 OR 82 OR 097722 83 OR 84 OR 85) OR 097723 E10-GDMQ-NUM = 04 OR 097724 E10-GDMQ-NUM = 05 097725** ---------------------------------------------------- 097726** VERSION 60 (23.02.2007) 097727** ---------------------------------------------------- 097728 PERFORM T5311013 098900 ELSE 099000 MOVE "DBVR022" TO H-FEHLER 099100 END-IF 099200 ELSE 099210** ------------------------------------------------------- 099220** VERSION 60 (23.02.2007) 099221** ------------------------------------------------------- 099300 PERFORM T5311013 100000 END-IF 100100 END-IF 100200 . 100210 100220 100300 T5311012-EXIT. 100400 EXIT. 100500 100600 100700 T5311013 SECTION. 100800 T5311013E. 100900 IF E1-VSNR(1:2) = "88" 101100 IF E10-GDMQ-NUM = 01 OR 99 101101 MOVE P-DATE TO HDATUM 101102 COMPUTE HDATJHJJ = HDATJHJJ - 14 101103 IF SIC-GEB > HDATUM 102000 MOVE "DBVR025" TO H-FEHLER 102100 END-IF 102200 END-IF 102800 END-IF 102900 . 103000 103100 103200 T5311013-EXIT. 103300 EXIT. 103400 103500 026000*COPY CDBVR030 REPLACING ==:S9:== BY ==E10==. 095860**---------------------------------------------------------------- 095870** COPY-MEMBER : CDBVR030 095880** PROGRAMMIERER : WERNER KRAUS 095890** ERSTELLUNGSDATUM : 23.03.1998 095900** VERSION : 001 (PGM-NSOERSTELLUNG) 095910** FUNKTION : FEHLERPRüFUNG BEREICHSNUMMER 095920** DER VERGABEANSTALT 095930**---------------------------------------------------------------- 095931** PROGRAMMIERER : MICHAEL KLEMKE 095932** ERSTELLUNGSDATUM : 24.10.2003 095933** VERSION : 002 / VERSION 36 095935**---------------------------------------------------------------- 095940 FDBVR030 SECTION. 095950 FDBVR030E. 095960 IF E10-BRNR-NUM NUMERIC THEN 095971 MOVE E10-BRNR-NUM TO BRNR-TAB 095972 IF BRNR-OK THEN 095973 IF E10-BRNR-NUM = 40 095974 IF OP-ZFTRV OR OP-RVTZF 095975 CONTINUE 095976 ELSE 095977 MOVE "DBVR034" TO H-FEHLER 095979 END-IF 095980 END-IF 095981 ELSE 095982 MOVE "DBVR032" TO H-FEHLER 095983 END-IF 095984 ELSE 095985 MOVE "DBVR030" TO H-FEHLER 095990 END-IF 096040 . 096050 FDBVR030-EXIT. 096060 EXIT. 026100*COPY CDBVR080 REPLACING ==:S9:== BY ==E10==. 000200**---------------------------------------------------------------- 000300** COPY-MEMBER : CDBVR080 000400** PROGRAMMIERER : WERNER KRAUS 000500** ERSTELLUNGSDATUM : 23.03.1998 000501** VERSION : 001 (PGM-NSOERSTELLUNG) 000502** FUNKTION : FEHLERPRüFUNG VERSICHERUNGSNUMMER 000503** VERGABE 000504**---------------------------------------------------------------- 000505** PROGRAMMIERER : MICHAEL KLEMKE 000506** ERSTELLUNGSDATUM : 14.11.2001 000507** VERSION : 002 000510**---------------------------------------------------------------- 000511** PROGRAMMIERER : MICHAEL KLEMKE 000512** ERSTELLUNGSDATUM : 25.03.2002 000513** VERSION : 003 000514**---------------------------------------------------------------- 000515** PROGRAMMIERER : MICHAEL KLEMKE 000516** ERSTELLUNGSDATUM : 04.11.2002 (VERSION-29) 000517** VERSION : 004 000518**---------------------------------------------------------------- 000519** PROGRAMMIERER : MICHAEL KLEMKE 000520** ERSTELLUNGSDATUM : 24.10.2003 (VERSION-36) 000521** VERSION : 005 000522**---------------------------------------------------------------- 000523** PROGRAMMIERER : MICHAEL KLEMKE 000524** ERSTELLUNGSDATUM : 19.05.2004 (VERSION-40) 000525** VERSION : 006 000526**---------------------------------------------------------------- 000527 FDBVR080 SECTION. 000528 FDBVR080E. 000529** ------------------------------------------------------------- 000530** VERSION 27 (25.03.2002) 000531** ------------------------------------------------------------- 000532 IF E10-GDMQ = "01" OR "04" OR "80" OR "99" THEN 000533 IF E10-VSNRZH NOT = " " THEN 000534 MOVE "DBVR080" TO H-FEHLER 000535 PERFORM FEHLER 000536 END-IF 000537 ELSE 000538 MOVE E10-VSNRZH TO HVSNR 000539** ---------------------------------------------------------- 000540** VERSION-29 (04.11.2002) 000541** ---------------------------------------------------------- 000542** T5311031 000543** ---------------------------------------------------------- 000544 IF E10-GDMQ = "02" OR "03" THEN 000545 IF HVSNRNUM1 NUMERIC AND 000546 HVSNRNUM2 NUMERIC AND 000547 HVSNR2 VSNRBUCHSTABE THEN 000548** ---------------------------------------------------- 000549** T5311032 000550** ---------------------------------------------------- 000551 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB 000552 IF NOT BNR-OK THEN 000553 MOVE "DBVR084" TO H-FEHLER 000554 PERFORM FEHLER 000555 END-IF 000556 IF HVSNRGEBMM < 00 OR > 12 THEN 000557 MOVE "DBVR086" TO H-FEHLER 000558 PERFORM FEHLER 000559 ELSE 000560 IF HVSNRGEBTT > 95 AND NOT EQUAL 97 THEN 000561 MOVE "DBVR086" TO H-FEHLER 000562 PERFORM FEHLER 000563 ELSE 000564 IF HVSNRGEBTT = 97 AND 000565 HVSNRGEBMM < 01 OR > 12 THEN 000566 MOVE "DBVR086" TO H-FEHLER 000567 PERFORM FEHLER 000568 END-IF 000569 END-IF 000570 END-IF 000571 MOVE HVSNRNUM1 TO ZIFF-1-8 000572 MOVE HVSNRSS TO ZIFF-11-12 000573 MOVE 1 TO I 000574 MOVE 0 TO SX-BUCHSTABE 000575 PERFORM UNTIL I > 26 000576 OR BUCHSTABE-GEFUNDEN 000577 IF HVSNR2 = ALPHA-B(I) 000578 MOVE I TO ZIFF-9-A2 000579 MOVE 1 TO SX-BUCHSTABE 000580 END-IF 000581 ADD 1 TO I 000582 END-PERFORM 000583 MOVE 0 TO HILFSFELD 000584 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 12 000585 COMPUTE QUERSUMME = ZIFFER(I) * 000586 FAKTOR-VSNR(I) 000587 COMPUTE HILFSFELD = QUERSUMME-1 + 000588 QUERSUMME-2 + HILFSFELD 000589 END-PERFORM 000590 DIVIDE 10 INTO HILFSFELD GIVING ERG 000591 REMAINDER REST 000592 IF REST NOT EQUAL HVSNRPR 000593 MOVE "DBVR088" TO H-FEHLER 000594 PERFORM FEHLER 000595 END-IF 000596** ---------------------------------------------------- 000597** ENDE T5311032 000598** ---------------------------------------------------- 000599 ELSE 000600 MOVE "DBVR082" TO H-FEHLER 000601 PERFORM FEHLER 000602 END-IF 000603 ELSE 000604 IF E10-GDMQ = "05" THEN 000605 IF E10-VSNRZH = " " THEN 000606 CONTINUE 000607 ELSE 000608 IF HVSNRNUM1 NUMERIC AND 000609 HVSNRNUM2 NUMERIC AND 000610 HVSNR2 VSNRBUCHSTABE THEN 000611** ---------------------------------------------- 000612** T5311032 000613** ---------------------------------------------- 000614 MOVE HVSNR1(1:2) TO HVSNRBNR-TAB 000615 IF NOT BNR-OK THEN 000616 MOVE "DBVR084" TO H-FEHLER 000617 PERFORM FEHLER 000618 END-IF 000619 IF HVSNRGEBMM < 00 OR > 12 THEN 000620 MOVE "DBVR086" TO H-FEHLER 000621 PERFORM FEHLER 000622 ELSE 000623 IF HVSNRGEBTT > 95 AND NOT EQUAL 97 THEN 000624 MOVE "DBVR086" TO H-FEHLER 000625 PERFORM FEHLER 000626 ELSE 000627 IF HVSNRGEBTT = 97 AND 000628 HVSNRGEBMM < 01 OR > 12 THEN 000629 MOVE "DBVR086" TO H-FEHLER 000630 PERFORM FEHLER 000631 END-IF 000632 END-IF 000633 END-IF 000634 MOVE HVSNRNUM1 TO ZIFF-1-8 000635 MOVE HVSNRSS TO ZIFF-11-12 000636 MOVE 1 TO I 000637 MOVE 0 TO SX-BUCHSTABE 000638 PERFORM UNTIL I > 26 000639 OR BUCHSTABE-GEFUNDEN 000640 IF HVSNR2 = ALPHA-B(I) 000641 MOVE I TO ZIFF-9-A2 000642 MOVE 1 TO SX-BUCHSTABE 000643 END-IF 000644 ADD 1 TO I 000645 END-PERFORM 000646 MOVE 0 TO HILFSFELD 000647 PERFORM VARYING I FROM 1 BY 1 UNTIL I > 12 000648 COMPUTE QUERSUMME = ZIFFER(I) * 000649 FAKTOR-VSNR(I) 000650 COMPUTE HILFSFELD = QUERSUMME-1 + 000651 QUERSUMME-2 + HILFSFELD 000652 END-PERFORM 000653 DIVIDE 10 INTO HILFSFELD GIVING ERG 000654 REMAINDER REST 000655 IF REST NOT EQUAL HVSNRPR 000656 MOVE "DBVR088" TO H-FEHLER 000657 PERFORM FEHLER 000658 END-IF 000659** ---------------------------------------------- 000660** ENDE T5311032 000661** ---------------------------------------------- 000662 ELSE 000663 MOVE "DBVR083" TO H-FEHLER 000664 PERFORM FEHLER 000665 END-IF 000666 END-IF 000667 END-IF 000668 END-IF 000669** ---------------------------------------------------------- 000670** ENDE T5311031 000671** ---------------------------------------------------------- 000672 END-IF 000673 . 000674 000675 000680 FDBVR080-EXIT. 000700 EXIT. 026110*COPY CDBRG300 REPLACING ==:S10:== BY ==E11==. 094990**---------------------------------------------------------------- 095000** COPY-MEMBER : CDBRG300 095010** PROGRAMMIERER : WERNER KRAUS 095020** ERSTELLUNGSDATUM : 10.04.2000 095030** VERSION : 001 (PGM-NSOERSTELLUNG) 095040** FUNKTION : FEHLERPRüFUNG ZAEHLER DBRG 095060**---------------------------------------------------------------- 095061** PROGRAMMIERER : GERTRAUD SCHUHMACHER 095062** ÄNDERUNG : 001 VOM 15.11.2000 095063**---------------------------------------------------------------- 095070 FDBRG300 SECTION. 095080 FDBRG300E. 095090 IF E11-ANRG NOT NUMERIC THEN 095100 MOVE "DBRG300" TO H-FEHLER 095200 ELSE 095300 IF E11-ANRG < 01 OR E11-ANRG > 46 THEN 095400 MOVE "DBRG310" TO H-FEHLER 095500 END-IF 095600 END-IF 095820 . 095830 FDBRG300-EXIT. 095840 EXIT. 026200*COPY CDBAZ010 REPLACING ==:S12:== BY ==E13==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAZ010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN 001400** STORNIERUNG 001600**---------------------------------------------------------------- 001700 FDBAZ010 SECTION. 001710 FDBAZ010E. 001800 IF E13-KENNZST = "J" OR "N" THEN 001900 CONTINUE 002000 ELSE 002100 MOVE "DBAZ010" TO H-FEHLER 002200 END-IF 003325 . 003330 FDBAZ010-EXIT. 003400 EXIT. 026201*COPY CDBAZ020 REPLACING ==:S12:== BY ==E13==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAZ020 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NSOERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN 001400** STORNIERUNG 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 24.10.2003 001630** VERSION : 002 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ERSTELLUNGSDATUM : 12.10.2006 001690** VERSION : 003 / 056 001691**---------------------------------------------------------------- 001700 FDBAZ020 SECTION. 001710 FDBAZ020E. 001720** ------------------------------------------------------------- 001730** T531302 001740** ------------------------------------------------------------- 001800 IF E13-LEAT-NUM NUMERIC THEN 002010** ---------------------------------------------------------- 002020** ÄNDERUNG VOM 24.10.2003 / VERSION 36 002030** ---------------------------------------------------------- 002100** IF :S12:-LEAT-NUM = 40 OR 41 OR 51 OR 52 OR 54 THEN 002101 IF E13-LEAT-NUM = 40 OR 41 OR 51 OR 52 OR 54 OR 002102 42 OR 43 OR 44 THEN 002103** ---------------------------------------------------------- 002110 IF E13-LEAT-NUM = 52 THEN 002120 MOVE E12-VSNR TO HVSNR 002130 IF HVSNRSS < 50 THEN 002140 MOVE "DBAZ024" TO H-FEHLER 002150 ELSE 002151** ------------------------------------------------- 002152** AUFRUF T5313021 002153** ------------------------------------------------- 002154 PERFORM T5313021 002160 END-IF 002161 ELSE 002162** ---------------------------------------------------- 002163** AUFRUF T5313021 002164** ---------------------------------------------------- 002165 PERFORM T5313021 002170 END-IF 002173 ELSE 002174 MOVE "DBAZ022" TO H-FEHLER 002175 END-IF 002176 ELSE 002177 MOVE "DBAZ020" TO H-FEHLER 002178 END-IF 002179 . 002180 002181 FDBAZ020-EXIT. 002182 EXIT. 002183 002184 002185 T5313021 SECTION. 002186 T5313021E. 002187** ------------------------------------------------------------- 002188** T5313021 002189** ------------------------------------------------------------- 002190 IF OP-BATRV THEN 002191 IF E13-LEAT-NUM = 40 OR 41 OR 42 OR 43 OR 44 THEN 002192 CONTINUE 002193 ELSE 002194 MOVE "DBAZ026" TO H-FEHLER 002195 END-IF 002196 ELSE 002197 IF OP-KVTWL OR OP-KVTRV THEN 002198 IF E13-LEAT-NUM = 51 OR 52 OR 54 THEN 002199 CONTINUE 002200 ELSE 002201 MOVE "DBAZ028" TO H-FEHLER 002202 END-IF 002214 END-IF 002215 END-IF 002216 . 002217 002218 002220 T5313021-EXIT. 002221 EXIT. 002230 026202*COPY CDBAZ030 REPLACING ==:S12:== BY ==E13== 026203* ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAZ030 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ZEITRAUM 001400** BEGINN 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 24.10.2003 001630** VERSION : 002 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ERSTELLUNGSDATUM : 26.11.2003 001690** VERSION : 003 001691**---------------------------------------------------------------- 001692** PROGRAMMIERER : MICHAEL KLEMKE 001693** änderungsDATUM : 23.02.2004 001694** VERSION : 004 / PROGRAMMVERSION 39 001695**---------------------------------------------------------------- 001696** PROGRAMMIERER : MICHAEL KLEMKE 001697** änderungsDATUM : 31.10.2005 001698** VERSION : 005 / PROGRAMMVERSION 50 001699**---------------------------------------------------------------- 001700** PROGRAMMIERER : MICHAEL KLEMKE 001701** änderungsDATUM : 05.12.2005 001702** VERSION : 006 / PROGRAMMVERSION 51 001703**---------------------------------------------------------------- 001704** PROGRAMMIERER : MICHAEL KLEMKE 001705** änderungsDATUM : 23.04.2007 001706** VERSION : 007 / PROGRAMMVERSION 62 001707**---------------------------------------------------------------- 001708 FDBAZ030 SECTION. 001710 FDBAZ030E. 001720** ------------------------------------------------------------- 001730** T531303 001740** ------------------------------------------------------------- 001810** HF-GEB-JHJJ ZWISCHENSPEICHERN, DA ÖFTER VERWENDET 001900** ------------------------------------------------------------- 002000 IF E13-ZRBE-NUM NUMERIC THEN 002101 MOVE HFELD-GEB-JHJJ TO HF-GEB-JHJJ-2 002102** ---------------------------------------------------------- 002110 DIVIDE 4 INTO E13-ZRBE-JJ GIVING ERG 002120 REMAINDER SCHALTJAHR 002130 IF E13-ZRBE-MM > ZERO AND < 13 AND 002140 E13-ZRBE-TT > ZERO AND 002150 <= TGT(SCHALTJAHR + 1, E13-ZRBE-MM) THEN 002180** ------------------------------------------------------- 002190 IF E13-KENNZST = "J" 002191** ---------------------------------------------------- 002192** AUFRUF T5313031 002193** ---------------------------------------------------- 002194 PERFORM T5313031 002200 ELSE 002201 IF E13-LEAT-NUM = 44 OR 54 THEN 002202 IF HFELD-P-GBDT = "N" THEN 002203** ---------------------------------------------- 002204** AUFRUF T5313031 002205** ---------------------------------------------- 002207 PERFORM T5313031 002208 ELSE 002209 COMPUTE HFELD-GEB-JHJJ = HF-GEB-JHJJ-2 + 17 002210 IF E13-ZRBE-NUM < HFELD-GEB THEN 002211 MOVE "DBAZ034" TO H-FEHLER 002212 ELSE 002213** ------------------------------------------- 002214** AUFRUF T5313031 002215** ------------------------------------------- 002217 PERFORM T5313031 002218 END-IF 002219 END-IF 002220 ELSE 002230** ------------------------------------------------- 002240** AUFRUF T5313031 002250** ------------------------------------------------- 002260 PERFORM T5313031 003333 END-IF 003334 END-IF 003340 ELSE 003341 MOVE "DBAZ032" TO H-FEHLER 003342 END-IF 003343 ELSE 003344 MOVE "DBAZ030" TO H-FEHLER 003345 END-IF 003346 . 003350 FDBAZ030-EXIT. 003400 EXIT. 003500 003510 003520 003530 003600 T5313031 SECTION. 003700 T5313031E. 003701** ------------------------------------------------------------- 003702** T5313031 003703** ------------------------------------------------------------- 003710 IF E13-LEAT-NUM = 42 THEN 003720 IF E13-ZRBE-NUM > 20030430 THEN 003730 IF HFELD-P-GBDT = "N" THEN 003740** ---------------------------------------------------- 003750** AUFRUF T5313032 003760** ---------------------------------------------------- 003770 PERFORM T5313032 003771 ELSE 003780 COMPUTE HFELD-GEB-JHJJ = HF-GEB-JHJJ-2 + 58 003790 IF E13-ZRBE-NUM >= HFELD-GEB THEN 003791** ------------------------------------------------- 003792** AUFRUF T5313032 003793** ------------------------------------------------- 003794 PERFORM T5313032 003800 ELSE 003900 MOVE "DBAZ036" TO H-FEHLER 003901 END-IF 003902 END-IF 003903 ELSE 003904 MOVE "DBAZ033" TO H-FEHLER 003905 END-IF 003906 ELSE 003907** ---------------------------------------------------------- 003908** AUFRUF T5313032 003909** ---------------------------------------------------------- 003910 PERFORM T5313032 003911 END-IF 003912 . 003920 T5313031-EXIT. 004000 EXIT. 004100 004200 004210 004220 004230 T5313032 SECTION. 004240 T5313032E. 004241** ------------------------------------------------------------- 004242** T5313032 004243** ------------------------------------------------------------- 004250 IF E13-LEAT-NUM = 43 THEN 004301 IF E13-ZRBE-NUM > 20000930 THEN 004302 IF HFELD-P-GBDT = "N" THEN 004303** ---------------------------------------------------- 004304** AUFRUF T5313033 004305** ---------------------------------------------------- 004307 PERFORM T5313033 004308 ELSE 004309 COMPUTE HFELD-GEB-JHJJ = HF-GEB-JHJJ-2 + 14 004310 IF E13-ZRBE-NUM >= HFELD-GEB THEN 004311** ------------------------------------------------- 004312** AUFRUF T5313033 004313** ------------------------------------------------- 004315 PERFORM T5313033 004316 ELSE 004317 MOVE "DBAZ037" TO H-FEHLER 004318 END-IF 004319 END-IF 004320 ELSE 004321 MOVE "DBAZ035" TO H-FEHLER 004322 END-IF 004323 ELSE 004324** ---------------------------------------------------------- 004325** AUFRUF T5313033 004326** ---------------------------------------------------------- 004327 PERFORM T5313033 004330 END-IF 004400 . 004410 004420 004500 T5313032-EXIT. 004600 EXIT. 004710 004720 004730 T5313033 SECTION. 004740 T5313033E. 004750** ------------------------------------------------------------- 004760** T5313033 004770** ------------------------------------------------------------- 004771 IF E13-KENNZST = "N" 004772 IF E13-ZRBE-NUM > 20041231 THEN 004773 IF E12-VSTR = "0A" OR "0C" 004774 CONTINUE 004775 ELSE 004778 IF OP-BATRV 004779 IF E12-VSTR = "0B" OR "0G" 004780 CONTINUE 004781 ELSE 004782 MOVE "DBAZ038" TO H-FEHLER 004784 END-IF 004785 ELSE 004786 IF OP-DSTBF OR OP-BFTDS 004787 IF E12-VSTR = "BA" OR "BB" OR "BC" OR "BG" 004788 CONTINUE 004789 ELSE 004790 MOVE "DBAZ038" TO H-FEHLER 004792 END-IF 004793 ELSE 004794 MOVE "DBAZ038" TO H-FEHLER 004796 END-IF 004797 END-IF 004802 END-IF 004803 END-IF 004804 END-IF 004805 . 004806 004807 004808 T5313033-EXIT. 004809 EXIT. 004810 004820 004900 026205*COPY CDBAZ040 REPLACING ==:S12:== BY ==E13==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBAZ040 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ZEITRAUM 001400** BEGINN 001600**---------------------------------------------------------------- 001700 FDBAZ040 SECTION. 001800 FDBAZ040E. 002300 IF E13-ZREN-NUM NOT NUMERIC THEN 002400 MOVE "DBAZ040" TO H-FEHLER 002500 GO TO FDBAZ040-EXIT 002600 ELSE 002610 DIVIDE 4 INTO E13-ZREN-JJ GIVING ERG 002620 REMAINDER SCHALTJAHR 002630 IF E13-ZREN-MM > ZERO AND < 13 002640 AND E13-ZREN-TT > ZERO 002650 AND <= TGT(SCHALTJAHR + 1, E13-ZREN-MM) THEN 002700 IF E13-ZREN >= 003325 E13-ZRBE THEN 003326 MOVE P-DATE TO HDATUM 003327** IF HDATMM <= 11 THEN 003328** MOVE HDATMM TO MON-ENDE-IND 003329** ADD 1 TO MON-ENDE-IND 003330** MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 003331** MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 003332** ELSE IF HDATMM = 12 THEN 003333** MOVE 1 TO MON-ENDE-IND 003334** MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 003335** MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 003336** ADD 1 TO HDATJHJJ 003337** END-IF 003338** END-IF 003339 IF HDATMM <= 9 THEN 003340 MOVE HDATMM TO MON-ENDE-IND 003341 ADD 3 TO MON-ENDE-IND 003342 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 003343 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 003344 ELSE IF HDATMM = 10 THEN 003345 MOVE 1 TO MON-ENDE-IND 003346 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 003347 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 003348 ADD 1 TO HDATJHJJ 003349 ELSE 003350 IF HDATMM = 11 THEN 003351 MOVE 2 TO MON-ENDE-IND 003352 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 003353 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 003354 ADD 1 TO HDATJHJJ 003355 ELSE 003356 IF HDATMM = 12 THEN 003357 MOVE 3 TO MON-ENDE-IND 003358 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 003359 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 003360 ADD 1 TO HDATJHJJ 003361 END-IF 003362 END-IF 003363 END-IF 003364 END-IF 003365 IF E13-ZREN-NUM <= HDATUM THEN 003366 IF E13-LEAT = "54" THEN 003367 GO TO FDBAZ040-EXIT 003368 ELSE 003369 IF E13-ZRBE-NUM NOT NUMERIC THEN 003370 GO TO FDBAZ040-EXIT 003371 END-IF 003372 IF E13-ZREN-JHJJ = 003373 E13-ZRBE-JHJJ THEN 003374 GO TO FDBAZ040-EXIT 003375 ELSE 003376 IF E13-KENNZST = "J" THEN 003377 IF E13-ZREN-NUM < "19990101" THEN 003378 GO TO FDBAZ040-EXIT 003379 ELSE 003380 MOVE "DBAZ046" TO H-FEHLER 003381 GO TO FDBAZ040-EXIT 003382 END-IF 003383 ELSE 003384 MOVE "DBAZ046" TO H-FEHLER 003385 GO TO FDBAZ040-EXIT 003386 END-IF 003387 END-IF 003388 END-IF 003389 ELSE 003390 MOVE "DBAZ048" TO H-FEHLER 003391 GO TO FDBAZ040-EXIT 003392 END-IF 003393 ELSE 003394 MOVE "DBAZ044" TO H-FEHLER 003395 GO TO FDBAZ040-EXIT 003396 END-IF 003397 ELSE 003398 MOVE "DBAZ042" TO H-FEHLER 003399 GO TO FDBAZ040-EXIT 003400 END-IF 003401 END-IF 003402 . 003410 FDBAZ040-EXIT. 003500 EXIT. 026210*COPY CDBEZ010 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ010 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ZEITRAUM 001400** BEGINN 001600**---------------------------------------------------------------- 001610** ÄNDERUNGSDATUM : 13.04.2005 001620** VERSION : 002 / 045 001650**---------------------------------------------------------------- 001700 FDBEZ010 SECTION. 001710 FDBEZ010E. 001800 IF E14-KENNZST = "N" OR "J" THEN 001810 IF E14-KENNZST = "J" THEN 001811 MOVE "N" TO HFELD-P-BBG 001812 END-IF 001820 ELSE 001900 MOVE "DBEZ010" TO H-FEHLER 002000 END-IF 002100 . 002200 002300 003330 FDBEZ010-EXIT. 003400 EXIT. 003500 003600 026300*COPY CDBEZ020 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ020 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG LEISTUNGSART 001400**---------------------------------------------------------------- 001500** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001510** ÄNDERUNG : 002 VOM 10.01.2001 VERSION 22 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE (NUR KOMMENTAR) 001620** ÄNDERUNG : 003 VOM 24.02.2003 VERSION 31 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 004 VOM 08.12.2004 001660**---------------------------------------------------------------- 001670** PROGRAMMIERER : MICHAEL KLEMKE 001680** ÄNDERUNG : 005 VOM 12.10.2006 001690**---------------------------------------------------------------- 001700 FDBEZ020 SECTION. 001710 FDBEZ020E. 001800 IF E14-LEAT NOT NUMERIC THEN 001900 MOVE "DBEZ020" TO H-FEHLER 002000 GO TO FDBEZ020-EXIT 002010 ELSE 002020 MOVE E14-LEAT TO LEAT-TAB 002030 IF NOT LEAT-OK THEN 002040 MOVE "DBEZ020" TO H-FEHLER 002050 GO TO FDBEZ020-EXIT 002060 ELSE 002070 IF OP-KVTWL OR OP-KVTRV THEN 002080 MOVE E14-LEAT TO LEATKK-TAB 002090 IF NOT LEATKK-OK THEN 002091 MOVE "DBEZ022" TO H-FEHLER 002092 GO TO FDBEZ020-EXIT 002093 ELSE 002094 GO TO FDBEZ020-EXIT 002095 END-IF 002096 ELSE 002097* ---------------------------------------------------- 002098* 5314021 ANFANG 002099* ---------------------------------------------------- 002100 IF OP-BATRV THEN 002101 MOVE E14-LEAT TO LEATBA-TAB 002102 IF NOT LEATBA-OK 002103 MOVE "DBEZ024" TO H-FEHLER 002110 GO TO FDBEZ020-EXIT 002120 ELSE 002130 GO TO FDBEZ020-EXIT 002140 END-IF 002150 ELSE 002151 IF OP-KTTRV THEN 002152 IF E14-LEAT NOT = "43" AND NOT = "44" 002153 MOVE "DBEZ025" TO H-FEHLER 002154 END-IF 002155 ELSE 002194* ---------------------------------------------- 002195* 5314022 ANFANG 002196* ---------------------------------------------- 002197 IF OP-SOTBF THEN 002198 IF E14-LEAT NOT = "26" THEN 002199 MOVE "DBEZ028" TO H-FEHLER 002200 GO TO FDBEZ020-EXIT 002201 ELSE 002202 GO TO FDBEZ020-EXIT 002203 END-IF 002204 ELSE 002205 IF OP-UETBF 002206 IF E14-LEAT = "03" OR "06" OR "09" 002207 GO TO FDBEZ020-EXIT 002208 ELSE 002209 MOVE "DBEZ029" TO H-FEHLER 002210 GO TO FDBEZ020-EXIT 002211 END-IF 002212 END-IF 002213 END-IF 002215 END-IF 002216 END-IF 002217 END-IF 002218 END-IF 002220 END-IF 002300 . 003330 FDBEZ020-EXIT. 003400 EXIT. 026400*COPY CDBEZ030 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ030 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001700 FDBEZ030 SECTION. 001710 FDBEZ030E. 001800 IF E14-GDMQ-NUM NOT NUMERIC 001900 MOVE "DBEZ030" TO H-FEHLER 001910 GO TO FDBEZ030-EXIT 001920 ELSE 001930 IF E14-GDMQ NOT = "02" AND NOT = "03" THEN 001940 MOVE "DBEZ032" TO H-FEHLER 001950 GO TO FDBEZ030-EXIT 001960 END-IF 002000 END-IF 002100 . 003330 FDBEZ030-EXIT. 003400 EXIT. 026500*COPY CDBEZ040 REPLACING ==:S13:== BY ==E14== 026501* ==:S11:== BY ==E12==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ040 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄNDERUNG VOM : 04.11.2002 (VERSION-29) 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ÄNDERUNG VOM : 24.02.2003 (VERSION 31) 001680** VERSION : 003 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ÄNDERUNG VOM : 26.10.2003 (VERSION 36) 001693** VERSION : 004 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** ÄNDERUNG VOM : 13.10.2004 (VERSION 41) 001697** VERSION : 005 001698**---------------------------------------------------------------- 001699** PROGRAMMIERER : MICHAEL KLEMKE 001700** ÄNDERUNG VOM : 08.12.2004 (VERSION 42) 001701** VERSION : 006 001702**---------------------------------------------------------------- 001703** PROGRAMMIERER : MICHAEL KLEMKE 001704** ÄNDERUNG VOM : 31.10.2005 (VERSION 50) 001705** VERSION : 007 001706**---------------------------------------------------------------- 001707** PROGRAMMIERER : MICHAEL KLEMKE 001708** ÄNDERUNG VOM : 05.12.2005 (VERSION 51) 001709** VERSION : 008 001710**---------------------------------------------------------------- 001711** PROGRAMMIERER : MICHAEL KLEMKE 001712** ÄNDERUNG VOM : 25.07.2006 (VERSION 55) 001713** VERSION : 009 001714**---------------------------------------------------------------- 001715 FDBEZ040 SECTION. 001720 FDBEZ040E. 001800 IF E14-ZRBE-NUM NOT NUMERIC THEN 001900 MOVE "DBEZ040" TO H-FEHLER 001910 MOVE "N" TO HFELD-P-BBG 002000 GO TO FDBEZ040-EXIT 002010 ELSE 002020 DIVIDE 4 INTO E14-ZRBE-JJ GIVING ERG 002030 REMAINDER SCHALTJAHR 002040 IF E14-ZRBE-MM > ZERO AND < 13 002050 AND E14-ZRBE-TT > ZERO 002060 AND <= TGT(SCHALTJAHR + 1, E14-ZRBE-MM) THEN 002062** ------------------------------------------------------- 002063** 531404A ANFANG 002064** ------------------------------------------------------- 002065 IF E14-KENNZST = "N" 002066 IF E14-ZRBE-NUM > 20041231 002067 IF E12-VSTR = "0A" OR "0C" 002068 PERFORM T5314041 002069 ELSE 002070 002071 IF OP-BATRV 002072 IF E12-VSTR = "0B" OR "0G" 002073 PERFORM T5314041 002074 ELSE 002077 MOVE "DBEZ043" TO H-FEHLER 002078 MOVE "N" TO HFELD-P-BBG 002079 END-IF 002080 ELSE 002081 IF OP-DSTBF OR OP-BFTDS 002082 IF E12-VSTR = "BA" OR "BB" OR 002083 "BC" OR "BG" 002084 PERFORM T5314041 002086 ELSE 002087 MOVE "DBEZ043" TO H-FEHLER 002088 MOVE "N" TO HFELD-P-BBG 002091 END-IF 002092 ELSE 002093 MOVE "DBEZ043" TO H-FEHLER 002094 MOVE "N" TO HFELD-P-BBG 002097 END-IF 002098 END-IF 002099 END-IF 002102 ELSE 002103 PERFORM T5314041 002104 END-IF 002105 ELSE 002106 PERFORM T5314041 002107 END-IF 002215 ELSE 002216 MOVE "DBEZ042" TO H-FEHLER 002217 MOVE "N" TO HFELD-P-BBG 002218 END-IF 002220 END-IF 002300 . 002400 002500 003330 FDBEZ040-EXIT. 003400 EXIT. 003500 003600 003601 T5314041 SECTION. 003602 T5314041E. 003603** ------------------------------------------------------------- 003604** T5314041 003605** ------------------------------------------------------------- 003610 IF E14-LEAT = "27" OR "28" THEN 003611 IF E14-ZRBE-NUM > 19960430 THEN 003612 GO TO FDBEZ040-EXIT 003613 ELSE 003614 MOVE "DBEZ044" TO H-FEHLER 003615 MOVE "N" TO HFELD-P-BBG 003616 GO TO FDBEZ040-EXIT 003617 END-IF 003618 ELSE 003619* ---------------------------------------------------------- 003620* 04.11.2002 (VERSION-29) 003621* ---------------------------------------------------------- 003622 IF E14-LEAT = "30" OR "31" OR "32" OR 003623 "33" OR "42" THEN 003624 IF E14-ZRBE-NUM > 19971231 THEN 003625 GO TO FDBEZ040-EXIT 003626 ELSE 003627 MOVE "DBEZ046" TO H-FEHLER 003628 MOVE "N" TO HFELD-P-BBG 003629 GO TO FDBEZ040-EXIT 003630 END-IF 003631 ELSE 003632 MOVE SIC-GEB TO HFELD-GEB 003633 COMPUTE HFELD-GEB-JHJJ = HFELD-GEB-JHJJ + 15 003634 IF (E14-LEAT = "43" OR "44") AND 003635 E14-ZRBE < HFELD-GEB 003636 MOVE "DBEZ045" TO H-FEHLER 003637 MOVE "N" TO HFELD-P-BBG 003638 GO TO FDBEZ040-EXIT 003639 ELSE 003640** ---------------------------------------------------- 003641* 24.02.2003 (VERSION 31) 003642** ---------------------------------------------------- 003643** 5314042 ANFANG 003644** ---------------------------------------------------- 003645 IF E14-LEAT = "43" OR "44" 003646 IF E14-ZRBE-NUM > 20041231 THEN 003647 CONTINUE 003648 ELSE 003649 MOVE "DBEZ047" TO H-FEHLER 003650 MOVE "N" TO HFELD-P-BBG 003651 END-IF 003652 ELSE 003653 IF E14-LEAT = "50" THEN 003654 IF E14-ZRBE-NUM > 20021231 THEN 003655** ------------------------------------------- 003656** ÄNDERUNG VOM 26.10.2003 / V-36 003657** ------------------------------------------- 003658 IF HFELD-P-GBDT = "N" THEN 003659 CONTINUE 003660 ELSE 003661 MOVE SIC-GEB TO HFELD-GEB 003662 COMPUTE HFELD-GEB-JHJJ = 003663 HFELD-GEB-JHJJ + 50 003664 IF E14-ZRBE-NUM < HFELD-GEB 003665 MOVE "DBEZ049" TO H-FEHLER 003666 MOVE "N" TO HFELD-P-BBG 003670 END-IF 003671 END-IF 003672** ------------------------------------------- 003673 ELSE 003674 MOVE "DBEZ048" TO H-FEHLER 003675 MOVE "N" TO HFELD-P-BBG 003676 END-IF 003677 END-IF 003678 END-IF 003679** ---------------------------------------------------- 003680** 5314042 ENDE 003681** ---------------------------------------------------- 003682 END-IF 003683 END-IF 003684 END-IF 003685 . 003686 003687 003688 T5314041-EXIT. 003690 EXIT. 003700 026510*COPY CDBEZ050 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ050 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ABGABEGRUND 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 26.10.2003 001630** VERSION : 002 001650**---------------------------------------------------------------- 001660** PROGRAMMIERER : MICHAEL KLEMKE 001670** ERSTELLUNGSDATUM : 13.10.2004 001680** VERSION : 003 / VERSION 41 001690**---------------------------------------------------------------- 001691** PROGRAMMIERER : MICHAEL KLEMKE 001692** ERSTELLUNGSDATUM : 31.10.2005 001693** VERSION : 004 / VERSION 50 001694**---------------------------------------------------------------- 001695** PROGRAMMIERER : MICHAEL KLEMKE 001696** ERSTELLUNGSDATUM : 12.10.2006 001697** VERSION : 005 / VERSION 56 001698**---------------------------------------------------------------- 001700 FDBEZ050 SECTION. 001710 FDBEZ050E. 001720** ------------------------------------------------------------- 001730** T531405 001740** ------------------------------------------------------------- 001800 IF E14-ZREN-NUM NUMERIC 001930 DIVIDE 4 INTO E14-ZREN-JJ GIVING ERG 001940 REMAINDER SCHALTJAHR 001950 IF E14-ZREN-MM > ZERO AND < 13 001960 AND E14-ZREN-TT > ZERO 001970 AND <= TGT(SCHALTJAHR + 1, E14-ZREN-MM) THEN 002010 MOVE P-DATE TO HDATUM 002020 IF HDATMM <= 11 THEN 002030 MOVE HDATMM TO MON-ENDE-IND 002040 ADD 1 TO MON-ENDE-IND 002050 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 002060 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 002070 ELSE IF HDATMM = 12 THEN 002080 MOVE 1 TO MON-ENDE-IND 002090 MOVE MON-TAB-MM(MON-ENDE-IND) TO HDATMM 002091 MOVE MON-TAB-TT(MON-ENDE-IND) TO HDATTT 002092 ADD 1 TO HDATJHJJ 002093 END-IF 002094 END-IF 002095 IF E14-ZREN-NUM <= HDATUM THEN 002096** ---------------------------------------------------- 002097** T5314051 002098** ---------------------------------------------------- 002099 IF E14-ZRBE-NUM NOT NUMERIC THEN 002100** ------------------------------------------------- 002101** AUFRUF T5314052 002102** ------------------------------------------------- 002103 PERFORM T5314052 002105 ELSE 002106 IF E14-ZREN < E14-ZRBE THEN 002107 MOVE "DBEZ054" TO H-FEHLER 002108 MOVE "N" TO HFELD-P-BBG 002110 ELSE 002111 IF E14-ZREN-JHJJ = E14-ZRBE-JHJJ 002112** ------------------------------------------- 002113** AUFRUF T5314052 002114** ------------------------------------------- 002116 PERFORM T5314052 002117 ELSE 002118 MOVE "DBEZ056" TO H-FEHLER 002119 MOVE "N" TO HFELD-P-BBG 002120 END-IF 002121 END-IF 002122 END-IF 002123 ELSE 002124 MOVE "DBEZ058" TO H-FEHLER 002125 MOVE "N" TO HFELD-P-BBG 002130 END-IF 002190 ELSE 002191 MOVE "DBEZ052" TO H-FEHLER 002192 MOVE "N" TO HFELD-P-BBG 002193 END-IF 002194 ELSE 002195 MOVE "DBEZ050" TO H-FEHLER 002196 MOVE "N" TO HFELD-P-BBG 002199 END-IF 002200 . 003330 FDBEZ050-EXIT. 003400 EXIT. 003500 003530 003600 T5314052 SECTION. 003610 T5314052E. 003620** ------------------------------------------------------------- 003630** T5314052 003640** ------------------------------------------------------------- 003650 IF E14-LEAT = "42" THEN 003660 IF E14-ZREN-NUM > 20030331 THEN 003670 MOVE "DBEZ060" TO H-FEHLER 003680 MOVE "N" TO HFELD-P-BBG 003681 ELSE 003682** ------------------------------------------------------- 003683** AUFRUF T5314053 003684** ------------------------------------------------------- 003685 PERFORM T5314053 003705 END-IF 003706 ELSE 003707 IF E14-LEAT = "50" THEN 003708 IF E14-ZREN-NUM > 20080831 THEN 003709 MOVE "DBEZ062" TO H-FEHLER 003710 MOVE "N" TO HFELD-P-BBG 003711 ELSE 003712** ---------------------------------------------------- 003713** AUFRUF T5314053 003714** ---------------------------------------------------- 003715 PERFORM T5314053 003716 END-IF 003717 ELSE 003718 IF E14-LEAT = "23" OR "41" THEN 003719 IF E14-ZREN-NUM > 20041231 THEN 003720 MOVE "DBEZ061" TO H-FEHLER 003721 MOVE "N" TO HFELD-P-BBG 003722 ELSE 003723** ------------------------------------------------- 003724** AUFRUF T5314053 003725** ------------------------------------------------- 003726 PERFORM T5314053 003727 END-IF 003728 ELSE 003729** ---------------------------------------------------- 003730** AUFRUF T5314053 003731** ---------------------------------------------------- 003732 PERFORM T5314053 003733 END-IF 003734 END-IF 003740 END-IF 003800 . 003900 T5314052-EXIT. 004000 EXIT. 004300 004400 004500 T5314053 SECTION. 004600 T5314053E. 004700** ------------------------------------------------------------- 004800** T5314053 004900** ------------------------------------------------------------- 005000 IF E14-LEAT = "43" OR "44" THEN 005001 IF HFELD-P-GBDT = "N" 005002 CONTINUE 005003 ELSE 005010 MOVE SIC-GEB TO HFELD-GEB 005011 COMPUTE HFELD-GEB-JHJJ = HFELD-GEB-JHJJ + 65 005012 IF E14-ZREN-NUM < HFELD-GEB 005013 CONTINUE 005014 ELSE 005015 MOVE "DBEZ064" TO H-FEHLER 005016 MOVE "N" TO HFELD-P-BBG 005020 END-IF 005021 END-IF 005030 END-IF 005100 . 005110 005120 005200 T5314053-EXIT. 005300 EXIT. 005400 005500 026600*COPY CDBEZ080 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ080 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG WäHRUNGSKENNZEICHEN 001600**---------------------------------------------------------------- 001700 FDBEZ080 SECTION. 001710 FDBEZ080E. 001800 IF E14-WG NOT = "D" AND NOT = "E" AND NOT = " " THEN 001900 MOVE "DBEZ082" TO H-FEHLER 001910 MOVE "N" TO HFELD-P-BBG 002000 GO TO FDBEZ080-EXIT 002010 ELSE 002011 IF E14-ZRBE-NUM NOT NUMERIC THEN 002013 GO TO FDBEZ080-EXIT 002014 END-IF 002015 IF E14-ZREN-NUM NOT NUMERIC THEN 002016 GO TO FDBEZ080-EXIT 002017 END-IF 002020 IF E14-WG = "D" THEN 002030 IF E14-ZRBE-NUM > 20011231 OR 002031 (E14-ZRBE-NUM = 0 AND E14-ZREN-NUM > 002032 20011231) THEN 002040 MOVE "DBEZ086" TO H-FEHLER 002041 MOVE "N" TO HFELD-P-BBG 002050 GO TO FDBEZ080-EXIT 002051 ELSE 002052 GO TO FDBEZ080-EXIT 002053 END-IF 002060 ELSE 002061 IF E14-WG = "E" THEN 002070 IF E14-ZRBE-NUM < 20020101 OR 002071 (E14-ZRBE-NUM = 0 AND E14-ZREN-NUM 002072 < 20020101) THEN 002080 MOVE "DBEZ084" TO H-FEHLER 002081 MOVE "N" TO HFELD-P-BBG 002082 GO TO FDBEZ080-EXIT 002090 ELSE 002091 GO TO FDBEZ080-EXIT 002092 END-IF 002095 END-IF 002096 END-IF 002097 END-IF 002100 . 003330 FDBEZ080-EXIT. 003400 EXIT. 026700*COPY CDBEZ090 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ090 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG ENTGELT 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 14.10.2004 001630** VERSION : 002 / VERSION 41 001650**---------------------------------------------------------------- 001700 FDBEZ090 SECTION. 001710 FDBEZ090E. 001800 IF E14-EG-NUM NUMERIC THEN 001810 IF E14-EG = "000000" THEN 001820 IF E14-ZRBE-NUM NUMERIC THEN 001830 IF E14-ZRBE-NUM < 19920101 THEN 001840 MOVE "N" TO HFELD-P-EG 001900 ELSE 002000 IF E14-LEAT = "43" OR "44" 002001 CONTINUE 002002 ELSE 002003 MOVE "DBEZ094" TO H-FEHLER 002004 MOVE "N" TO HFELD-P-EG 002006 END-IF 002007 END-IF 002008 ELSE 002009 MOVE "N" TO HFELD-P-EG 002010 END-IF 002011 ELSE 002012 IF E14-WG = " " THEN 002013 MOVE "DBEZ095" TO H-FEHLER 002014 MOVE "N" TO HFELD-P-EG 002018 END-IF 002021 END-IF 002022 ELSE 002023 MOVE "DBEZ090" TO H-FEHLER 002024 MOVE "N" TO HFELD-P-EG 002025 END-IF 002100 . 002200 002300 003330 FDBEZ090-EXIT. 003400 EXIT. 003500 003600 026710*COPY CDBEZ100 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ100 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG BEITRAGSANTEIL 001400**---------------------------------------------------------------- 001500** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001510** ÄNDERUNG : 002 VOM 10.01.2001 VERSION 22 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ÄNDERUNG : 003 VOM 24.02.2003 VERSION 31 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 004 VOM 14.10.2004 VERSION 41 001660**---------------------------------------------------------------- 001700 FDBEZ100 SECTION. 001710 FDBEZ100E. 001800 IF E14-BY-NUM NOT NUMERIC THEN 001900 MOVE "DBEZ100" TO H-FEHLER 001910 MOVE "N" TO HFELD-P-BY 002000 GO TO FDBEZ100-EXIT 002010 ELSE 002020 IF E14-LEAT = "02" OR "03" OR "06" OR "09" OR 002021 "21" OR "22" OR "23" OR 002022 "25" OR "26" OR "27" OR "28" OR "29" OR 002023 "30" OR "31" OR "32" OR "33" OR 002024 "40" OR "41" OR 002028 "42" OR "43" OR "44" OR "50" THEN 002030 IF E14-BY-NUM = 0 THEN 002040 MOVE "N" TO HFELD-P-BY 002050 GO TO FDBEZ100-EXIT 002060 ELSE 002061 MOVE "DBEZ102" TO H-FEHLER 002062 MOVE "N" TO HFELD-P-BY 002070 GO TO FDBEZ100-EXIT 002080 END-IF 002090 ELSE 002100 IF E14-BY-NUM = 0 THEN 002110 MOVE "N" TO HFELD-P-BY 002120 GO TO FDBEZ100-EXIT 002130 ELSE 002140 IF E14-WG = " " THEN 002141 MOVE "DBEZ106" TO H-FEHLER 002142 MOVE "N" TO HFELD-P-BY 002143 GO TO FDBEZ100-EXIT 002144 END-IF 002145 END-IF 002150 END-IF 002200 . 003330 FDBEZ100-EXIT. 003400 EXIT. 026800*COPY CDBEZ160 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ160 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN RECHTSKREIS 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : GERTRAUD SCHUHMACHER 001620** ÄNDERUNG : 001 VOM 15.11.2000 001630**---------------------------------------------------------------- 001640** PROGRAMMIERER : MICHAEL KLEMKE 001650** ÄNDERUNG : 14.10.2004 001651** VERSION : 003 / VERSION 41 001660**---------------------------------------------------------------- 001700 FDBEZ160 SECTION. 001710 FDBEZ160E. 001800 IF E14-KENNZRK NOT = "W" AND NOT = "O" THEN 001900 MOVE "DBEZ160" TO H-FEHLER 002010 ELSE 002020 IF E14-LEAT = "25" OR "26" THEN 002030 IF E14-KENNZRK = "O" THEN 002040 GO TO FDBEZ160-EXIT 002050 ELSE 002060 MOVE "DBEZ164" TO H-FEHLER 002070 GO TO FDBEZ160-EXIT 002080 END-IF 002081 ELSE 002082 IF E14-LEAT = "23" OR "43" OR "44" THEN 002083 IF E14-KENNZRK = "O" THEN 002084 MOVE "DBEZ166" TO H-FEHLER 002085 GO TO FDBEZ160-EXIT 002086 ELSE 002087 GO TO FDBEZ160-EXIT 002090 END-IF 002091 END-IF 002092 END-IF 002093 END-IF 002100 . 003330 FDBEZ160-EXIT. 003400 EXIT. 026900*COPY CDBEZ180 REPLACING ==:S13:== BY ==E14==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDBEZ180 001000** PROGRAMMIERER : WERNER KRAUS 001100** ERSTELLUNGSDATUM : 23.03.1998 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG KENNZEICHEN RECHTSKREIS 001600**---------------------------------------------------------------- 001700 FDBEZ180 SECTION. 001710 FDBEZ180E. 001800 IF E14-KENNZWE NOT = "N" AND NOT = "J" THEN 001900 MOVE "DBEZ180" TO H-FEHLER 002010 END-IF 002100 . 003330 FDBEZ180-EXIT. 003400 EXIT. 026910*COPY CDBEZBBG REPLACING ==:S13:== BY ==E14== 026920* ==:S11:== BY ==E12==. 001700**---------------------------------------------------------------- 001800** COPY-MEMBER : CDBEZBBG 001900** PROGRAMMIERER : WERNER KRAUS 002000** ERSTELLUNGSDATUM : 23.03.1998 002100** VERSION : 001 (PGM-NEUERSTELLUNG) 002200** FUNKTION : PRüFUNG BEITRAGSBEMESSUNGSGRENZE 002300**---------------------------------------------------------------- 002310** ÄNDERUNG : 18.04.2005 002320** VERSION : 002 / VERSION 45 / 01 002340**---------------------------------------------------------------- 002350** ÄNDERUNG : 08.12.2006 002360** VERSION : 003 / VERSION 58 002370**---------------------------------------------------------------- 002400 FDBEZBBG SECTION. 002500 FDBEZBBGE. 002510** ------------------------------------------------------------- 002520** T531411 002530** ------------------------------------------------------------- 002600 IF HFELD-P-BBG = "N" THEN 002700 GO TO FDBEZBBG-EXIT 002800 ELSE 002900 IF HFELD-P-EG = "N" THEN 002910** ------------------------------------------------------- 002911** T531411-2 002930** ------------------------------------------------------- 003000 IF E14-ZRBE-NUM < 19920101 THEN 003100 GO TO FDBEZBBG-EXIT 003200 ELSE 003300 IF HFELD-P-BY = "N" THEN 003400 GO TO FDBEZBBG-EXIT 003500 ELSE 003600 PERFORM BBGDBEZ 003610** ------------------------------------------------- 003611** T531411-3 003630** ------------------------------------------------- 003700 IF HFELD-FE = "F1" THEN 003800 MOVE "DBEZ104" TO H-FEHLER 003900 GO TO FDBEZBBG-EXIT 004000 ELSE 004100 GO TO FDBEZBBG-EXIT 004200 END-IF 004210** ------------------------------------------------- 004300 END-IF 004400 END-IF 004410** ------------------------------------------------------- 004420** T531411-2 ENDE 004430** ------------------------------------------------------- 004500 ELSE 004600 IF E14-ZRBE-NUM < 19910101 THEN 004700 IF E14-KENNZRK = "O" THEN 004710** ------------------------------------------------- 004720** T531411-2 004730** ------------------------------------------------- 004800 IF E14-ZRBE-NUM < 19920101 THEN 004900 GO TO FDBEZBBG-EXIT 005000 ELSE 005100 IF HFELD-P-BY = "N" THEN 005200 GO TO FDBEZBBG-EXIT 005300 ELSE 005400 PERFORM BBGDBEZ 005410** ------------------------------------------- 005420** T531411-3 005421** ------------------------------------------- 005500 IF HFELD-FE = "F1" THEN 005600 MOVE "DBEZ104" TO H-FEHLER 005700 GO TO FDBEZBBG-EXIT 005800 ELSE 005900 GO TO FDBEZBBG-EXIT 006000 END-IF 006010** ------------------------------------------- 006100 END-IF 006200 END-IF 006210** ------------------------------------------------- 006220** T531411-2 ENDE 006230** ------------------------------------------------- 006300 ELSE 006310** ------------------------------------------------- 006320** T531411-1 ANFANG 006330** ------------------------------------------------- 006400 MOVE E14-ZRBE-NUM TO HFELD-BE 006500 MOVE E14-ZREN-NUM TO HFELD-EN 006600 MOVE E14-WG TO HFELD-WG 006700 MOVE E14-EG TO HFELD-EG 006800 MOVE 0 TO HFELD-PERSGR 006900 MOVE E14-KENNZRK TO HFELD-OST-WEST 007000 MOVE E14-LEAT TO HFELD-LEAT 007100 MOVE E12-VSTR TO HFELD-VSTR 007110 MOVE E12-BBNRVU(1:3) TO HFELD-BBNRVU-1-3 007200 PERFORM FBBG-PRUEF 007300 IF HFELD-FE = "F1" THEN 007301 IF E14-LEAT = "43" OR "44" 007303** ------------------------------------------- 007304** 08.12.2006 (Version-58) 007305** ------------------------------------------- 007307 IF E14-ZRBE-NUM > 20061231 THEN 007308 MOVE "DBEZ098" TO H-FEHLER 007309 PERFORM FEHLER 007320 ELSE 007400 MOVE "DBEZ097" TO H-FEHLER 007401 PERFORM FEHLER 007402 END-IF 007410 ELSE 007510 MOVE "DBEZ096" TO H-FEHLER 007520 PERFORM FEHLER 007600 END-IF 007610 END-IF 007700** ------------------------------------------------- 007710** T531411-1 ENDE 007720** ------------------------------------------------- 007730** T531411-2 ANFANG 007740** ------------------------------------------------- 007800 IF E14-ZRBE-NUM < 19920101 THEN 007900 GO TO FDBEZBBG-EXIT 008000 ELSE 008100 IF HFELD-P-BY = "N" THEN 008200 GO TO FDBEZBBG-EXIT 008300 ELSE 008400 PERFORM BBGDBEZ 008500 IF HFELD-FE = "F1" THEN 008600 MOVE "DBEZ104" TO H-FEHLER 008700 GO TO FDBEZBBG-EXIT 008800 ELSE 008900 GO TO FDBEZBBG-EXIT 009000 END-IF 009100 END-IF 009200 END-IF 009310** ------------------------------------------------- 009320** T531411-2 ENDE 009330** ------------------------------------------------- 009400 END-IF 009500 ELSE 009510** ------------------------------------------------- 009520** T531411-1 009530** ------------------------------------------------- 009600 MOVE E14-ZRBE-NUM TO HFELD-BE 009700 MOVE E14-ZREN-NUM TO HFELD-EN 009800 MOVE E14-WG TO HFELD-WG 009900 MOVE E14-EG TO HFELD-EG 010000 MOVE 0 TO HFELD-PERSGR 010100 MOVE E14-KENNZRK TO HFELD-OST-WEST 010200 MOVE E14-LEAT TO HFELD-LEAT 010300 MOVE E12-VSTR TO HFELD-VSTR 010310 MOVE E12-BBNRVU(1:3) TO HFELD-BBNRVU-1-3 010400 PERFORM FBBG-PRUEF 010410 IF HFELD-FE = "F1" THEN 010420 IF E14-LEAT = "43" OR "44" 010421** ---------------------------------------------- 010422** 19.12.2006 (Version-58) 010423** ---------------------------------------------- 010424 IF E14-ZRBE-NUM > 20061231 THEN 010425 MOVE "DBEZ098" TO H-FEHLER 010426 PERFORM FEHLER 010427 ELSE 010428 MOVE "DBEZ097" TO H-FEHLER 010429 PERFORM FEHLER 010430 END-IF 010431 ELSE 010432 MOVE "DBEZ096" TO H-FEHLER 010433 PERFORM FEHLER 010480 END-IF 010490 END-IF 010500** ------------------------------------------------- 010600** T531411-1 ENDE 010700** ------------------------------------------------- 010800** T531411-2 ANFANG 010900** ------------------------------------------------- 011000 IF E14-ZRBE-NUM < 19920101 THEN 011100 GO TO FDBEZBBG-EXIT 011200 ELSE 011300 IF HFELD-P-BY = "N" THEN 011400 GO TO FDBEZBBG-EXIT 011500 ELSE 011600 PERFORM BBGDBEZ 011700 IF HFELD-FE = "F1" THEN 011800 MOVE "DBEZ104" TO H-FEHLER 011900 GO TO FDBEZBBG-EXIT 012000 ELSE 012100 GO TO FDBEZBBG-EXIT 012200 END-IF 012300 END-IF 012400 END-IF 012510** ------------------------------------------------- 012520** T531411-2 ENDE 012530** ------------------------------------------------- 012600 END-IF 012700 END-IF 012800 END-IF 012900 . 012910 012920 013000 FDBEZBBG-EXIT. 013100 EXIT. 013110 013120 013200 BBGDBEZ SECTION. 013300 BBGDBEZE. 013400 MOVE E14-ZRBE-NUM TO HFELD-BE 013500 MOVE E14-ZREN-NUM TO HFELD-EN 013600 MOVE E14-WG TO HFELD-WG 013700 MOVE "W" TO HFELD-OST-WEST 013800 MOVE "OG" TO HFELD-VSTR 013810 MOVE E12-BBNRVU(1:3) TO HFELD-BBNRVU-1-3 013900 PERFORM FBBY-PRUEF 014000 . 014010 014020 014100 BBGDBEZ-EXIT. 014200 EXIT. 014300 014400 027000*COPY BBGPRUEF REPLACING ==:S0:== BY ==E1== 027100* ==:S1:== BY ==E2== 027101* ==:S11:== BY ==E12== 027102* ==:S13:== BY ==E14==. 101710**---------------------------------------------------------------- 101720** COPY-MEMBER : BBGPRUEF 101730** PROGRAMMIERER : WERNER KRAUS 101740** ERSTELLUNGSDATUM : 07.05.1998 101750** VERSION : 001 (PGM-NEUERSTELLUNG) 101760** FUNKTION : ERMITTLUNG BEITRAGSBEMESSUNGSGRENZE 101770**---------------------------------------------------------------- 101771** PROGRAMMIERER : MICHAEL KLEMKE 101772** ÄnderungsSDATUM : 15.10.2001 101773** VERSION : 002 101774** FUNKTION : ERMITTLUNG BEITRAGSBEMESSUNGSGRENZE 101775**---------------------------------------------------------------- 101776** PROGRAMMIERER : MICHAEL KLEMKE 101777** ÄnderungsSDATUM : 27.03.2002 101778** VERSION : 003 101779** FUNKTION : PRÜFEN PERSGR 209 AUF GERINGF.(VERSION 27) 101780**---------------------------------------------------------------- 101781** PROGRAMMIERER : MICHAEL KLEMKE 101782** ÄnderungsSDATUM : 26.10.2003 101783** VERSION : 004 101785**---------------------------------------------------------------- 101786** PROGRAMMIERER : MICHAEL KLEMKE 101787** ÄNDERUNGSSDATUM : 19.05.2004 - VERSION 40 101788** VERSION : 005 101789**---------------------------------------------------------------- 101790** PROGRAMMIERER : MICHAEL KLEMKE 101791** ÄNDERUNGSSDATUM : 14.10.2004 - VERSION 41 101792** VERSION : 006 101793**---------------------------------------------------------------- 101794** PROGRAMMIERER : MICHAEL KLEMKE 101795** ÄNDERUNGSSDATUM : 08.12.2004 - VERSION 42 101796** VERSION : 007 101797**---------------------------------------------------------------- 101798** PROGRAMMIERER : MICHAEL KLEMKE 101799** ÄNDERUNGSSDATUM : 31.10.2005 - VERSION 50 101800** VERSION : 008 101801**---------------------------------------------------------------- 101802** PROGRAMMIERER : MICHAEL KLEMKE 101803** ÄNDERUNGSSDATUM : 08.12.2006 - VERSION 58 101804** VERSION : 008 101805**---------------------------------------------------------------- 101806 FBBG-PRUEF SECTION. 101807 FBBG-PRUEFE. 101808 MOVE "N" TO SCHALTJ 101810 MOVE 0228 TO TB-MOTG(2) 101820 MOVE 0 TO HFELD-TAGE 101830 MOVE 0 TO HFELD-JBBG 101840 MOVE 0 TO HFELD-BBG 101850** PRüFUNG OB SCHALTJ 101860 IF HFELD-BE-JJ = 0 THEN 101870 MOVE HFELD-BE-JHJJ TO HFELD-BE-R 101880 DIVIDE HFELD-BE-R BY 400 GIVING RFELD1 REMAINDER 101890 REST1 101900 IF REST1 = 0 THEN 101910 MOVE "J" TO SCHALTJ 101920** FEBRUAR MIT 29 TAGEN BELEGEN 101930 MOVE 0229 TO TB-MOTG(2) 101940 END-IF 101950 ELSE 101960 DIVIDE HFELD-BE-JJ BY 4 GIVING RFELD1 REMAINDER 101970 REST1 101980 IF REST1 = 0 THEN 101990 MOVE "J" TO SCHALTJ 102000** FEBRUAR MIT 29 TAGEN BELEGEN 102010 MOVE 0229 TO TB-MOTG(2) 102020 END-IF 102030 END-IF 102040** ERMITTLUNG DER ANZAHL DER TAGE 102050** BEI BESCHäFTIGTEN IMMER 01.01. (nur bei DSME) 102060 IF ST-DSME 102070 MOVE E1-PERSGR TO BBG-PERSGR-TAB 102080 IF NOT BBG-PERSGR-OK THEN 102090** BEI BESCHäFTIGTEN BEGINN IMMER 01.01. 102100 MOVE 0101 TO HFELD-BE-MT 102110 END-IF 102120 END-IF 102130** ERMITTELN OB MONATSANFANG BZW ANZAHL DER TAGE IM MONAT 102140 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-BE-MM = 102150 TB-MO(I) OR I > 12 102160 CONTINUE 102170 END-PERFORM 102180 IF HFELD-BE-TT = 01 THEN 102190 MOVE 1 TO MON-ANF 102200 ELSE 102210** TATSäCHLICHE ANZAHL TAGE IM BEGINNMONAT 102220 COMPUTE BE-MO-TAGE = TB-TG(I) - HFELD-BE-TT + 1 102230 END-IF 102240** ERMITTELN OB MONATSENDE BZW ANZAHL DER TAGE IM MONAT 102250 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-EN-MM = 102260 TB-MO(I) OR I > 12 102270 CONTINUE 102280 END-PERFORM 102290 IF HFELD-EN-TT = TB-TG(I) 102300 MOVE 1 TO MON-END 102310 ELSE 102320 MOVE HFELD-EN-TT TO EN-MO-TAGE 102330 END-IF 102340** BERECHNUNG TAGE 102350 IF HFELD-BE-MM = HFELD-EN-MM 102360** Z.B. 05.01 BIS 28.01. 102370 COMPUTE HFELD-TAGE = HFELD-EN-TT - HFELD-BE-TT + 1 102380** VOLLE MONATE IMMER MIT 30 TAGEN 102390 IF HFELD-TAGE > 30 THEN 102400 MOVE 30 TO HFELD-TAGE 102410 END-IF 102420 IF HFELD-EN-MM = 02 THEN 102430 IF HFELD-TAGE >= 28 AND SCHALTJ = "N" 102440 MOVE 30 TO HFELD-TAGE 102450 ELSE IF HFELD-TAGE > 28 AND SCHALTJ = "J" THEN 102460 MOVE 30 TO HFELD-TAGE 102470 END-IF 102471 END-IF 102480 END-IF 102490 ELSE 102500 IF MON-ANF = 1 AND MON-END = 1 102510** Z.B. 01.03. BIS 30.06. 102520 COMPUTE HFELD-TAGE = ((HFELD-EN-MM - HFELD-BE-MM) 102530 + 1 ) * 30 102540 ELSE 102550 IF MON-ANF = 1 102560** Z.B. 01.03. BIS 17.06. 102570 COMPUTE HFELD-TAGE = ((HFELD-EN-MM - HFELD-BE-MM) 102580 * 30) + EN-MO-TAGE 102590 ELSE 102600 IF MON-END = 1 102610** Z.B. 15.03. BIS 30.06. 102620 COMPUTE HFELD-TAGE = ((HFELD-EN-MM - HFELD-BE-MM) 102630 * 30) + BE-MO-TAGE 102640 ELSE 102650 IF (HFELD-EN-MM - HFELD-BE-MM) > 1 102660** Z.B. 15.03. BIS 18.06. 102670 COMPUTE HFELD-TAGE = (((HFELD-EN-MM - 102680 HFELD-BE-MM) - 1) * 30) 102690 + BE-MO-TAGE + EN-MO-TAGE 102700 ELSE 102710** Z.B. 15.03. BIS 18.04. 102720 COMPUTE HFELD-TAGE = BE-MO-TAGE + EN-MO-TAGE 102730 END-IF 102740 END-IF 102750 END-IF 102760 END-IF 102770 END-IF 102780 IF HFELD-KENN = "DSME" THEN 102790 IF HFELD-PERSGR = 301 OR 302 OR 303 THEN 102800** WEHR- ODER ZIVILDIENSTLEISTENDE 102810 PERFORM BBG-TB 102820 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 THEN 102830 MOVE 9000 TO RC-SAVE 102840 GO TO BBG-PRUEF-EXIT 102850 END-IF 102860 COMPUTE HFELD-BBG = (HFELD-TAGE * HFELD-JBBG) / 360 102870** AUF VOLLE DM/EURO AUFRUNDEN 102880 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 102890 IF HFELD-EG > HFELD-BBG-DM THEN 102900 MOVE "F1" TO HFELD-FE 102910 END-IF 102920 ELSE 102930 IF HFELD-PERSGR = 207 OR 208 THEN 102940 PERFORM BEZUG-TB 102950 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 THEN 102960 MOVE 9000 TO RC-SAVE 102970 GO TO BBG-PRUEF-EXIT 102980 END-IF 102990 COMPUTE HFELD-BBG = (HFELD-TAGE * HFELD-JBBG 103000 * 0,8) / 360 103010** AUF VOLLE DM/EURO AUFRUNDEN 103020 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103030 IF HFELD-EG > HFELD-BBG-DM THEN 103040 MOVE "F3" TO HFELD-FE 103050 END-IF 103060 ELSE 103061** ----------------------------------------------------- 103062** ÄNDERUNG VOM 26.10.2003 / VERSION 36 103063** ----------------------------------------------------- 103070** IF HFELD-PERSGR = 201 OR 209 OR 210 THEN 103071 IF HFELD-PERSGR = 201 THEN 103072** ----------------------------------------------------- 103080 PERFORM BBG-TB 103090 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 THEN 103100 MOVE 9000 TO RC-SAVE 103110 GO TO BBG-PRUEF-EXIT 103120 END-IF 103130 COMPUTE HFELD-BBG = (HFELD-TAGE * HFELD-JBBG) 103140 / 360 103150** AUF VOLLE DM/EURO AUFRUNDEN 103160 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103170 IF HFELD-EG > HFELD-BBG-DM THEN 103180 MOVE "F1" TO HFELD-FE 103190 ELSE 103191** ----------------------------------------------- 103192** 7.3 PRÜFUNG DER BBG FÜR PERS.IM HAUSHALTSSCH. 103193** ----------------------------------------------- 103200 MOVE 0 TO HFELD-ANZ-MO 103210 MOVE 0 TO HFELD-BBG 103220 COMPUTE HFELD-ANZ-MO = HFELD-EN-MM 103230 - HFELD-BE-MM + 1 103231** ----------------------------------------------- 103232** ÄNDERUNG 27-03-2002 (VERSION 27) 103233** ----------------------------------------------- 103234 IF E2-WG = "E" 103240 COMPUTE HFELD-BBG = HFELD-ANZ-MO * 767 103241 ELSE 103242 COMPUTE HFELD-BBG = HFELD-ANZ-MO * 1500 103243 END-IF 103250 IF HFELD-EG > HFELD-BBG THEN 103260 MOVE "F2" TO HFELD-FE 103295 END-IF 103296 END-IF 103303 ELSE 103304** -------------------------------------------------- 103305** ÄNDERUNG VOM 26.10.2003 / VERSION 36 103306** -------------------------------------------------- 103307** IF HFELD-PERSGR = 109 THEN 103308 IF HFELD-PERSGR = 109 OR 209 THEN 103309** ----------------------------------------------- 103310** 7.7 PRÜFUNG GERINGF. BESCHÄFTIGTE 103311** ----------------------------------------------- 103312 PERFORM BBG-TB 103313 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 103314 MOVE 9000 TO RC-SAVE 103315 GO TO BBG-PRUEF-EXIT 103316 END-IF 103317 COMPUTE HFELD-BBG = (HFELD-JBBG * 60) / 360 103318 IF HFELD-TAGE > 60 103319 COMPUTE HFELD-TAGE = HFELD-TAGE - 60 103320 IF HFELD-WG = "D" THEN 103321 COMPUTE HFELD-BBG = 103322 HFELD-BBG + HFELD-TAGE * 21 103323 ELSE 103324** ----------------------------------------- 103325** VERSION-50 (31.10.2005) 103326** ----------------------------------------- 103327 IF E2-ZRBG < 20030101 103328 COMPUTE HFELD-BBG = 103329 HFELD-BBG + HFELD-TAGE * 11 103330 ELSE 103331 COMPUTE HFELD-BBG = 103332 HFELD-BBG + HFELD-TAGE * 14 103333 END-IF 103334** ----------------------------------------- 103338 END-IF 103339 END-IF 103340** ----------------------------------------------- 103341** AUF VOLLE DM/EURO AUFRUNDEN 103342** ----------------------------------------------- 103343 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103344 IF HFELD-EG > HFELD-BBG-DM THEN 103345 MOVE "F4" TO HFELD-FE 103346 END-IF 103347** -------------------------------------------------- 103348 ELSE 103349** ----------------------------------------------- 103350** ABSCHNITT 7.4 103351** ----------------------------------------------- 103352 PERFORM BBG-TB 103353 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 103354 MOVE 9000 TO RC-SAVE 103355 GO TO BBG-PRUEF-EXIT 103356 END-IF 103357 COMPUTE HFELD-BBG = (HFELD-TAGE * HFELD-JBBG) 103360 / 360 103371** ----------------------------------------------- 103372** ÄNDERUNG VOM 19.05.2004 / VERSION 40 103373** ----------------------------------------------- 103374 MOVE 0 TO HFELD-ZUSCHLAG 103375 IF E12-MMEZ = "J" 103376 IF E14-ZRBE-MM = 2 AND 103377 E14-ZRBE-TT > 1 103378** DIVIDE 4 INTO :S13:-ZRBE-JJ GIVING ERG 103379** REMAINDER SCHALTJAHR 103380** IF SCHALTJAHR = 0 AND ERG > 0 103381 IF SCHALTJ = "J" 103382** -------------------------------------- 103383** SCHALTJAHR 103384** -------------------------------------- 103385 IF E14-ZREN-MM > 2 OR 103386 E14-ZREN-MM = 2 AND 103387 E14-ZREN-TT = 29 103388 MOVE 1 TO HFELD-ZUSCHLAG 103389 END-IF 103390 ELSE 103391** -------------------------------------- 103392** KEIN SCHALTJAHR 103393** -------------------------------------- 103394 IF E14-ZREN-MM > 2 OR 103395 E14-ZREN-MM = 2 AND 103396 E14-ZREN-TT = 28 103397 MOVE 2 TO HFELD-ZUSCHLAG 103398 END-IF 103399 END-IF 103400 END-IF 103401 END-IF 103402 COMPUTE HFELD-BBG = HFELD-BBG + 103403 (HFELD-JBBG * HFELD-ZUSCHLAG) / 360 103404 COMPUTE HFELD-BBG = HFELD-BBG * 1,033333 103409** ----------------------------------------------- 103410 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103411 IF HFELD-EG > HFELD-BBG-DM THEN 103412 MOVE "F1" TO HFELD-FE 103413 END-IF 103414 END-IF 103420 END-IF 103430 END-IF 103440 END-IF 103450 ELSE 103460 IF HFELD-LEAT >= 20 AND <= 33 THEN 103470 PERFORM BBG-TB 103480 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 THEN 103490 MOVE 9000 TO RC-SAVE 103500 GO TO BBG-PRUEF-EXIT 103510 END-IF 103520 COMPUTE HFELD-BBG = (HFELD-TAGE * HFELD-JBBG) / 360 103530 COMPUTE HFELD-BBG = HFELD-BBG * 1,06 103540 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103550 IF HFELD-EG > HFELD-BBG-DM THEN 103560 MOVE "F1" TO HFELD-FE 103570 END-IF 103580 ELSE 103581 IF HFELD-LEAT = 43 OR 44 103582** ---------------------------------------------------- 103583** ABSCHNITT 7.8 103584** ---------------------------------------------------- 103585** 08.12.2006 (VERSION-58) 103586** ---------------------------------------------------- 103587 IF E14-ZRBE-NUM > 20061231 THEN 103588 MOVE 2460 TO HFELD-JBBG 103591 ELSE 103592 MOVE 4800 TO HFELD-JBBG 103593 END-IF 103595 COMPUTE HFELD-BBG = 103596 (HFELD-TAGE * HFELD-JBBG) / 360 103597 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103598 IF HFELD-EG > HFELD-BBG-DM THEN 103599 MOVE "F1" TO HFELD-FE 103600 END-IF 103601 ELSE 103602** ---------------------------------------------------- 103603** ABSCHNITT 7.4 103604** ---------------------------------------------------- 103605 PERFORM BBG-TB 103606 IF HFELD-JBBG NOT NUMERIC OR HFELD-JBBG = 0 THEN 103610 MOVE 9000 TO RC-SAVE 103620 GO TO BBG-PRUEF-EXIT 103630 END-IF 103640 COMPUTE HFELD-BBG = (HFELD-TAGE * HFELD-JBBG) 103650 / 360 103661 103662** ---------------------------------------------------- 103664** ÄNDERUNG VOM 19.05.2004 / VERSION 40 103665** ---------------------------------------------------- 103667 MOVE 0 TO HFELD-ZUSCHLAG 103668 IF E12-MMEZ = "J" 103669 IF E14-ZRBE-MM = 2 AND 103670 E14-ZRBE-TT > 1 103673* DIVIDE 4 INTO :S13:-ZRBE-JJ GIVING ERG 103674* REMAINDER SCHALTJAHR 103675* IF SCHALTJAHR = 0 AND ERG > 0 103676 IF SCHALTJ = "J" 103677** ------------------------------------------- 103678** SCHALTJAHR 103679** ------------------------------------------- 103680 IF E14-ZREN-MM > 2 OR 103681 E14-ZREN-MM = 2 AND 103682 E14-ZREN-TT = 29 103683 MOVE 1 TO HFELD-ZUSCHLAG 103684 END-IF 103685 ELSE 103686** ------------------------------------------- 103687** KEIN SCHALTJAHR 103688** ------------------------------------------- 103690 IF E14-ZREN-MM > 2 OR 103691 E14-ZREN-MM = 2 AND E14-ZREN-TT = 28 103692 MOVE 2 TO HFELD-ZUSCHLAG 103693 END-IF 103694 END-IF 103697 END-IF 103698 END-IF 103699 COMPUTE HFELD-BBG = HFELD-BBG + 103700 (HFELD-JBBG * HFELD-ZUSCHLAG) / 360 103701 COMPUTE HFELD-BBG = HFELD-BBG * 1,033333 103702** ---------------------------------------------------- 103703 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BBG + 0,49 103704 IF HFELD-EG > HFELD-BBG-DM THEN 103705 MOVE "F1" TO HFELD-FE 103706 END-IF 103707 END-IF 103710 END-IF 103720 END-IF 103730 . 103740 BBG-PRUEF-EXIT. 103750 EXIT. 103760**---------------------------------------------------------- 103770** BBG-TB SECTION 103780** ERMITTELN JEWEILIGE BEITRAGSBEMESSUNGSGRENZ 103790**---------------------------------------------------------- 103800 BBG-TB SECTION. 103810 BBG-TBE. 103811** ------------------------------------------------------- 103812** TABELLE TA08 103813** ------------------------------------------------------- 103820 IF HFELD-WG = "D" THEN 103830 IF HFELD-VSTR = "0A" OR "0B" OR "AB" OR "BA" OR "BB" 103831 OR " " THEN 103840 IF HFELD-OST-WEST = "W" OR "9" THEN 103841 103842 IF HFELD-VSTR = " " AND 103843 (HFELD-BBNRVU-1-3 = "098" OR "980") 103844** ------------------------------------------- 103845** KnV West 103846** ------------------------------------------- 103847 MOVE "KNW" TO H-TB-KENN 103848 PERFORM VARYING I FROM 1 BY 1 UNTIL 103849 HFELD-BE-JHJJ = TB-EG-JAHR(I) AND TB-KENN(I) 103850 = H-TB-KENN OR TB-ELEM(I) = HIGH-VALUE 103851 CONTINUE 103852 END-PERFORM 103853 MOVE TB-BBGGRENZE(I) TO HFELD-JBBG 103855 ELSE 103856** ------------------------------------------- 103857** AV/ArV West 103858** ------------------------------------------- 103859 MOVE "AVW" TO H-TB-KENN 103860 PERFORM VARYING I FROM 1 BY 1 UNTIL 103870 HFELD-BE-JHJJ = TB-EG-JAHR(I) AND TB-KENN(I) 103880 = H-TB-KENN OR TB-ELEM(I) = HIGH-VALUE 103890 CONTINUE 103900 END-PERFORM 103910 MOVE TB-BBGGRENZE(I) TO HFELD-JBBG 103911 END-IF 103920 ELSE 103921 IF HFELD-VSTR = " " AND 103922 (HFELD-BBNRVU-1-3 = "098" OR "980") 103923** ------------------------------------------- 103924** KnV Ost 103925** ------------------------------------------- 103926 MOVE "KNO" TO H-TB-KENN 103927 PERFORM VARYING I FROM 1 BY 1 UNTIL 103928 HFELD-BE-JHJJ = TB-EG-JAHR(I) AND TB-KENN(I) 103929 = H-TB-KENN OR TB-ELEM(I) = HIGH-VALUE 103930 CONTINUE 103931 END-PERFORM 103932 MOVE TB-BBGGRENZE(I) TO HFELD-JBBG 103934 ELSE 103935** ------------------------------------------- 103936** AV/ArV Ost 103937** ------------------------------------------- 103938 MOVE "AVO" TO H-TB-KENN 103940 PERFORM VARYING I FROM 1 BY 1 UNTIL 103950 HFELD-BE-JHJJ = TB-EG-JAHR(I) AND TB-KENN(I) 103960 = H-TB-KENN OR TB-ELEM(I) = HIGH-VALUE 103970 CONTINUE 103980 END-PERFORM 103990 MOVE TB-BBGGRENZE(I) TO HFELD-JBBG 103992 104000 END-IF 104001 END-IF 104010 ELSE 104020 IF HFELD-OST-WEST = "W" OR "9" THEN 104021** ---------------------------------------------- 104022** KnV West 104023** ---------------------------------------------- 104030 MOVE "KNW" TO H-TB-KENN 104040 PERFORM VARYING I FROM 1 BY 1 UNTIL 104050 HFELD-BE-JHJJ = TB-EG-JAHR(I) AND TB-KENN(I) 104060 = H-TB-KENN OR TB-ELEM(I) = HIGH-VALUE 104070 CONTINUE 104080 END-PERFORM 104090 MOVE TB-BBGGRENZE(I) TO HFELD-JBBG 104100 ELSE 104101** ---------------------------------------------- 104102** KnV Ost 104103** ---------------------------------------------- 104110 MOVE "KNO" TO H-TB-KENN 104120 PERFORM VARYING I FROM 1 BY 1 UNTIL 104130 HFELD-BE-JHJJ = TB-EG-JAHR(I) AND TB-KENN(I) 104140 = H-TB-KENN OR TB-ELEM(I) = HIGH-VALUE 104150 CONTINUE 104160 END-PERFORM 104170 MOVE TB-BBGGRENZE(I) TO HFELD-JBBG 104180 END-IF 104190 END-IF 104200 ELSE 104201** ---------------------------------------------------- 104202** TABELLE TA08a 104203** ---------------------------------------------------- 104210 IF HFELD-VSTR = "0A" OR "0B" OR "AB" OR "BA" OR "BB" 104211 OR " " THEN 104220 IF HFELD-OST-WEST = "W" OR "9" THEN 104221 IF HFELD-VSTR = " " AND 104222 (HFELD-BBNRVU-1-3 = "098" OR "980") 104223** ------------------------------------------- 104224** KnV West 104225** ------------------------------------------- 104226 MOVE "KNW" TO H-TB-KENN 104227 PERFORM VARYING I FROM 1 BY 1 UNTIL 104228 HFELD-BE-JHJJ = TB-EG-JAHR-E(I) AND TB-KENN-E(I) 104229 = H-TB-KENN OR TB-ELEM-E(I) = HIGH-VALUE 104230 CONTINUE 104231 END-PERFORM 104232 MOVE TB-BBGGRENZE-E(I) TO HFELD-JBBG 104233 ELSE 104234** ------------------------------------------- 104235** AV/ArV West 104236** ------------------------------------------- 104237 MOVE "AVW" TO H-TB-KENN 104240 PERFORM VARYING I FROM 1 BY 1 UNTIL 104250 HFELD-BE-JHJJ = TB-EG-JAHR-E(I) AND TB-KENN-E(I) 104260 = H-TB-KENN OR TB-ELEM-E(I) = HIGH-VALUE 104270 CONTINUE 104280 END-PERFORM 104290 MOVE TB-BBGGRENZE-E(I) TO HFELD-JBBG 104291 END-IF 104300 ELSE 104301 IF HFELD-VSTR = " " AND 104302 (HFELD-BBNRVU-1-3 = "098" OR "980") 104303** ------------------------------------------- 104304** KnV Ost 104305** ------------------------------------------- 104306 MOVE "KNO" TO H-TB-KENN 104307 PERFORM VARYING I FROM 1 BY 1 UNTIL 104308 HFELD-BE-JHJJ = TB-EG-JAHR-E(I) AND TB-KENN-E(I) 104309 = H-TB-KENN OR TB-ELEM-E(I) = HIGH-VALUE 104310 CONTINUE 104311 END-PERFORM 104312 MOVE TB-BBGGRENZE-E(I) TO HFELD-JBBG 104314 ELSE 104315** ------------------------------------------- 104316** AV/ArV Ost 104317** ------------------------------------------- 104318 MOVE "AVO" TO H-TB-KENN 104320 PERFORM VARYING I FROM 1 BY 1 UNTIL 104330 HFELD-BE-JHJJ = TB-EG-JAHR-E(I) AND TB-KENN-E(I) 104340 = H-TB-KENN OR TB-ELEM-E(I) = HIGH-VALUE 104350 CONTINUE 104360 END-PERFORM 104370 MOVE TB-BBGGRENZE-E(I) TO HFELD-JBBG 104380 END-IF 104381 END-IF 104390 ELSE 104400 IF HFELD-OST-WEST = "W" OR "9" THEN 104401** ---------------------------------------------- 104402** KnV West 104403** ---------------------------------------------- 104410 MOVE "KNW" TO H-TB-KENN 104420 PERFORM VARYING I FROM 1 BY 1 UNTIL 104430 HFELD-BE-JHJJ = TB-EG-JAHR-E(I) AND TB-KENN-E(I) 104440 = H-TB-KENN OR TB-ELEM-E(I) = HIGH-VALUE 104450 CONTINUE 104460 END-PERFORM 104470 MOVE TB-BBGGRENZE-E(I) TO HFELD-JBBG 104480 ELSE 104481** ---------------------------------------------- 104482** KnV Ost 104483** ---------------------------------------------- 104490 MOVE "KNO" TO H-TB-KENN 104500 PERFORM VARYING I FROM 1 BY 1 UNTIL 104510 HFELD-BE-JHJJ = TB-EG-JAHR-E(I) AND TB-KENN-E(I) 104520 = H-TB-KENN OR TB-ELEM-E(I) = HIGH-VALUE 104530 CONTINUE 104540 END-PERFORM 104550 MOVE TB-BBGGRENZE-E(I) TO HFELD-JBBG 104560 END-IF 104570 END-IF 104580 END-IF 104590 . 104600 BBG-TB-EXIT. 104610 EXIT. 104620**---------------------------------------------------------- 104630** BEZUG-TB SECTION 104640** ERMITTELN JEWEILIGE BEZUGSGROESSE 104650**---------------------------------------------------------- 104660 BEZUG-TB SECTION. 104670 BEZUG-TBE. 104680 IF HFELD-WG = "D" THEN 104690 IF HFELD-OST-WEST = "W" OR "9" THEN 104700 MOVE "AVW" TO H-TB-KENN 104710 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-BE-JHJJ 104720 = TB-BZ-JAHR(I) AND TB-BZ-KENN(I) = H-TB-KENN OR 104730 TB-BZ-ELEM(I) = HIGH-VALUE 104740 CONTINUE 104750 END-PERFORM 104760 MOVE TB-BZ-GR(I) TO HFELD-JBBG 104770 ELSE 104780 MOVE "AVO" TO H-TB-KENN 104790 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-BE-JHJJ 104800 = TB-BZ-JAHR(I) AND TB-BZ-KENN(I) = H-TB-KENN OR 104810 TB-BZ-ELEM(I) = HIGH-VALUE 104820 CONTINUE 104830 END-PERFORM 104840 MOVE TB-BZ-GR(I) TO HFELD-JBBG 104850 END-IF 104860 ELSE 104870 IF HFELD-OST-WEST = "W" OR "9" THEN 104880 MOVE "AVW" TO H-TB-KENN 104890 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-BE-JHJJ 104900 = TB-BZ-JAHR-E(I) AND TB-BZ-KENN-E(I) = H-TB-KENN OR 104910 TB-BZ-ELEM-E(I) = HIGH-VALUE 104920 CONTINUE 104930 END-PERFORM 104940 MOVE TB-BZ-GR-E(I) TO HFELD-JBBG 104950 ELSE 104960 MOVE "AVO" TO H-TB-KENN 104970 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-BE-JHJJ 104980 = TB-BZ-JAHR-E(I) AND TB-BZ-KENN-E(I) = H-TB-KENN OR 104990 TB-BZ-ELEM-E(I) = HIGH-VALUE 105000 CONTINUE 105010 END-PERFORM 105020 MOVE TB-BZ-GR-E(I) TO HFELD-JBBG 105030 END-IF 105040 . 105050 BEZUG-TB-EXIT. 105060 EXIT. 105070 FBBY-PRUEF SECTION. 105080 FBBY-PRUEFE. 105090 MOVE "N" TO SCHALTJ 105100 MOVE 0228 TO TB-MOTG(2) 105110 MOVE 0 TO HFELD-TAGE 105120 MOVE 0 TO HFELD-JBBG 105130 MOVE 0 TO HFELD-BBG 105140 MOVE 0 TO HFELD-BS 105150 MOVE 0 TO HFELD-BY 105160** PRüFUNG OB SCHALTJ 105170 IF HFELD-BE-JJ = 0 THEN 105180 MOVE HFELD-BE-JHJJ TO HFELD-BE-R 105190 DIVIDE HFELD-BE-R BY 400 GIVING RFELD1 REMAINDER 105200 REST1 105210 IF REST1 = 0 THEN 105220 MOVE "J" TO SCHALTJ 105230** FEBRUAR MIT 29 TAGEN BELEGEN 105240 MOVE 0229 TO TB-MOTG(2) 105250 END-IF 105260 ELSE 105270 DIVIDE HFELD-BE-JJ BY 4 GIVING RFELD1 REMAINDER 105280 REST1 105290 IF REST1 = 0 THEN 105300 MOVE "J" TO SCHALTJ 105310** FEBRUAR MIT 29 TAGEN BELEGEN 105320 MOVE 0229 TO TB-MOTG(2) 105330 END-IF 105340 END-IF 105350** ERMITTLUNG DER ANZAHL DER TAGE 105360** BEI BESCHäFTIGTEN IMMER 01.01. (nur bei DSME) 105370 IF ST-DSME 105380 MOVE E1-PERSGR TO BBG-PERSGR-TAB 105390 IF NOT BBG-PERSGR-OK THEN 105400** BEI BESCHäFTIGTEN BEGINN IMMER 01.01. 105410 MOVE 0101 TO HFELD-BE-MT 105420 END-IF 105430 END-IF 105440** ERMITTELN OB MONATSANFANG BZW ANZAHL DER TAGE IM MONAT 105450 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-BE-MM = 105460 TB-MO(I) OR I > 12 105470 CONTINUE 105480 END-PERFORM 105490 IF HFELD-BE-TT = 01 THEN 105500 MOVE 1 TO MON-ANF 105510 ELSE 105520** TATSäCHLICHE ANZAHL TAGE IM BEGINNMONAT 105530 COMPUTE BE-MO-TAGE = TB-TG(I) - HFELD-BE-TT + 1 105540 END-IF 105550** ERMITTELN OB MONATSENDE BZW ANZAHL DER TAGE IM MONAT 105560 PERFORM VARYING I FROM 1 BY 1 UNTIL HFELD-EN-MM = 105570 TB-MO(I) OR I > 12 105580 CONTINUE 105590 END-PERFORM 105600 IF HFELD-EN-TT = TB-TG(I) 105610 MOVE 1 TO MON-END 105620 ELSE 105630 MOVE HFELD-EN-TT TO EN-MO-TAGE 105640 END-IF 105650** BERECHNUNG TAGE 105660 IF HFELD-BE-MM = HFELD-EN-MM 105670** Z.B. 05.01 BIS 28.01. 105680 COMPUTE HFELD-TAGE = HFELD-EN-TT - HFELD-BE-TT + 1 105690** VOLLE MONATE IMMER MIT 30 TAGEN 105700 IF HFELD-TAGE > 30 THEN 105710 MOVE 30 TO HFELD-TAGE 105720 END-IF 105730 IF HFELD-EN-MM = 02 THEN 105740 IF HFELD-TAGE >= 28 AND SCHALTJ = "N" 105750 MOVE 30 TO HFELD-TAGE 105760 ELSE IF HFELD-TAGE > 28 AND SCHALTJ = "J" THEN 105770 MOVE 30 TO HFELD-TAGE 105771 END-IF 105780 END-IF 105790 END-IF 105800 ELSE 105810 IF MON-ANF = 1 AND MON-END = 1 105820** Z.B. 01.03. BIS 30.06. 105830 COMPUTE HFELD-TAGE = ((HFELD-EN-MM - HFELD-BE-MM) 105840 + 1 ) * 30 105850 ELSE 105860 IF MON-ANF = 1 105870** Z.B. 01.03. BIS 17.06. 105880 COMPUTE HFELD-TAGE = ((HFELD-EN-MM - HFELD-BE-MM) 105890 * 30) + EN-MO-TAGE 105900 ELSE 105910 IF MON-END = 1 105920** Z.B. 15.03. BIS 30.06. 105930 COMPUTE HFELD-TAGE = ((HFELD-EN-MM - HFELD-BE-MM) 105940 * 30) + BE-MO-TAGE 105950 ELSE 105960 IF (HFELD-EN-MM - HFELD-BE-MM) > 1 105970** Z.B. 15.03. BIS 18.06. 105980 COMPUTE HFELD-TAGE = (((HFELD-EN-MM - 105990 HFELD-BE-MM) - 1) * 30) 106000 + BE-MO-TAGE + EN-MO-TAGE 106010 ELSE 106020** Z.B. 15.03. BIS 18.04. 106030 COMPUTE HFELD-TAGE = BE-MO-TAGE + EN-MO-TAGE 106040 END-IF 106050 END-IF 106060 END-IF 106070 END-IF 106080 END-IF 106090 PERFORM VARYING I FROM 1 BY 1 UNTIL 106100 HFELD-BE-JHJJ = TB-BTS-JAHR(I) 106110 OR TB-ELEM-E(I) = HIGH-VALUE 106120 CONTINUE 106130 END-PERFORM 106140 MOVE TB-BTS-BEITS(I) TO HFELD-BS 106150 PERFORM BBG-TB 106160 COMPUTE HFELD-BS-R = (HFELD-BS / 10000) / 2 END-COMPUTE 106180 COMPUTE HFELD-BY = (HFELD-JBBG * HFELD-BS-R) 106190 * HFELD-TAGE / 360 106200 END-COMPUTE 106210 COMPUTE HFELD-BBG-DM ROUNDED = HFELD-BY + 0,49 106220 END-COMPUTE 106221 MOVE E14-BY TO HFELD-BYN 106222 IF HFELD-BYNK > HFELD-BBG-DM 106223 MOVE "F1" TO HFELD-FE 106224 END-IF 106235 . 106240 FBBY-PRUEF-EXIT. 106250 EXIT. 027110 027111*COPY CDSKO040 REPLACING ==:S14:== BY ==E15==. 045310**---------------------------------------------------------------- 045320** COPY-MEMBER : CDSKO040 045330** PROGRAMMIERER : MICHAEL KLEMKE 045340** ERSTELLUNGSDATUM : 11.10.2004 045350** VERSION : 001 (PGM-NEUERSTELLUNG) 045360** FUNKTION : FEHLERPRüFUNG VERSIONSNUMMER 045370**---------------------------------------------------------------- 045380 FDSKO040 SECTION. 045390 FDSKO040E. 045400 IF E15-VERNR NOT NUMERIC 045410 MOVE "DSKO040" TO H-FEHLER 045420 ELSE IF 045430 E15-VERNR NOT EQUAL 01 045440 MOVE "DSKO042" TO H-FEHLER 045450 END-IF 045460 . 045470 FDSKO040-EXIT. 045480 EXIT. 027112*COPY CDSKO050 REPLACING ==:S14:== BY ==E15==. 045680**---------------------------------------------------------------- 045690** COPY-MEMBER : CDSKO050 045720** VERSION : 001 (PGM-NEUERSTELLUNG) 045730** FUNKTION : FEHLERPRüFUNG DATUM-ERSTELLUNG 045740** DATENDEFINITION IM COPYMEMBER DDSKO050 045750**---------------------------------------------------------------- 045751** PROGRAMMIERER : MICHAEL KLEMKE 045752** ÄNDERUNG : 002 VOM 11.10.2004 VERSION 41 045753**---------------------------------------------------------------- 045760 FDSKO050 SECTION. 045770 FDSKO050E. 045771 SET NOT-DSME05X-VOR TO TRUE 045780 IF E15-ED NUMERIC THEN 045801 045802 DIVIDE 4 INTO E15-HJJ GIVING ERG REMAINDER SCHALTJAHR 045803 IF E15-HMM > ZERO AND < 13 045804 AND E15-HTT > ZERO 045805 AND <= TGT(SCHALTJAHR + 1, E15-HMM) THEN 045806 IF E15-HDAT > P-DATE 045807 MOVE "DSKO054" TO H-FEHLER 045808 SET DSME05X-VORH TO TRUE 045809 PERFORM FEHLER 045810 END-IF 045814 ELSE 045815 MOVE "DSKO052" TO H-FEHLER 045816 SET DSME05X-VORH TO TRUE 045817 PERFORM FEHLER 045818 END-IF 045821 IF E15-HSTD > 23 OR 045822 E15-HMIN >= 60 OR 045823 E15-HSEK >= 60 THEN 045824 MOVE "DSKO056" TO H-FEHLER 045825 SET DSME05X-VORH TO TRUE 045826 PERFORM FEHLER 045827 END-IF 045828 IF NOT-DSME05X-VOR 045832 IF OP-AGDEU OR OP-WLTKV 045833 CONTINUE 045834 ELSE 045835 IF E15-HDAT = P-DATE THEN 045836 IF NOT ST-DSKO 045837 IF E15-HUHR >= P-TIME THEN 045838 MOVE "DSKO058" TO H-FEHLER 045839 PERFORM FEHLER 045840 END-IF 045841 END-IF 045842 END-IF 045843 END-IF 045844 END-IF 045849 ELSE 045850 MOVE "DSKO050" TO H-FEHLER 045851 END-IF 046060 . 046061 046064 046070 FDSKO050-EXIT. 046080 EXIT. 046090 046100 027113*COPY CDSKO060 REPLACING ==:S14:== BY ==E15==. 045920**---------------------------------------------------------------- 045930** COPY-MEMBER : CDSKO060 045940** PROGRAMMIERER : MICHAEL KLEMKE 045950** ERSTELLUNGSDATUM : 11.10.2004 045960** VERSION : 001 (PGM-NEUERSTELLUNG) 045970** FUNKTION : FEHLERPRüFUNG FEHLERKENNZEICHEN 045990**---------------------------------------------------------------- 046000 FDSKO060 SECTION. 046010 FDSKO060E. 046020 IF E15-FEKZ NUMERIC THEN 046021 IF E15-FEAN NUMERIC THEN 046022 IF E15-FEAN = 0 046024 IF E15-FEKZ = 0 OR 1 046025 CONTINUE 046026 ELSE 046027 MOVE "DSKO062" TO H-FEHLER 046030 END-IF 046031 ELSE 046032 MOVE "DSKO072" TO H-FEHLER 046033 END-IF 046034 ELSE 046035 MOVE "DSKO070" TO H-FEHLER 046036 END-IF 046037 ELSE 046038 MOVE "DSKO060" TO H-FEHLER 046039 END-IF 046170 . 046171 046172 046180 FDSKO060-EXIT. 046190 EXIT. 046200 046300 027114*COPY CDSKO500 REPLACING ==:S14:== BY ==E15==. 000507**---------------------------------------------------------------- 000900** COPY-MEMBER : CDSKO500 001000** PROGRAMMIERER : MICHAEL KLEMKE 001100** ERSTELLUNGSDATUM : 14.10.2004 - VERSION 41 001200** VERSION : 001 (PGM-NEUERSTELLUNG) 001300** FUNKTION : FEHLERPRüFUNG DSKO 001600**---------------------------------------------------------------- 001610** PROGRAMMIERER : MICHAEL KLEMKE 001620** ERSTELLUNGSDATUM : 23.04.2007 - VERSION 62 001630** VERSION : 002 001650**---------------------------------------------------------------- 001700 FDSKO500 SECTION. 001710 FDSKO500E. 001800 IF E15-NAME1 = " " 001820 MOVE "DSKO500" TO H-FEHLER 001830 PERFORM FEHLER 002700 END-IF 002800 IF E15-PLZ = " " 002900 MOVE "DSKO530" TO H-FEHLER 003000 PERFORM FEHLER 003100 END-IF 003200 IF E15-ORT = " " 003210 MOVE "DSKO540" TO H-FEHLER 003220 PERFORM FEHLER 003230 END-IF 003240 IF E15-STR = " " 003250 MOVE "DSKO550" TO H-FEHLER 003260 PERFORM FEHLER 003270 END-IF 003280 IF E15-ANR-AP = " " OR "M" OR "W" 003281 CONTINUE 003282 ELSE 003290 MOVE "DSKO570" TO H-FEHLER 003291 PERFORM FEHLER 003292 END-IF 003293** ------------------------------------------------------------- 003294** T546 ANFANG 003295** ------------------------------------------------------------- 003296 IF E15-EMAIL-AP NOT = SPACES 003297 PERFORM VARYING I FROM 70 BY -1 UNTIL I = 0 003298 OR E15-EMAIL-AP(I:1) NOT = " " 003299 CONTINUE 003300 END-PERFORM 003301 MOVE I TO AKTLG 003302 SET DSKO610-NOT TO TRUE 003303 SET DSKO612-NOT TO TRUE 003304 MOVE 0 TO ANZ-SZ 003305 PERFORM VARYING I FROM 1 BY 1 UNTIL I > AKTLG 003306 IF E15-EMAIL-AP(I:1) EMAIL 003307 IF E15-EMAIL-AP(I:1) = "@" OR "§" 003308 ADD 1 TO ANZ-SZ 003309 IF I = 1 OR AKTLG 003310 SET DSKO612-VORH TO TRUE 003311 END-IF 003312 END-IF 003313 ELSE 003314 IF E15-EMAIL-AP(I:1) = """" 003315 CONTINUE 003316 ELSE 003318 SET DSKO610-VORH TO TRUE 003319 END-IF 003320 END-IF 003321 END-PERFORM 003322 IF DSKO610-VORH 003323 MOVE "DSKO610" TO H-FEHLER 003324 PERFORM FEHLER 003325 END-IF 003326 IF DSKO612-VORH OR ANZ-SZ NOT = 1 003327 MOVE "DSKO612" TO H-FEHLER 003328 PERFORM FEHLER 003329 END-IF 003330 ELSE 003331 MOVE "DSKO605" TO H-FEHLER 003332 PERFORM FEHLER 003333 END-IF 003334** ------------------------------------------------------------- 003335** T546 ENDE 003336** ------------------------------------------------------------- 003337 . 003338 003339 003340 FDSKO500-EXIT. 003400 EXIT. 003500 003600 027120 027200**---------------------------------------------------------------- 027300** UNTERROUTINE : ABS-5-1-3 SECTION 027400** FUNKTION : DSME-SATZ NACH "WORKDSME" ENTDICHTEN 027500** VARIABLEN : 027600**---------------------------------------------------------------- 027700 ABS-5-1-3 SECTION. 027800 ABS-5-1-3A. 028000 MOVE 1 TO VON 028010 MOVE 0 TO HFELD-LG 028200** ------------------------------------------------------------- 028300** HF-MERKMALE(1:1) VORBELEGT MIT "J" FUER DSME-BAUSTEIN 028400** ------------------------------------------------------------- 028500 MOVE EIN-SATZ(171:10) TO HF-MERKMALE(2:10) 028700 PERFORM VARYING IX FROM 1 BY 1 028810 UNTIL IX > 11 OR HFELD-FE NOT = SPACES 028900 IF HF-MERKMALE(IX:1) = "J" 028910 MOVE DSME-DBNAME(IX) TO HFELD-KE-NEU 029000** -------------------------------------------------------- 029100** DATENBAUSTEIN WIE GEKENNZEICHNET IM DATENSATZ VORHANDEN 029200** -------------------------------------------------------- 029300 IF EIN-SATZ(VON:4) = DSME-DBNAME(IX) 029600** ----------------------------------------------------- 029700** DATENBAUSTEIN IN PRUEFBEREICH UEBERTRAGEN 029800** ----------------------------------------------------- 029810 MOVE DSME-DBLG(IX) TO LAE-DB 029900 EVALUATE DSME-DBNAME(IX) 030000 WHEN "DSME" MOVE EIN-SATZ(VON:LAE-DB) TO E1-DUCDSME 030100 WHEN "DBME" MOVE EIN-SATZ(VON:LAE-DB) TO E2-DUCDBME 030200 WHEN "DBNA" MOVE EIN-SATZ(VON:LAE-DB) TO E3-DUCDBNA 030300 WHEN "DBGB" MOVE EIN-SATZ(VON:LAE-DB) TO E4-DUCDBGB 030400 WHEN "DBAN" MOVE EIN-SATZ(VON:LAE-DB) TO E5-DUCDBAN 030500 WHEN "DBEU" MOVE EIN-SATZ(VON:LAE-DB) TO E6-DUCDBEU 030600** WHEN "DBSO" MOVE EIN-SATZ(VON:LAE-DB) TO E7-DUCDBSO 030700 WHEN "DBKS" MOVE EIN-SATZ(VON:LAE-DB) TO E8-DUCDBKS 030800 WHEN "DBSV" MOVE EIN-SATZ(VON:LAE-DB) TO E9-DUCDBSV 030900 WHEN "DBVR" MOVE EIN-SATZ(VON:LAE-DB) TO E10-DUCDBVR 031000 WHEN "DBRG" MOVE EIN-SATZ(VON:LAE-DB) TO E11-DUCDBRG 031100** ---------------------------------------------- 031200** SONDERFALL: VARIABLE ANZAHL ELEMENTE 031300** ---------------------------------------------- 031400 IF E11-ANRG NUMERIC THEN 031500 IF E11-ANRG-NUM > 0 THEN 031600** ---------------------------------------- 031700** LAENGE = LAENGE VARIABLER DATENTEIL 031800** VON-X = BEGINN VARIABLER DATENTEIL 031900** ---------------------------------------- 032000 COMPUTE LAENGE = 206 * E11-ANRG-NUM 032100** COMPUTE VON-X = VON + LAE-DB 032200** MOVE EIN-SATZ(VON-X:LAENGE) TO 032300** E1-DUCDBRG(209:LAENGE) 032400 ADD LAENGE TO VON 032410 HFELD-LG 032600 END-IF 032610 ELSE 032611** ------------------------------------------- 032612** KENNZEICHEN FUER UNZUL. LÄNGE BAUSTEIN-ALT 032613** ------------------------------------------- 032614 MOVE "LG" TO HFELD-FE 032700 END-IF 032800 WHEN OTHER CONTINUE 032900 END-EVALUATE 033000 ADD LAE-DB TO VON 033010** ----------------------------------------------------- 033020** LÄNGE DES DATENSATZES AKTUALISIEREN 033030** ----------------------------------------------------- 033040 ADD DSME-DBLG(IX) TO HFELD-LG 033050 IF HFELD-LG > SATZLG 033060** -------------------------------------------------- 033070** SATZLÄNGE FEHLERHAFT 033080** -------------------------------------------------- 033090 MOVE "LG" TO HFELD-FE 033092 ELSE 033093 MOVE HFELD-KE-NEU TO HFELD-KE-ALT 033094 END-IF 033100 ELSE 033200** ----------------------------------------------------- 033300** ANGEKUENDIGTER DATENBAUSTEIN FEHLT 033400** ----------------------------------------------------- 033401 IF EIN-SATZ(VON:2) = "DB" OR (VON - 1) = SATZLG 033402 MOVE "FE" TO HFELD-FE 033410 ELSE 033411 MOVE "LG" TO HFELD-FE 033412 END-IF 033600 END-IF 033700 END-IF 033800 END-PERFORM 036900 . 037000 037100 037200 ABS-5-1-3-EXIT. 037300 EXIT. 037400 037500 037600**---------------------------------------------------------------- 037700** UNTERROUTINE : ABS-5-1-4 SECTION 037800** FUNKTION : DSAE-SATZ NACH "WORKDSAE" ENTDICHTEN 037900** VARIABLEN : 038000**---------------------------------------------------------------- 038100 ABS-5-1-4 SECTION. 038110 ABS-5-1-4A. 038200 MOVE 1 TO VON 038300 MOVE 0 TO HFELD-LG 038600** ------------------------------------------------------------- 038700** HF-MERKMALE(1:1) VORBELEGT MIT "J" FUER DSAE-BAUSTEIN 038800** ------------------------------------------------------------- 038900 MOVE EIN-SATZ(171:2) TO HF-MERKMALE(2:2) 039000 PERFORM VARYING IX FROM 1 BY 1 039010 UNTIL IX > 3 OR HFELD-FE NOT = SPACES 039200 IF HF-MERKMALE(IX:1) = "J" 039210 MOVE DSAE-DBNAME(IX) TO HFELD-KE-NEU 039220** ------------------------------------------------------- 039230** DATENBAUSTEIN WIE GEKENNZEICHNET IM DATENSATZ VORHANDEN 039240** ------------------------------------------------------- 039600 IF EIN-SATZ(VON:4) = DSAE-DBNAME(IX) 039700 MOVE DSAE-DBLG(IX) TO LAE-DB 039800** ---------------------------------------------------- 039900** DATENBAUSTEIN IN ENTSPR. STRUKTUR UEBERTRAGEN 040000** ---------------------------------------------------- 040100 EVALUATE DSAE-DBNAME(IX) 040200 WHEN "DSAE" MOVE EIN-SATZ(VON:LAE-DB) TO E12-DUCDSAE 040300 WHEN "DBAZ" MOVE EIN-SATZ(VON:LAE-DB) TO E13-DUCDBAZ 040400 WHEN "DBEZ" MOVE EIN-SATZ(VON:LAE-DB) TO E14-DUCDBEZ 040500 WHEN OTHER CONTINUE 040600 END-EVALUATE 040700 ADD LAE-DB TO VON 040710** ---------------------------------------------------- 040720** LÄNGE DES DATENSATZES AKTUALISIEREN 040730** ---------------------------------------------------- 040740 ADD DSAE-DBLG(IX) TO HFELD-LG 040750 IF HFELD-LG > SATZLG 040760** ------------------------------------------------- 040770** SATZLÄNGE FEHLERHAFT 040780** ------------------------------------------------- 040790 MOVE "LG" TO HFELD-FE 040791 ELSE 040792 MOVE HFELD-KE-NEU TO HFELD-KE-ALT 040793 END-IF 040800 ELSE 040810** ---------------------------------------------------- 040820** ANGEKUENDIGTER DATENBAUSTEIN FEHLT 040830** ---------------------------------------------------- 040840 IF EIN-SATZ(VON:2) = "DB" OR (VON - 1) = SATZLG 040850 MOVE "FE" TO HFELD-FE 040860 ELSE 040870 MOVE "LG" TO HFELD-FE 040880 END-IF 041300 END-IF 041400 END-IF 041500 END-PERFORM 044600 . 044700 044800 044900 ABS-5-1-4-EXIT. 045000 EXIT. 045100 045200