./OPTIONS OUTPUT (PRINT (OPTIONS OUTPUT)) INST-VAR (DYNAMIC-CALL) OUTPUT-FORMATTING ( SPACE-BEFORE ( DIVISIONS (EJECT) DATA-TEXT-BLOCKS (SKIP3) PROCEDURE-TEXT-BLOCKS (EJECT) ) ) DOCUMENTATION (SWTREE) EXTENDED-NAMES (ALL) ./PROGRAM BA668T 'S. GROB' DATE-WRITTEN (25-07-07) VERSION (01.04) PROGRAM-TYPE (MAIN) LANGUAGE (C2R3) NOGENERATE NOINTERRUPT-PROCESSING ./USER REMARKS. ** --------------------------------------------------------------- *A *A BA668T EC CASH EMV / SPUR 2 PASSIV *A *A STIXXX13 = EC CASH EMV / SPUR 2 *A *A AUTORISIERUNG PASSIV *A ENTGEGENNAHME DER TRANSAKTION UND VERTEILEN *A AN DAS BEARBEITENDE SUBSYSTEM *A 1. TRANSAKTION ZUR TEIL-DB *A NACH VERARBEITUNG MGS/CHIP *A A) VERARBEITUNG MAGNETSTREIFEN BA669T *A B) VERARBEITUNG CHIP BA670T *A 2. IRRLäUFER WEITERLEITEN IN RICHTIGES IMS *A STIXXX13 --> STIIMY13 *A --- - *A ! ! *A ! !-> Y = DIE IMSID *A !-+> XXX = DIE SYSID DES IMS *A *A VERARBEITUNG *A DIE BEI EC CASH EMV / SPUR 2 *A ANKOMMENDEN AUTORISIERUNGSNACHRICHTEN WERDEN *A GEPRÜFT, SYNCHRONISIERT, UND JE NACH ERGEBNIS *A ZUR AUTORISIERUNG AN BA669T/BA670T *A WEITERGELEITET; *A BEI FEHLERN WIRD SOFORT GEANTWORTET. *A DABEI WIRD JEDER VORGANG IN DER FS80 *A PROTOKOLLIERT. *A *A AUFGABEN - ENTGEGENNAHME DER NACHRICHTEN *A TYP 0100 AUTORISIERUNGSANFRAGEN UND *A TYP 042X STORNOS *A - UMSETZEN DER TRANSAKTIONSDATEN VON ISO NACH *A GENO BZW.GENO NACH ISO MIT BA555U *A - ERMITTELN DER BANKLEITZAHL ÜBER DIE *A ROUTING-NUMMER IN DER PAN *A - PRÜFEN OB AGREE-BANK *A - ERMITTELN DER RZBK *A - PRÜFEN, OB INS RICHTIGE IMS GEROUTET WURDE *A - ERMITTELN DER TEIL-DB FÜR AUTORISIERUNG *A - PLAUSIBILITÄTSPRÜFUNG DER EINZELNEN BMPS *A - PRÜFUNG DES MAC *A - S1-SYNCHRONISATION MIT BA108U (REIHENFOLGE) *A - ERSTELLEN DER PROTOKOLLSÄTZE *A - PROTOKOLLIEREN ALLER VORGÄNGE IN DER *A KONTROLL-DB PASSIV FS80 MIT BA108U *A - RÜCKSENDEN ZU CP ÜBER LTERM OHNE *A TRANSAKTIONSCODE WENN FEHLER *A - WEITERLEITEN AN RICHTIGES IMS WENN FALSCH *A GEROUTET WURDE *A - WEITERLEITEN AN BA669T BZW. BA670T ZUR *A AUTORISIERUNG *A *A TX-CODE - STIXXX13 (XXX = SYSID) *A EINGABE - STIIMY13 ( Y = IMSID) *A *A TX-CODES - BA669X1T ( T = TEILDATENBANK) *A AUSGABE - BA670X1T *A *A ** --------------------------------------------------------------- *B *B PLUS ABTEILG D A T U M A E N D E R U N G S G R U N D *B VERS NAME TT.MM.JJ *B --/-- --------- --.--.-- --------------------------------- *B *B 01/00 GROB 25.07.07 NEUERSTELLUNG *B AEW4KA *B *B 01/01 GROB 14.11.07 SYNCHRONISATION MANUELLER STORNO *B AEW4KA *B *B 01/02 GROB 28.01.08 SECCOS 6: PRüFUNG AUF S6KCVR3 *B AEW3PA ENTFERNEN. *B 04.04.08 PRüFUNG IN BMP55 TAG 9F10 CVR3 *B FüR CIRRUS-KARTEN ANPASSEN. *B *B 01/03 MAYER 03.06.08 CASHBACK ANHAND ABWKZ ABLEHNEN *B AEW5EK *B *B 01/04 MAYER 29.09.08 ATRART VERSORGEN *B AEW5EK *B *B 01/05 STRENG 24.09.09 ÜBERWACHUNG ENDKUNDENKANÄLE *B AEW3PC AUFRUF BA781U *B ** --------------------------------------------------------------- *C BESONDERHEITEN *C *C KEINE *C ** --------------------------------------------------------------- ./USER 'WORKING-77' DATA. * *----> -------------- * *----> IDENTIFIKATION * *----> -------------- 01 IDENT PIC X(32) VALUE 'BA668T PLUS=01/05 24.09.2009'. * *----> ------ * *----> IDENT2 * *----> ------ 01 IDENT2 PIC X(60) VALUE 'ÜBERWACHUNG ENDKUNDENKANÄLE '. * *----> ---------- * *----> PROGRAM-ID * *----> ---------- 01 PID PIC X(02) VALUE 'CC'. * *----> ---------- * *----> IO-MESSAGE * *----> ---------- ./FILE IO-PCB DESCRIPTION (ORGANIZATION (IO-QUEUE) FULL-PCB NOIO-AREA ). * *----> ----------- * *----> B05-GET-MSG * *----> ----------- ./FILE IO-PCB USAGE (FUNCTION (INPUT) FILE-PRIORITY (05) CALL (FU075U VFU0751 IO-PCB E-MSG E-MSG-ENDE ) ). ./USER IO-PCB-DEFINITIONEN DATA. * *----> ------------------------- * *----> VERBINDUNGSBEREICH FU075U * *----> ------------------------- 01 VFU0751. COPY VFU0751 REPLACING 'A' BY VFU0751. * *----> ----------------- * *----> EINGABE-NACHRICHT * *----> ----------------- 01 E-MSG. COPY BS7533 REPLACING 'A' BY E-MSG. 05 E-MSG-ENDE PIC X(01). 01 PIC X(36) VALUE 'AUSGABE-MESSAGE AN CP BS7534 ==>'. 01 BS7534. COPY BS7534 REPLACING 'A' BY BS7534. * *----> ---------------------------------------- * *----> STRUKTUR, DIE INTERN WEITERGEROUTET WIRD * *----> ---------------------------------------- 01 GENO-DATEN. * *----> -------------------------------------- * *----> GENO-STRUKTUR FüR EC CASH EMV / SPUR 2 * *----> -------------------------------------- 02 SEND-BS7435. COPY BS7435R REPLACING 'A' BY XXX. * *----> ------------------ * *----> STRUKTUR DER BMP55 * *----> ------------------ 02 SEND-BS4353. COPY BS4353R REPLACING 'A' BY XXX. ./FILE ALT-PCB DESCRIPTION (ORGANIZATION (ALTERNATE-DESTINATION) NOIO-AREA FULL-PCB ). ./FILE PCB-BLZROUT DESCRIPTION (ORGANIZATION (IMS-DATA-BASE) NOIO-AREA ). ./FILE PCB-BLZROUTR DESCRIPTION (ORGANIZATION (IMS-DATA-BASE) NOIO-AREA ). ./FILE PCB-SYNCP DESCRIPTION (ORGANIZATION (IMS-DATA-BASE) FULL-PCB NOIO-AREA ). ./FILE PCB-PROTP DESCRIPTION (ORGANIZATION (IMS-DATA-BASE) FULL-PCB NOIO-AREA ). * *----> ----------- * *----> I05-VBA087U * *----> ----------- ./FILE VBA087U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (05) CALL (BA087U VBA0871 VBA0872 ) ). ./USER VBA087U-DEFINITONEN DATA. * *----> ------------------------- * *----> VERBINDUNGSBEREICH BA087U * *----> ------------------------- 01 VBA0871. COPY VBA0871 REPLACING 'A' BY VBA0871. * *----> ------------------------- * *----> VERBINDUNGSBEREICH BA087U * *----> ------------------------- 01 VBA0872. COPY VBA0872 REPLACING 'A' BY VBA0872. * *----> ----------------------- * *----> I10-KONTROLL-DB-ZUGRIFF * *----> ----------------------- ./FILE BA108U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (10) CALL (BA108U VBA1081 PCB-SYNCP PCB-PROTP BS1830 BS4400E BS4400V BS2319 ) ). ./USER VBA108U-DEFINITONEN DATA. * *----> ------------------------- * *----> VERBINDUNGSBEREICH BA108U * *----> ------------------------- 01 VBA1081. COPY VBA1081R REPLACING 'A' BY VBA1081. * *----> ----------------------------------- * *----> VERBINDUNGSBEREICH BA108U LöSCHCOPY * *----> ----------------------------------- 01 L-VBA1081. COPY VBA1081 REPLACING 'A' BY XXX. * *----> ------ * *----> BS1830 * *----> ------ 01 BS1830. COPY BS1830R REPLACING 'A' BY BS1830. * *----> ---------------- * *----> BS1830 LöSCHCOPY * *----> ---------------- 01 L-BS1830. COPY BS1830 REPLACING 'A' BY XXX. * *----> ------ * *----> BS4400 * *----> ------ 01 BS4400E. COPY BS4400R REPLACING 'A' BY BS4400E. * *----> ------ * *----> BS2328 * *----> ------ 01 BS2328 REDEFINES BS4400E. COPY BS2328R REPLACING 'A' BY BS2328. * *----> ------ * *----> BS4400 * *----> ------ 01 BS4400V. COPY BS4400R REPLACING 'A' BY BS4400V. * *----> ------ * *----> BS2300 * *----> ------ 01 BS2300 REDEFINES BS4400V. COPY BS2300R REPLACING 'A' BY BS2300. * *----> ---------------- * *----> BS2328 LöSCHCOPY * *----> ---------------- 01 L-BS2328. COPY BS2328 REPLACING 'A' BY L-BS2328. * *----> ---------------- * *----> BS2300 LöSCHCOPY * *----> ---------------- 01 L-BS2300. COPY BS2300 REPLACING 'A' BY XXX. * *----> ------ * *----> BS2300 * *----> ------ 01 BS2300Z. COPY BS2300R REPLACING 'A' BY BS2300Z. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-BS4400. COPY BS4400 REPLACING 'A' BY XXX. * *----> ------ * *----> BS4401 * *----> ------ 01 BS4401. COPY BS4401R REPLACING 'A' BY BS4401. * *----> ---------------- * *----> BS4400 LöSCHCOPY * *----> ---------------- 01 L-BS4401. COPY BS4401 REPLACING 'A' BY L-BS4401. * *----> ------ * *----> BS2319 * *----> ------ 01 BS2319. COPY BS2319R REPLACING 'A' BY BS2319. * *----> ---------------- * *----> BS2319 LöSCHCOPY * *----> ---------------- 01 L-BS2319. COPY BS2319 REPLACING 'A' BY XXX. * *----> ----------------- * *----> I15 BA341U MACING * *----> ----------------- ./FILE BA341U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (15) CALL (BA341U VBA3411 ISO-BA341U VBA3419 ) ). ./USER VBA341U-DEFINITONEN DATA. * *----> ------- * *----> VBA3411 * *----> ------- 01 VBA3411. COPY VBA3411R REPLACING 'A' BY VBA3411. * *----> ----------------- * *----> VBA3411 LöSCHCOPY * *----> ----------------- 01 L-VBA3411. COPY VBA3411 REPLACING 'A' BY XXX. * *----> ------- * *----> VBA3419 * *----> ------- 01 VBA3419. COPY VBA3419R REPLACING 'A' BY VBA3419. * *----> ------- * *----> VBA3419 * *----> ------- 01 L-VBA3419. COPY VBA3419 REPLACING 'A' BY XXX. * *----> ------------------------ * *----> 22000 BYTE FüR ISO-DATEN * *----> ------------------------ 01 ISO-BA341U PIC X(22000). * *----> ---------- * *----> V20-BA356U * *----> ---------- ./FILE BA356U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (RANDOM) MODULE-NUMBER (20) CALL (BA356U VBA3561 VBA3569 MSG-BEREICH ) ). ./USER VBA356U-DEFINITONEN DATA. * *----> ------------------------------------- * *----> EINGABE BA356U, NACHRICHTEN VERSENDEN * *----> ------------------------------------- 01 VBA3561. COPY VBA3561R REPLACING 'A' BY VBA3561. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-VBA3561. COPY VBA3561 REPLACING 'A' BY XXX. * *----> -------------- * *----> AUSGABE BA356U * *----> -------------- 01 VBA3569. COPY VBA3569R REPLACING 'A' BY VBA3569. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-VBA3569. COPY VBA3569 REPLACING 'A' BY XXX. * *----> ---------------------------------- * *----> ZU VERSENDENDE MESSAGE FUER BA356U * *----> ---------------------------------- 01 MSG-BEREICH. 05 MSG-LAENGE PIC 9(05) COMP. 05 MSG-DATEN PIC X(22000). * *----> ---------------------- * *----> I20 ISO-GENO-UMSETZUNG * *----> ---------------------- ./FILE BA555U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (20) CALL (BA555U VBA5551 VBA5559 ) ). ./USER BA555U-DEFINITONEN DATA. * *----> -------------------------- * *----> VERBINDUNGSBEREICH VBA5551 * *----> -------------------------- 01 VBA5551. COPY VBA5551R REPLACING 'A' BY VBA5551. * *----> --------------------- * *----> LOESCHBEREICH VBA5551 * *----> --------------------- 01 L-VBA5551. COPY VBA5551 REPLACING 'A' BY XXX. * *----> ---------------------- * *----> AUSGABEBEREICH VBA5559 * *----> ---------------------- 01 VBA5559. COPY VBA5559R REPLACING 'A' BY VBA5559. * *----> ---------------------- * *----> AUSGABEBEREICH VBA5559 * *----> ---------------------- 01 L-VBA5559. COPY VBA5559 REPLACING 'A' BY XXX. * *----> -------------------------------------- * *----> GENO-STRUKTUR FüR EC CASH EMV / SPUR 2 * *----> -------------------------------------- 01 BS7435. COPY BS7435R REPLACING 'A' BY BS7435. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-BS7435. COPY BS7435 REPLACING 'A' BY XXX. * *----> ------------------ * *----> STRUKTUR DER BMP55 * *----> ------------------ 01 BS4353. COPY BS4353R REPLACING 'A' BY BS4353. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-BS4353. COPY BS4353 REPLACING 'A' BY L-BS4353. * *----> ---------------- * *----> BMP55 IM ORGINAL * *----> ---------------- 01 ISOBMP55 PIC X(1024). * *----> -------------------------- * *----> ISOSATZ AUF VOLLWORTGRENZE * *----> -------------------------- 01 ISOSA-01 PIC X(8000). * *----> ---------- * *----> I25 BA443U * *----> ---------- ./FILE BA443U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (25) CALL (BA443U VBA4431 VBA4439 ) ). ./USER VBA443U-DEFINITONEN DATA. * *----> ------- * *----> VBA4431 * *----> ------- 01 VBA4431. COPY VBA4431R REPLACING 'A' BY VBA4431. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-VBA4431. COPY VBA4431 REPLACING 'A' BY XXX. * *----> ------- * *----> VBA4439 * *----> ------- 01 VBA4439. COPY VBA4439R REPLACING 'A' BY VBA4439. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-VBA4439. COPY VBA4439 REPLACING 'A' BY XXX. * *----> ---------- * *----> I30 BA437U * *----> ---------- ./FILE BA437U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (30) CALL (BA437U VBA4371 VBA4379 PCB-BLZROUT PCB-BLZROUTR ) ). ./USER VBA437U-DEFINITONEN DATA. * *----> ------- * *----> VBA4371 * *----> ------- 01 VBA4371. COPY VBA4371R REPLACING 'A' BY VBA4371. * *----> ------- * *----> VBA4371 * *----> ------- 01 L-VBA4371. COPY VBA4371 REPLACING 'A' BY XXX. * *----> ------- * *----> VBA4379 * *----> ------- 01 VBA4379. COPY VBA4379R REPLACING 'A' BY VBA4379. * *----> --------- * *----> LöSCHCOPY * *----> --------- 01 L-VBA4379. COPY VBA4379 REPLACING 'A' BY XXX. * *----> -------------- * *----> I35-DATUM-ZEIT * *----> -------------- ./FILE ML210U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (35) CALL (ML210U VML2101 VML2102 ) ). ./USER VML210U-DEFINITONEN DATA. * *----> ------- * *----> VML2101 * *----> ------- 01 VML2101. COPY VML210U1 REPLACING 'A' BY VML2101. * *----> ------- * *----> VML2102 * *----> ------- 01 VML2102. COPY VML210U2 REPLACING 'A' BY VML2102. * *----> ------------------------- * *----> I40 BA781U SB-ÜBERWACHUNG * *----> ------------------------- ./FILE BA781U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (40) CALL (BA781U VBA7811 VBA7819 ) ). ./USER VBA781U-DEFINITONEN DATA. * *----> ------- * *----> VBA7811 * *----> ------- 01 VBA7811. COPY VBA7811R REPLACING 'A' BY VBA7811. 01 L-VBA7811. COPY VBA7811 REPLACING 'A' BY XXX. * *----> ------- * *----> VBA7819 * *----> ------- 01 VBA7819. COPY VBA7819R REPLACING 'A' BY VBA7819. * *----> ----------------- * *----> I50 DATUM/UHRZEIT * *----> ----------------- ./FILE FU143U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (50) CALL (FU143U VFU1431 ) ). ./USER FU143U-DEFINITONEN DATA. * *----> ------------------------- * *----> VERBINDUNGSBEREICH FU143U * *----> ------------------------- 01 VFU1431. COPY VFU1431 REPLACING 'A' BY VFU1431. * *----> ---------- * *----> I55 FU068U * *----> ---------- ./FILE FU068U DESCRIPTION (NOIO-AREA) USAGE (FUNCTION (INPUT) MODULE-NUMBER (55) CALL (FU068U VFU068U-FUNKT VFU068U-LL VFU068U-ITEXT VFU068U-OTEXT VFU068U-OZONE VFU068U-OZIFF ) ). ./USER VFU068U-DEFINITONEN DATA. * *----> ------------- * *----> VFU068U-FUNKT * *----> ------------- 01 VFU068U-FUNKT PIC X(002) VALUE SPACE. * *----> ---------- * *----> VFU068U-LL * *----> ---------- 01 VFU068U-LL PIC 9(005) VALUE 0 USAGE COMP. * *----> ------------- * *----> VFU068U-ITEXT * *----> ------------- 01 VFU068U-ITEXT PIC X(130) VALUE SPACE. * *----> ------------- * *----> VFU068U-OTEXT * *----> ------------- 01 VFU068U-OTEXT PIC X(260) VALUE SPACE. * *----> ------------- * *----> VFU068U-OZONE * *----> ------------- 01 VFU068U-OZONE PIC X(130) VALUE SPACE. * *----> ------------- * *----> VFU068U-OZIFF * *----> ------------- 01 VFU068U-OZIFF PIC X(130) VALUE SPACE. ./USER HILFSFELDER DATA. 01 PIC X(36) VALUE 'BEGINN HILFSFELDER WORKINGSTORAGE==>'. * *----> ----------- * *----> HILFSFELDER * *----> ----------- 01 HILFSFELDER. * *----> ------------------------ * *----> HILFSFELDER FüR AUSGABEN * *----> ------------------------ 05 X1 PIC 9(09) COMP-3 VALUE ZERO. 05 X2 PIC 9(09) COMP-3 VALUE ZERO. 05 X3 PIC 9(09) COMP-3 VALUE ZERO. 05 X4 PIC 9(09) COMP-3 VALUE ZERO. 05 X5 PIC 9(09) COMP-3 VALUE ZERO. 05 Z-LNG-BMP55 PIC 9(09) COMP-3 VALUE ZERO. 05 Z-LNG-ISOSA PIC 9(09) COMP-3 VALUE ZERO. * *----> ---------- * *----> TAG-LAENGE * *----> ---------- 05 Z-TAGLEN PIC 9(03). * *----> ------------------------------------- * *----> ZWISCHENBEREICH FÜR DATUM UND UHRZEIT * *----> ------------------------------------- 05 Z-DZ PIC 9(10). 05 REDEFINES Z-DZ. 10 Z-DZ-MMTT PIC 9(04). 10 REDEFINES Z-DZ-MMTT. 15 Z-DZ-MMTT-MON PIC 9(02). 15 Z-DZ-MMTT-TAG PIC 9(02). 10 Z-DZ-ZEIT PIC 9(06). 10 REDEFINES Z-DZ-ZEIT. 15 Z-DZ-ZEIT-STD PIC 9(02). 15 Z-DZ-ZEIT-MIN PIC 9(02). 15 Z-DZ-ZEIT-SEC PIC 9(02). * *----> ---------------------------- * *----> TRANSAKTIONSBETRAG AUS BMP04 * *----> ---------------------------- 05 Z-BETRAG PIC S9(10)V99 COMP-3. 05 Z-BETRAG-ONK REDEFINES Z-BETRAG PIC S9(12) COMP-3. * *----> -------------------------- * *----> STRING-FäHIGES BETRAGSFELD * *----> Z.B. FüR CASHBACK ANZEIGE * *----> -------------------------- 05 Z-BETRAG-CB PIC 9(12),99 USAGE DISPLAY VALUE ZERO. * *----> ----- * *----> DATUM * *----> ----- 05 Z-DATUM PIC 9(06). 05 REDEFINES Z-DATUM. 10 PIC 9(02). 10 Z-DATUM-MMTT PIC 9(04). * *----> -------------------------- * *----> TRANSAKTIONS-NR. AUS BMP11 * *----> -------------------------- 05 Z-TSANR PIC 9(06). * *----> --------------------- * *----> FOLGENUMMER 1-STELLIG * *----> --------------------- 05 Z-KARNR PIC 9(01). * *----> ---------------------- * *----> VERFALLDATUM AUS BMP14 * *----> ---------------------- 05 Z-VFDAT PIC 9(04). 05 Z-VFDAT-JJMM REDEFINES Z-VFDAT. 10 Z-VFDAT-JJ PIC 9(02). 10 Z-VFDAT-MM PIC 9(02). 88 M-VFDAT-MM-EC-OK VALUE 11, 12. * *----> -------------------------------- * *----> ART DER DATENERFASSUNG AUS BMP22 * *----> -------------------------------- 05 Z-DATER PIC 9(04). 05 REDEFINES Z-DATER. 10 Z-DATER-12 PIC 9(02). 88 Z-DATER-FALLBACK VALUE 80. 10 Z-DATER-34 PIC 9(02). 88 Z-DATER-MIT-PIN VALUE 01. 88 Z-DATER-OHNE-PIN VALUE 02. * *----> ----------------------------------------- * *----> IDENTNUMMER AUS UND FÜR ABSENDER IN BMP33 * *----> ----------------------------------------- 05 Z-IDNR PIC 9(06). 05 REDEFINES Z-IDNR. 10 Z-IDNR-1-2 PIC 9(02). 10 Z-IDNR-3 PIC 9(01). 10 Z-IDNR-4-6 PIC 9(03). * *----> ----------------------- * *----> SERVICE CODES AUS BMP35 * *----> ----------------------- 05 Z-SP2SVC. 10 Z-SP2SVC-C1 PIC X. 88 M-SP2SVC-C1-MGS VALUE '1'. 88 M-SP2SVC-C1-EMV VALUE '2'. 10 Z-SP2SVC-C2 PIC X. 10 Z-SP2SVC-C3 PIC X. 05 REDEFINES Z-SP2SVC PIC X(03). 88 M-SP2SVC-OK VALUE '101' '121' '123' '201' '221' '223'. 88 M-SP2SVC-EC VALUE '101' '201'. 88 M-SP2SVC-BS VALUE '121' '123' '221' '223'. * *----> ----------------- * *----> WÄHRUNG AUS BMP49 * *----> ----------------- 05 Z-WAEHR PIC 9(03) VALUE ZERO. * *----> ---------------------- * *----> ERSATBETRÄGE AUS BMP95 * *----> ---------------------- 05 Z-TEILBT PIC 9(10)V99 VALUE ZERO. 05 FILLER REDEFINES Z-TEILBT. 10 Z-TEILBT-9 PIC 9(12). 05 FILLER REDEFINES Z-TEILBT. 10 Z-TEILBT-X PIC X(12). * *----> ------------------------ * *----> SERVICE-CODES FÜR BS2328 * *----> ------------------------ 05 Z-BEKTO PIC 9(02). 05 REDEFINES Z-BEKTO. 10 Z-BEKTO1 PIC 9(01). 10 Z-BEKTO2 PIC 9(01). * *----> ---------- * *----> TAG-NUMMER * *----> ---------- 05 Z-TAGNR PIC X(04). * *----> ------------------------ * *----> TRANSAKTIONSCODE EINGABE * *----> ------------------------ 05 TRC-EINGABE. 10 TRC-EINGABE-1-3 PIC X(03) VALUE ' '. 10 TRC-EINGABE-SYSID PIC X(03) VALUE ' '. 10 TRC-EINGABE-7-8 PIC X(02) VALUE ' '. 05 REDEFINES TRC-EINGABE. 10 TRC-EINGABE-1-5 PIC X(05). 10 PIC X(03). * *----> ----------------------- * *----> SWITCH TRANSAKTIONSCODE * *----> ----------------------- 05 SWITCH-TRANS. 10 PIC X(07) VALUE SPACE. 10 SWITCH-TDB PIC X(01) VALUE SPACE. 05 SWITCH-ALTNAME REDEFINES SWITCH-TRANS. 10 SWITCH-TXCODE PIC X(03). 10 SWITCH-SYSID PIC X(03). 10 SWITCH-TXNUMBER PIC X(02). 05 SWITCH-TRANS-RED REDEFINES SWITCH-TRANS. 10 PIC X(03). 10 SWITCH-TXKON-RED PIC X(02). 10 SWITCH-TXIMS-RED PIC X(01). 10 PIC X(02). * *----> -------------- * *----> MASCHINENDATUM * *----> -------------- 05 HEUTE PIC 9(08). 05 REDEFINES HEUTE. 10 HEUTE-JH PIC 9(02). 10 HEUTE-JJ PIC 9(02). 10 HEUTE-MMTT PIC 9(04). 10 REDEFINES HEUTE-MMTT. 15 HEUTE-MM PIC 9(02). 15 HEUTE-TT PIC 9(02). 05 REDEFINES HEUTE. 10 PIC 9(02). 10 HEUTE-JJMM PIC 9(04). 10 PIC 9(02). 05 REDEFINES HEUTE. 10 HEUTE-JHJJ PIC 9(04). 10 PIC 9(04). 05 REDEFINES HEUTE. 10 PIC 9(03). 10 HEUTE-JHJJ-RECHTS PIC 9(01). 10 PIC 9(04). * *----> -------------------------------- * *----> AKTUELLES JAHR + 3 BZW. +4 JAHRE * *----> FÜR KARTEN-VERFALLPRÜFUNG * *----> -------------------------------- 05 HEUTE-JHJJ-PLUS-DREI PIC 9(04). 05 HEUTE-JHJJ-PLUS-VIER PIC 9(04). * *----> -------------------------------- * *----> AKTUELLES JAHR + 1 BZW. -1 JAHRE * *----> FÜR SCHLÜSSELVERSION * *----> -------------------------------- 05 HEUTE-JHJJ-PLUS-1 PIC 9(04). 05 REDEFINES HEUTE-JHJJ-PLUS-1. 10 PIC 9(03). 10 HEUTE-JHJJ-PLUS-1-RECHTS PIC 9(01). 05 HEUTE-JHJJ-MINUS-1 PIC 9(04). 05 REDEFINES HEUTE-JHJJ-MINUS-1. 10 PIC 9(03). 10 HEUTE-JHJJ-MINUS-1-RECHTS PIC 9(01). * *----> ----------------- * *----> TRANSAKTIONSDATUM * *----> ----------------- 05 Z-TRDAT PIC 9(08). 05 REDEFINES Z-TRDAT. 10 Z-TRDAT-JHJJ PIC 9(04). 10 REDEFINES Z-TRDAT-JHJJ. 15 Z-TRDAT-JH PIC 9(02). 15 Z-TRDAT-JJ PIC 9(02). 10 Z-TRDAT-MMTT PIC 9(04). 10 REDEFINES Z-TRDAT-MMTT. 15 Z-TRDAT-MM PIC 9(02). 15 Z-TRDAT-TT PIC 9(02). * *----> ------------------------------- * *----> ACQUIRER-IDENTNUMMER FÜR BS1830 * *----> ------------------------------- 05 Z-IDENT PIC 9(13) VALUE ZERO. * *----> ----------------- * *----> BNKIDI FÜR BS1830 * *----> ----------------- 05 Z-BNKIDI PIC X(16) VALUE SPACES. 05 REDEFINES Z-BNKIDI. 10 PIC X(01). 10 Z-BNKIDI-KNE1 PIC X(15). * *----> --------------------------------------- * *----> HILFSFELDER DER ZEICHENAUFLÖSUNG * *----> ACHTUNG: HIER WERDEN DIE BIT-POSITIONEN * *----> VON LINKS GEZäHLT * *----> --------------------------------------- 05 Z-CHAR PIC X(01). 05 Z-CHAR-HEX. 10 Z-CHAR-HEX-L PIC X(01). 10 Z-CHAR-HEX-R PIC X(01). 05 Z-CHAR-BITSTRING. 10 Z-CHAR-BITSTRING-L PIC X(04). 10 Z-CHAR-BITSTRING-R PIC X(04). 05 REDEFINES Z-CHAR-BITSTRING. 10 Z-CHAR-BITSTRING-BIT-1 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-1-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-1-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-2 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-2-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-2-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-3 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-3-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-3-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-4 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-4-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-4-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-5 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-5-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-5-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-6 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-6-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-6-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-7 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-7-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-7-IST-1 VALUE '1'. 10 Z-CHAR-BITSTRING-BIT-8 PIC X(01). 88 Z-CHAR-BITSTRING-BIT-8-IST-0 VALUE '0'. 88 Z-CHAR-BITSTRING-BIT-8-IST-1 VALUE '1'. ./USER KONSTANTEN DATA. 01 KONSTANT-B PIC X(30) VALUE 'BEGINN KONSTANTEN ===> '. * *----> ---------- * *----> KONSTANTEN * *----> ---------- 01 KONSTANTEN. 05 KCD PIC X(01) VALUE 'D'. 05 KCP PIC X(01) VALUE 'P'. 05 KCT PIC X(01) VALUE 'T'. * *----> --------------------------------- * *----> CP-IDENT-NUMMER FÜR KRYPTOGRAPHIE * *----> --------------------------------- 05 K-IDNR-CP-PROD PIC 9(06) VALUE 260007. 05 K-IDNR-CP-TEST PIC 9(06) VALUE 260200. ./USER SCHALTER DATA. 01 SCHALTER-B PIC X(30) VALUE 'BEGINN SCHALTER ===> '. * *----> -------- * *----> SCHALTER * *----> -------- 01 SCHALTER. * *----> ----------- * *----> PIN-PRÜFUNG * *----> ----------- 05 S-PIN-PRUEFUNG PIC X(03) VALUE SPACE. 88 M-PIN-PRUEFUNG-UNBELEGT VALUE ' '. 88 M-PIN-PRUEFUNG-ONLINE VALUE 'ONL'. 88 M-PIN-PRUEFUNG-OFFLINE VALUE 'OFL'. * *----> ----------------- * *----> PROTOKOLLSCHALTER * *----> ----------------- 05 S-PROT PIC 9(03) VALUE 0. 88 M-PROT-UNBELEGT VALUE 0. 88 M-PROT-BMP55-TAG-UNBEKANNT VALUE 1. * *----> ---------------------------------------- * *----> VERARBEITUNGS-SCHALTER * *----> DIE EINZELNEN VERARBEITUNGSSCHRITTE * *----> WERDEN SO LANGE AUSGEFüHRT, BIS EINE * *----> FEHLER-SITUATION EINTRITT. IN DIESEM * *----> FALL WERDEN DANN DIE RESTLICHEN * *----> SCHRITTE IN DIESEM SCHALTER FESTGEHALTEN * *----> UND IM AUSGANG ABGEHANDELT * *----> ---------------------------------------- 05 S-FEHLER PIC 9(03) VALUE 0. 88 M-KEIN-FEHLER VALUE 0. 88 M-FEHLER VALUE 1 THRU 999. 88 M-FEHLER-PLAUSI VALUE 1. 88 M-FEHLER-PLAUSI-BMP55 VALUE 2. 88 M-FEHLER-MAC-VER VALUE 3. 88 M-FEHLER-SYNCHRONISATION VALUE 4. 88 M-FEHLER-BA443U VALUE 5. 88 M-FEHLER-BA437U VALUE 6. 88 M-FEHLER-FALSCHES-IMS VALUE 7. 88 M-FEHLER-ISO-GENO-PLAUSI VALUE 8. 88 M-FEHLER-BA108U-PROT VALUE 9. 88 M-FEHLER-BA108U VALUE 10. 88 M-FEHLER-CASHBACK VALUE 11. 88 M-FEHLER-ANTWORTEN VALUE 001 THRU 899. 88 M-FEHLER-KEINE-ANTWORT VALUE 900 THRU 999. 88 M-FEHLER-WEITERROUTEN VALUE 900. 88 M-FEHLER-ISO-GENO VALUE 901. 88 M-FEHLER-GENO-ISO VALUE 902. 88 M-FEHLER-MAC-GEN VALUE 903. * *----> ----------------------------- * *----> NACHRICHTENWEG (EIN-/AUSGANG) * *----> ----------------------------- 05 S-WEG PIC X(03). 88 M-WEG-EIN VALUE 'EIN'. 88 M-WEG-AUS VALUE 'AUS'. ./USER TABELLEN DATA. ./USER INDIZES DATA. * *----> ------- * *----> INDIZES * *----> ------- 01 INDIZES-B PIC X(30) VALUE 'BEGINN INDIZES ===> '. * *----> ------- * *----> INDIZES * *----> ------- 01 INDIZES. * *----> --------------- * *----> FÜR BMP-TABELLE * *----> --------------- 05 POS-IND PIC S9(04) COMP VALUE +0. 05 POS-MAX PIC S9(04) COMP VALUE +128. 05 DIS-IND PIC S9(04) COMP VALUE +0. 05 DIS-MAX PIC S9(04) COMP VALUE +128. * *----> -------------------- * *----> FÜR AWC-TEXT-TABELLE * *----> -------------------- 05 AWC-IND PIC S9(03) COMP-3 VALUE +0. 05 AWC-MAX PIC S9(03) COMP-3 VALUE +12. * *----> ----------------- * *----> FÜR BMP55-TABELLE * *----> ----------------- 05 BMP55-IND PIC 9(03) VALUE ZERO. 05 BMP55-MAX PIC 9(03) VALUE ZERO. * *----> -------------------- * *----> FÜR ZEICHENUMSETZUNG * *----> -------------------- 05 CHAR-IND PIC S9(02) COMP-3 VALUE ZERO. 05 BITS-IND PIC S9(02) COMP-3 VALUE ZERO. ./USER FEHLERF DATA. 01 FEHLER-B PIC X(30) VALUE 'BEGINN FEHLERTEXTE ===> '. * *----> -------------------------------- * *----> FEHLERTEXTE FÜR VM-PROTOKOLLSATZ * *----> -------------------------------- COPY GAAFETXT. * *----> ----------------- * *----> FEHLERNACHRICHTEN * *----> ----------------- 01 FEHLER-NACHRICHTEN. 05 FEHLER-1. 10 PIC X(26) VALUE 'FEHLER BEI BA108U HIFNR = '. 10 FEHLER-1-HIFNR PIC X(04) VALUE SPACE. 10 PIC X(10) VALUE ' HIFKAT = '. 10 FEHLER-1-HIFKAT PIC X(03) VALUE SPACE. 05 FEHLER-2. 10 PIC X(21) VALUE 'RETURN-CODE FU068U = '. 10 FEHLER-2-CODE PIC 9(04) VALUE ZERO. ./USER INFO-TEXT DATA. 10 INFO-ANZAHL PIC X(02) VALUE '14'. 10 INFO-ZEILE1. 15 INFO-PGM PIC X(08) VALUE 'BA668T '. 15 PIC X(07) VALUE ' IOPCB:'. 15 INFO-IO-PCB PIC X(08) VALUE SPACE. 15 PIC X(06) VALUE ' STAT:'. 15 INFO-STAT PIC X(02) VALUE SPACE. 15 PIC X(06) VALUE ' PREF:'. 15 INFO-PREFIX PIC 9(18) VALUE ZERO. 15 PIC X(05) VALUE ' MOD:'. 15 INFO-MODNAME PIC X(08) VALUE SPACE. 15 PIC X(04) VALUE ' NT:'. 15 INFO-NT PIC 9(04) VALUE ZERO. 15 PIC X(04) VALUE SPACE. 10 INFO-ZEILE2. 15 PIC X(05) VALUE ' BLZ:'. 15 INFO-BLZ PIC 9(08) VALUE ZERO. 15 PIC X(05) VALUE ' KTO:'. 15 INFO-KTONR PIC 9(10) VALUE ZERO. 15 PIC X(06) VALUE ' TRNR:'. 15 INFO-TRNR PIC 9(06) VALUE ZERO. 15 PIC X(07) VALUE ' TRDAT:'. 15 INFO-TRDAT PIC 9(08) VALUE ZERO. 15 PIC X(07) VALUE ' TRUHR:'. 15 INFO-TRUHR PIC 9(06) VALUE ZERO. 15 PIC X(06) VALUE ' RZBK:'. 15 INFO-RZBK PIC 9(04) VALUE ZERO. 15 PIC X(06) VALUE ' KOND:'. 15 INFO-KOND PIC 9(02) VALUE ZERO. 10 INFO-ZEILE3. 15 PIC X(48) VALUE '*** IN DER NAECHSTEN ZEILE BEGINNT DIE EINGABE-'. 15 PIC X(32) VALUE 'MESSAGE IN DUMP-FORMAT ***'. 10 INFO-MESSAGE-HEX. 15 INFO-MESSAGE PIC X(360) VALUE SPACE. 15 PIC X(56) VALUE '*ENDE DER MESSAGE*'. 10 INFO-TABELLE. 15 OCCURS 6. 20 INFO-GAA-MSG-ELEM PIC X(80) VALUE SPACE. * *----> ------------------------ * *----> FEHLER BEI AUFRUF BA356U * *----> ------------------------ 10 INFO-BA356U. 15 PIC X(31) VALUE 'FEHLER BEI AUFRUF BA356U, RC = '. 15 INFO-BA356U-RC PIC 9(02). 15 PIC X(05) VALUE ' RC1='. 15 INFO-BA356U-RC1 PIC 9(02). 15 PIC X(05) VALUE ' RC2='. 15 INFO-BA356U-RC2 PIC 9(02). 15 PIC X(33) VALUE ' FEHLERTEXT IN DER NäCHSTEN ZEILE'. * *----> ------------------------ * *----> FEHLER BEI AUFRUF BA108U * *----> ------------------------ 10 INFO-BA108U. 15 PIC X(31) VALUE 'FEHLER BEI AUFRUF BA108U, RC = '. 15 INFO-BA108U-AWC PIC 9(03). 15 PIC X(09) VALUE ' VBA1081:'. 15 INFO-VBA1081 PIC X(127). ./USER LINKAGE-SECTION. ./USER PROGRAM-ENTRY. ./USER A05-VORLAUF TEXT. * *----> ------------------------------------- * *----> ANFORDERN TECHNISCHE DATEN MIT BA087U * *----> ------------------------------------- ./USER A05-VORLAUF PROC. * *----> ------------------------------------- * *----> ANFORDERN TECHNISCHE DATEN MIT BA087U * *----> ------------------------------------- MOVE SWT-PGM-NAME TO VBA0871-PNAME INFO-PGM MOVE ZERO TO VBA0871-RZBK VBA0871-BLZ SET VBA0871-TECDAT TO TRUE * *----> ------------- * *----> AUFRUF BA087U * *----> ------------- PERFORM I05-VBA087U * *----> ------------------------------ * *----> INITIALISIERUNG VON MSG-FELDER * *----> ------------------------------ MOVE LOW-VALUE TO E-MSG MOVE SWT-GU TO VFU0751-FUNKT * *----> --------------------------------------- * *----> DYNAMISCHE ERMITTLUNG DER TABELLENLÄNGE * *----> --------------------------------------- COMPUTE BMP55-MAX = LENGTH OF BS4353-TAGS / LENGTH OF BS4353-TAGTAB (1) CONTINUE. ./USER B05-LESEN-INPUT TEXT. * *----> ---------------------------------- * *----> STEUERNDES LESEN IMS MESSAGE QUEUE * *----> ---------------------------------- ./USER B05-LESEN-INPUT PROC. IF IO-PCB-STAT = 'QC' THEN MOVE SWT-ON TO PS05-LAST ELSE * *----> ---------------------------------- * *----> * *----> ---------------------------------- MOVE E-MSG TO INFO-TABELLE MOVE E-MSG-TXCODE TO TRC-EINGABE END-IF. ./USER F05-VERARBEITUNG TEXT. * *----> ------------ * *----> VERARBEITUNG * *----> ------------ ./USER F05-VERARBEITUNG PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY '---------------------------------' '------ ENTRY BA668T -------------' '---------------------------------' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' TIMESTAMP : ' SWT-DATE-COMPILED DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' IDENT : ' IDENT DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' IDENT2 : ' IDENT2 DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' IO-PCB-NAME : ' IO-PCB-NAME END-IF * *----> ------------------------------------------ * *----> SETZEN VERARBEITUNGSSCHALTER * *----> DATUM ANFORDERN * *----> BEREICHE UND ZWISCHENFELDER INITIALISIEREN * *----> ------------------------------------------ PERFORM F0505-INIT * *----> ----------------------------------- * *----> BA555U ISO-GENO-UMSETZUNG * *----> ERGEBNIS STEHT IN BS7435 UND BS4353 * *----> ----------------------------------- PERFORM F0510-ISO-GENO * *----> ------------------ * *----> PRÜFEN DER MESSAGE * *----> ------------------ IF M-KEIN-FEHLER THEN PERFORM F0515-GENO-PRUEF END-IF * *----> ---------------------------------- * *----> BA108U EINGANGS-SYNCHRONISATION S1 * *----> ---------------------------------- IF M-KEIN-FEHLER THEN PERFORM F0520-SYNC-S1-BA108U END-IF * *----> -------------------------------------------------- * *----> EVENT-DATEN FÜR SB-ÜBERWACHUNG SCHREIBEN (EINGANG) * *----> -------------------------------------------------- IF M-KEIN-FEHLER OR M-FEHLER-ANTWORTEN THEN PERFORM F0590-UEBERWACHUNG END-IF * *----> --------------------- * *----> ENDE DER VERARBEITUNG * *----> --------------------- PERFORM F0525-AUSGABE * *----> -------------------------------------------------- * *----> EVENT-DATEN FÜR SB-ÜBERWACHUNG SCHREIBEN (AUSGANG) * *----> -------------------------------------------------- IF M-FEHLER-ANTWORTEN THEN PERFORM F0590-UEBERWACHUNG END-IF * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ENDE MIT NT: ' BS7435-NTYP DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ANTWORTCODE: ' BS7435-BMP039-AWCD DISPLAY '---------------------------------' '------ EXIT BA668T -------------' '---------------------------------' END-IF * *----> -------------- * *----> PUTZEN AM ENDE * *----> -------------- MOVE LOW-VALUE TO E-MSG CONTINUE. ./USER F0505-INIT TEXT. * *----> ------------------------------------------ * *----> SETZEN VERARBEITUNGSSCHALTER * *----> DATUM ANFORDERN * *----> BEREICHE UND ZWISCHENFELDER INITIALISIEREN * *----> ------------------------------------------ ./USER F0505-INIT PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' INIT BEREICHE UND ZWISCHENFELDER' END-IF * *----> ----- * *----> INITS * *----> ----- SET M-KEIN-FEHLER TO TRUE SET M-PROT-UNBELEGT TO TRUE SET M-WEG-EIN TO TRUE * *----> ----------------------------- * *----> DATUM UND UHRZEIT ANFORDERN * *----> DATUM UM JAHRHUNDERT ERGÄNZEN * *----> MIT ML210U * *----> ----------------------------- MOVE 14 TO VML2101-FUNKT MOVE 01 TO VML2101-F14-FORM1 VML2101-F14-FORM2 MOVE ZERO TO VML2101-F14-DATUM MOVE ZERO TO VML2101-F14-UHRZ MOVE SPACES TO VML2101-F14-ZART1 VML2101-F14-ZART2 VML2101-F14-TABELLE * *----> ------------- * *----> AUFRUF ML210U * *----> ------------- PERFORM I35-ML210U MOVE VML2102-F14-RDATUM TO HEUTE * *----> ------------- * *----> AUFRUF FU143U * *----> ------------- PERFORM I50-FU143U * *----> ------------------------------------------ * *----> BEREICHE UND ZWISCHENFELDER INITIALISIEREN * *----> ------------------------------------------ MOVE L-VBA1081 TO VBA1081 MOVE L-BS1830 TO BS1830 MOVE L-BS2328 TO BS2328 MOVE L-BS2300 TO BS2300 MOVE L-BS2319 TO BS2319 MOVE L-BS7435 TO BS7435 MOVE L-BS7435 TO SEND-BS7435 MOVE L-BS4353 TO BS4353 MOVE L-BS4353 TO SEND-BS4353 MOVE L-BS4401 TO BS4401 MOVE SPACE TO Z-SP2SVC Z-BNKIDI MOVE ZERO TO Z-WAEHR Z-TEILBT Z-DATER Z-BEKTO Z-DZ Z-TRDAT Z-VFDAT Z-IDNR Z-IDENT MOVE 9999 TO BS1830-RZBK CONTINUE. ./USER F0510-ISO-GENO TEXT. * *----> ---------------------------------------- * *----> BA555U ISO-GENO UMSETZUNG EINGABEMESSAGE * *----> ---------------------------------------- ./USER F0510-ISO-GENO PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ISO-GENO-UMSETZUNG' END-IF * *----> ---------------------------------------- * *----> BA555U ISO-GENO UMSETZUNG EINGABEMESSAGE * *----> ---------------------------------------- MOVE L-VBA5551 TO VBA5551 MOVE SWT-PGM-NAME TO VBA5551-PGM SET VBA5551-PEST-A TO TRUE SET VBA5551-FKT-ISO-GENO TO TRUE SET VBA5551-ANWEND-EC-CASH TO TRUE SET VBA5551-KOMPAR-AS-AS TO TRUE * *----> ----------------------- * *----> POINTERLEISTE VERSORGEN * *----> ----------------------- MOVE 'VFU1431' TO VBA5551-PTAB-BEZ(1) SET VBA5551-PTAB-PTR(1) TO ADDRESS OF VFU1431 MOVE 'VBA0872' TO VBA5551-PTAB-BEZ(2) SET VBA5551-PTAB-PTR(2) TO ADDRESS OF VBA0872 MOVE 'ISODATEN' TO VBA5551-PTAB-BEZ(3) MOVE E-MSG-ISOSA TO ISOSA-01 SET VBA5551-PTAB-PTR(3) TO ADDRESS OF ISOSA-01 MOVE 'BS7435' TO VBA5551-PTAB-BEZ(4) SET VBA5551-PTAB-PTR(4) TO ADDRESS OF BS7435 MOVE 'BS4353' TO VBA5551-PTAB-BEZ(5) SET VBA5551-PTAB-PTR(5) TO ADDRESS OF BS4353 MOVE 'ISOBMP55' TO VBA5551-PTAB-BEZ(7) SET VBA5551-PTAB-PTR(7) TO ADDRESS OF ISOBMP55 * *----> ---------------------- * *----> AUFRUF BA555U ISO-GENO * *----> ---------------------- PERFORM I20-BA555U * *----> ----------------- * *----> ERGEBNIS ISO-GENO * *----> ----------------- EVALUATE TRUE WHEN VBA5559-RC-OK * *----> ------------------------------ * *----> PROTOKOLLSÄTZE FÜR KONTROLL-DB * *----> AUS GENO ERSTELLEN * *----> ------------------------------ PERFORM F051010-PROT-ISO-GENO WHEN VBA5559-RC-FEHLER AND VBA5559-HIFKAT-PIS * *----> ------------------------------ * *----> PROTOKOLLSÄTZE FÜR KONTROLL-DB * *----> AUS GENO ERSTELLEN * *----> ------------------------------ PERFORM F051010-PROT-ISO-GENO * *----> ----------------------------- * *----> FEHLER AUS DER PLAUSI-PRüFUNG * *----> ----------------------------- SET M-FEHLER-ISO-GENO-PLAUSI TO TRUE * *----> ---------------------------------- * *----> ISOAWCD AUS BA555U GGF. üBERNEHMEN * *----> ---------------------------------- IF NOT VBA5559-ISOAWCD-OK THEN MOVE VBA5559-ISOAWCD TO BS7435-BMP039-AWCD ELSE MOVE 30 TO BS7435-BMP039-AWCD END-IF * *----> ------------------------------ * *----> PROTOKOLLSÄTZE FÜR KONTROLL-DB * *----> ------------------------------ PERFORM F051015-PROT-ISO-GENO-FEHLER MOVE 'F2JJJN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC WHEN OTHER * *----> ------------------------------ * *----> PROTOKOLLSÄTZE FÜR KONTROLL-DB * *----> ------------------------------ PERFORM F051010-PROT-ISO-GENO PERFORM F051015-PROT-ISO-GENO-FEHLER MOVE 'F2JJJN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC * *----> -------------------------- * *----> KEINE WEITERE VERARBEITUNG * *----> -------------------------- SET M-FEHLER-ISO-GENO TO TRUE MOVE 30 TO BS7435-BMP039-AWCD * *----> ---------------------- * *----> ISOSATZ PROTOKOLLIEREN * *----> ---------------------- PERFORM F051020-PROT-ISOSA END-EVALUATE * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN IF BS7435-NTYP = 100 THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ============================' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ===> ANFRAGE <===' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ============================' ELSE DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ============================' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ===> STORNO <===' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ============================' END-IF END-IF CONTINUE. ./USER F051010-PROT-ISO-GENO TEXT. * *----> ------------------------------- * *----> VERSORGEN SYNCHRONISATIONS-SATZ * *----> EINGABE-SATZ E2 * *----> AUS GENO-SATZ * *----> ------------------------------- ./USER F051010-PROT-ISO-GENO PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VERSORGEN PROTOKOLLSÄTZE AUS GENO-SATZ' END-IF * *----> --------------------------------------------- * *----> VERSORGEN SYNCHRONISATIONS-SATZ BS1830-FELDER * *----> --------------------------------------------- MOVE BS7435-BMP002-PAN TO BS1830-PAN MOVE BS7435-BMP023-FOLG TO BS1830-FOLG MOVE BS7435-BMP014-VERFDT TO BS1830-VERF IF ( BS7435-NTYP = 420 OR 421 ) AND BS7435-BMP037-TRNR > ZERO THEN MOVE BS7435-BMP037-TRNR TO BS1830-TRNR ELSE MOVE BS7435-BMP011-TRNR TO BS1830-TRNR END-IF * *----> ------------------------------------------- * *----> ERMITTELN TRANSAKTIONSUHRZEIT UND -DATUM * *----> ANFRAGE : AUS BMP 12 UND 13 * *----> AUTOMATISCHER STORNO: AUS BMP 12 UND 37.1 * *----> (BMP 12 STIMMT MIT BMP 12 DER ANFRAGE * *----> UEBEREIN) * *----> MANUELLER STORNO : * *----> - DATUM (MMTT) AUS BMP 37.1 * *----> - URSPRUNGSUHRZEIT AUS DER ANFRAGE STEHT * *----> NICHT ZUR VERFüGUNG, DAHER WIRD DIE * *----> UHRZEIT AUS BMP12 EINGESTELLT. * *----> ------------------------------------------- IF ( BS7435-NTYP = 420 OR 421 ) THEN MOVE BS7435-BMP012-TRUHR TO Z-DZ-ZEIT MOVE BS7435-BMP037-DATUM TO Z-DZ-MMTT ELSE MOVE BS7435-BMP012-TRUHR TO Z-DZ-ZEIT MOVE BS7435-BMP013-TRDAT TO Z-DZ-MMTT END-IF MOVE Z-DZ-MMTT TO Z-TRDAT-MMTT MOVE HEUTE-JH TO Z-TRDAT-JH MOVE HEUTE-JJ TO Z-TRDAT-JJ * *----> ----------------------------- * *----> JAHRESWECHSEL BERÜCKSICHTIGEN * *----> ----------------------------- IF Z-TRDAT-MM = 01 AND HEUTE-MM = 12 THEN ADD 1 TO Z-TRDAT-JHJJ ELSE IF Z-TRDAT-MM = 12 AND HEUTE-MM = 01 THEN SUBTRACT 1 FROM Z-TRDAT-JHJJ END-IF END-IF MOVE Z-TRDAT TO BS1830-TRDAT MOVE Z-DZ-ZEIT TO BS1830-TRUHR MOVE '2' TO BS1830-KASPUR MOVE 'A' TO BS1830-VERS MOVE TRC-EINGABE TO BS1830-TRCODE MOVE IO-PCB-NAME TO BS1830-LTERMA * *----> ------------------------------------- * *----> ERMITTELN VORGANGSART DER TRANSAKTION * *----> ------------------------------------- MOVE BS7435-BMP032-IDACQ TO Z-IDENT MOVE Z-IDENT TO BS1830-IDNR MOVE BS7435-BMP042-HAENDLID TO Z-BNKIDI-KNE1 MOVE Z-BNKIDI TO BS1830-BNKIDI MOVE BS7435-BMP041-TERMID TO BS1830-GAANRI MOVE BS7435-BMP004-BETRAG TO BS1830-BETRAG MOVE BS7435-BMP025-KONCD TO BS1830-LKOND * *----> ------------------------------------- * *----> PACKZ 0 = PIN WURDE DEZENTRAL IM CHIP * *----> GEPRUEFT UND IST OKAY * *----> PACKZ 2 = PIN WIRD ZENTRAL GEPRUEFT * *----> ------------------------------------- IF BS7435-BIT-BMP052-ON MOVE +2 TO BS1830-PACKZ ELSE MOVE ZERO TO BS1830-PACKZ END-IF * *----> --------- * *----> KARTENART * *----> --------- MOVE BS7435-BMP035-SP2SC1 TO Z-SP2SVC-C1 MOVE BS7435-BMP035-SP2SC2 TO Z-SP2SVC-C2 MOVE BS7435-BMP035-SP2SC3 TO Z-SP2SVC-C3 EVALUATE TRUE WHEN M-SP2SVC-EC MOVE X'C2C394D7' TO BS1830-KAART WHEN M-SP2SVC-BS MOVE X'C2C396D7' TO BS1830-KAART END-EVALUATE * *----> --------------------------- * *----> ERSATZBETRAG BEI TEILSTORNO * *----> --------------------------- IF ( BS7435-NTYP = 420 OR 421 ) AND BS7435-BMP095-TEILBT NUMERIC AND BS7435-BMP095-TEILBT > ZERO THEN MOVE BS7435-BMP095-TEILBT TO BS1830-ERSATZ ELSE MOVE ZERO TO BS1830-ERSATZ END-IF * *----> --------------------------------------- * *----> VERSORGEN E2 EINGABE-SATZ BS4401-FELDER * *----> --------------------------------------- MOVE L-BS4400 TO BS4400E MOVE 'E2' TO BS4400E-ART MOVE 668 TO BS4401-PRSTE MOVE IO-PCB-NAME TO BS4401-LTERM MOVE TRC-EINGABE TO BS4401-TRCOD MOVE BS7435-NTYP TO BS4401-NTYP MOVE BS7435-BMP003-ABWKZ TO BS4401-ABWKZ MOVE BS7435-BMP025-KONCD TO BS4401-KONDC MOVE BS7435-BMP033-IDNR TO BS4401-IDNR MOVE ZERO TO BS4401-MM MOVE BS7435-BMP035-SP2SC1 TO BS4401-FRSL MOVE BS7435-BMP035-SP2SC2 TO Z-BEKTO1 MOVE BS7435-BMP035-SP2SC3 TO Z-BEKTO2 MOVE Z-BEKTO TO BS4401-BEKTO MOVE BS7435-BMP057-SLGNEU TO BS4401-SLGN MOVE BS7435-BMP057-SLVNEU TO BS4401-SLVER MOVE KCP TO BS4401-PINKZ MOVE BS7435-BMP022-DATER TO BS4401-DATER Z-DATER MOVE BS7435-BMP004-BETRAG TO BS4401-TBETR MOVE BS7435-BMP049-WAEACQ TO BS4401-WACQ Z-WAEHR MOVE Z-WAEHR TO BS4401-WACIS MOVE BS7435-BMP037 TO BS4401-REFNR COMPUTE BS4401-LZEIT = BS7435-BMP013-TRDAT * 1000000 + BS7435-BMP012-TRUHR MOVE BS7435-BMP032-IDACQ TO BS4401-AIDAT MOVE BS7435-BMP037-TRNR TO BS4401-TRNU * *----> -------------------------------------------- * *----> VERSORGEN E2 ZUSAETZLICHE ZEILE FUER * *----> BIN, HAENDLER-INFOS UND GGF. CASHBACK-BETRAG * *----> -------------------------------------------- MOVE BS7435-BMP002-PAN(1:8) TO BS4401-BIN MOVE BS7435-BMP042-HAENDLID TO BS4401-HAENDID MOVE BS7435-BMP043 TO BS4401-KNID IF BS7435-BMP003-ABWKZ-ECC-MCB THEN MOVE BS7435-BMP054-CASHBACK TO BS4401-CASHBACK END-IF * *----> ------------------------------------ * *----> VERSORGEN E2 ZUSAETZLICHE ZEILE FUER * *----> URSPRUNGSDATEN BEI STORNO/-WDH * *----> ------------------------------------ IF ( BS7435-NTYP = 420 OR 421 ) THEN MOVE BS7435-BMP037-TRNR TO BS4401-TRNU MOVE BS7435-BMP037-DATUM TO BS4401-DATU MOVE BS7435-BMP038-AUTKZ TO BS4401-AID END-IF * *----> ------------------------------------ * *----> VERSORGEN E2 ZUSAETZLICHE ZEILE FUER * *----> ERSATZBETRAG BEI TEIL-STORNO/-WDH * *----> ------------------------------------ IF ( BS7435-NTYP = 420 OR 421 ) AND BS7435-BMP095-TEILBT NUMERIC AND BS7435-BMP095-TEILBT > ZERO THEN MOVE BS7435-BMP095-TEILBT TO Z-TEILBT MOVE Z-TEILBT-9 TO BS4401-EEUR BS4401-ECUR END-IF * *----> ------------- * *----> BS4401 SETZEN * *----> ------------- MOVE 'BS4401' TO BS4400E-COPY MOVE LENGTH OF BS4401 TO BS4400E-VARLNG MOVE BS4401 TO BS4400E-VAR * *----> ------------------------------------------ * *----> VERSORGEN VERARBEITUNGS-SATZ BS2300-FELDER * *----> ------------------------------------------ MOVE BS7435-NTYP TO BS2300-NTYP MOVE BS7435-BMP003-ABWKZ TO BS2300-ABWKZ MOVE 'VM' TO BS2300-ART MOVE PID TO BS2300-HIFPIM * *----> ---------------------------------------------- * *----> VERSORGEN VBA1081-SCHNITTSTELLE VBA1081-FELDER * *----> ---------------------------------------------- MOVE BS7435-BMP003-ABWKZ TO VBA1081-ABWKZ MOVE BS7435-NTYP TO VBA1081-NTE CONTINUE. ./USER F051015-PROT-ISO-GENO-FEHLER TEXT. * *----> ---------------------------------- * *----> FÜLLEN PROT-SÄTZE WENN FEHLERHAFTE * *----> ISO-GENO-UMSETZUNG * *----> ----------------------------------- ./USER F051015-PROT-ISO-GENO-FEHLER PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VERSORGEN PROTOKOLLSÄTZE WENN ISO-GENO-FEHLER' END-IF * *----> --------------------------------------------- * *----> VERSORGEN SYNCHRONISATIONS-SATZ BS1830-FELDER * *----> --------------------------------------------- MOVE 1 TO BS1830-KZKRI MOVE '2' TO BS1830-KASPUR MOVE 'A' TO BS1830-VERS MOVE TRC-EINGABE TO BS1830-TRCODE MOVE IO-PCB-NAME TO BS1830-LTERMA * *----> ------------------------------------------ * *----> VERSORGEN VERARBEITUNGS-SATZ BS2300-FELDER * *----> ------------------------------------------ MOVE 'VM' TO BS2300-ART MOVE PID TO BS2300-HIFPIM MOVE VBA5559-HIFKAT TO BS2300-HIFKAM MOVE VBA5559-HIFNR TO BS2300-HIFNRM MOVE VBA5559-HIFTXT TO BS2300-FTXT1M MOVE BS7435-BMP049-WAEACQ TO Z-WAEHR BS1830-WSLA * *----> ---------------------- * *----> VERSORGEN EINGABE-SATZ * *----> ---------------------- MOVE 'E1' TO BS2328-ART MOVE 668 TO BS2328-PRSTE1 MOVE E-MSG-ISOSA TO BS2328-ISOSA CONTINUE. ./USER F051020-PROT-ISOSA TEXT. * *----> ---------------------- * *----> PROTOKOLLIEREN ISOSATZ * *----> ---------------------- ./USER F051020-PROT-ISOSA PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BA615U PROT. ISOSATZ IN HEX, MAX 20 ZEILEN' END-IF * *----> -------------- * *----> STEUERUNG K-DB * *----> -------------- MOVE 1 TO BS1830-KZKRI MOVE PID TO BS2300-HIFPIM * MOVE 'A1NNJN' TO VBA1081-STKZ MOVE 'F1NNJN' TO VBA1081-STKZ * *----> ----------------------------------------- * *----> WIE LANG IST DER ISOSATZ * *----> JE ZEILE 80 ZEICHEN HEX = 40 BYTES ISOSA * *----> ----------------------------------------- MOVE ZERO TO X1 X2 X3 X4 Z-LNG-ISOSA * *----> ------------------------------------- * *----> X5 = POSITION IM ISOSA ZUM üBERTRAGEN * *----> ------------------------------------- MOVE 1 TO X5 MOVE VBA5559-ISOLNG TO Z-LNG-ISOSA IF VBA5559-ISOLNG < 80 THEN MOVE 200 TO Z-LNG-ISOSA END-IF * *----> -------------------------------------- * *----> X2 = ANZAHL ZEILEN MIT RESTLäNGE IN X3 * *----> -------------------------------------- DIVIDE Z-LNG-ISOSA BY 40 GIVING X2 REMAINDER X3 * *----> ---------------------------------- * *----> X2 UM 1 ERHöHEN WENNS NEN REST GAB * *----> ---------------------------------- IF ( X3 > ZERO ) OR ( X2 = ZERO ) THEN ADD 1 TO X2 END-IF * *----> -------------------- * *----> AUSGEBEN IN SCHLEIFE * *----> -------------------- PERFORM VARYING X1 FROM 1 BY 1 UNTIL X1 > X2 OR X1 > 20 * *----> ------------------------------------- * *----> X4 = ANZAHL ZEICHEN ISOSA FüR AUSGABE * *----> UND KONVERTIERUNG IN HEX * *----> ------------------------------------- IF X3 > 0 AND X1 = X2 THEN COMPUTE X4 = X3 ELSE COMPUTE X4 = 40 END-IF MOVE E-MSG-ISOSA (X5:X4) TO VFU068U-ITEXT MOVE X4 TO VFU068U-LL PERFORM U49-HEXSTRING MOVE VFU068U-OTEXT(1:2 * X4) TO BS2300-FTXT1M PERFORM U01-PROT-UND-SYNC * *----> ------------------------------------- * *----> X5 = POSITION IM ISOSA FüR HEXCONVERT * *----> ------------------------------------- ADD X4 TO X5 END-PERFORM CONTINUE. ./USER U49-HEXSTRING TEXT. * *----> ----------------------- * *----> ZEICHEN IN HEX AUFLÖSEN * *----> ----------------------- ./USER U49-HEXSTRING PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' FU068U HEX-UMSETZUNG' END-IF * *----> -------------------------- * *----> ZEICHEN IN HEXA-HORIZONTAL * *----> -------------------------- MOVE 'HD' TO VFU068U-FUNKT MOVE LOW-VALUES TO VFU068U-OTEXT VFU068U-OZONE VFU068U-OZIFF * *----> ----------- * *----> CALL FU068U * *----> ----------- PERFORM I55-FU068U IF RETURN-CODE NOT = ZERO THEN MOVE RETURN-CODE TO FEHLER-2-CODE MOVE FEHLER-2 TO INFO-TABELLE IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ABBRUCH WEGEN ' FEHLER-2 END-IF CALL FU008U USING K-ABEND INFO-TEXT END-IF CONTINUE. ./USER F0515-GENO-PRUEF TEXT. * *----> ---------------------------------------------- * *----> 1 PRÜFUNG OB BLZ AUF ROUTING DB * *----> 2 PRÜFUNG OB AGREE-BANK * *----> 3 ERMITTELN RZBK * *----> 4 PRÜFUNG OB IM RICHTIGEN IMS * *----> 5 KORRELATIONSPRüFUNGEN DER UMGESETZTEN BMPS * *----> 6 PLAUSIBILITÄTSKONTROLLE DER UMGESETZTEN BMP55 * *----> 8 PRÜFUNG KRYPTOGRAPHIE * *----> 9 PRÜFUNG MAC IN EINGABE * *----> ALLE FEHLER DER PRÜFUNGEN WERDEN PROTOKOLLIERT * *----> ---------------------------------------------- ./USER F0515-GENO-PRUEF PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PRÜFEN UMGESETZTE NACHRICHT' END-IF * *----> ----------------- * *----> CASHBACK ABLEHNEN * *----> ----------------- IF BS7435-BMP003-ABWKZ-ECC-MCB THEN PERFORM F051502-CASHBACK-ABLEHNEN END-IF * *----> -------------------------------------- * *----> ERMITTLUNG KARTENART AUS DEN SPURDATEN * *----> -------------------------------------- IF M-KEIN-FEHLER THEN PERFORM F051505-BA443U END-IF * *----> -------------------------------------- * *----> ERMITTLUNG BLZ, RZBK, TEILDB UND TRART * *----> UND PRÜFEN OB IM RICHTIGEN IMS * *----> -------------------------------------- IF M-KEIN-FEHLER THEN PERFORM F051510-BA437U END-IF * *----> --------------------- * *----> KORRELATIONSPRÜFUNGEN * *----> DER UMGESETZTEN BMPS * *----> --------------------- IF M-KEIN-FEHLER THEN PERFORM F051515-KORREL END-IF * *----> --------------------- * *----> PLAUSIBILITÄTSPRÜFUNG * *----> DER UMGESETZTEN BMP55 * *----> --------------------- IF M-KEIN-FEHLER AND BS7435-BIT-BMP055-ON AND BS7435-NTYP = 100 THEN PERFORM F051520-PLAUSI-BMP55 END-IF * *----> ---------- * *----> MAC VERIFY * *----> ---------- IF M-KEIN-FEHLER THEN * *----> ---------- * *----> MIT BA341U * *----> ---------- PERFORM F051530-MAC-VERIFIZIERUNG END-IF CONTINUE. ./USER F051502-CASHBACK-ABLEHNEN TEXT. * *----> ----------------- * *----> CASHBACK ABLEHNEN * *----> ----------------- ./USER F051502-CASHBACK-ABLEHNEN PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' CASHBACK ABLEHNEN' END-IF * *----> ----------------- * *----> CASHBACK ABLEHNEN * *----> ----------------- SET M-FEHLER-CASHBACK TO TRUE MOVE 1 TO BS1830-KZKRI MOVE 05 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE 'PIS' TO BS2300-HIFKAM MOVE '003A' TO BS2300-HIFNRM MOVE BS7435-BMP054-CASHBACK TO Z-BETRAG-CB STRING 'CASHBACK NICHT ZUGELASSEN! #' Z-BETRAG-CB '#' DELIMITED BY SIZE INTO BS2300-FTXT1M PERFORM U84-PROT-E2-VM CONTINUE. ./USER F051505-BA443U TEXT. * *----> ------------------------------------------- * *----> AUFRUF BA443U ERMITTLUNG KARTENART AUS SPUR * *----> ------------------------------------------- ./USER F051505-BA443U PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' EMV ERMITTELN KARTENART BA443U' END-IF * *----> --------------------------------- * *----> BELEGEN VERBINDUNGSBEREICH BA443U * *----> --------------------------------- MOVE L-VBA4431 TO VBA4431 MOVE L-VBA4439 TO VBA4439 MOVE SWT-PGM-NAME TO VBA4431-PGM MOVE VBA0872-IMSTYP TO VBA4431-IMSTYP MOVE VBA0872-FIRMA TO VBA4431-FIRMA MOVE VBA0872-IMSIDG TO VBA4431-IMSIDG MOVE VBA0872-SYSID TO VBA4431-SYSID * *----> --------------- * *----> FUNKTION SPUR-2 * *----> --------------- SET VBA4431-FUNKT-SPUR2 TO TRUE * *----> ------- * *----> DIE PAN * *----> ------- MOVE BS7435-BMP002-PAN TO VBA4431-PAN * *----> ------------------ * *----> PANLAENGE: 19 BYTE * *----> ------------------ MOVE BS7435-BMP002-PANLNG TO VBA4431-PANLNG * *----> ------------------------------------------------- * *----> DEN SERVICE-CODE AUS DEN SPUR-2-DATEN EXTRAHIEREN * *----> ------------------------------------------------- MOVE BS7435-BMP035-SP2SC1 TO Z-SP2SVC-C1 MOVE BS7435-BMP035-SP2SC2 TO Z-SP2SVC-C2 MOVE BS7435-BMP035-SP2SC3 TO Z-SP2SVC-C3 MOVE Z-SP2SVC TO VBA4431-SERV2 * *----> --------------------------------- * *----> AUFRUF BA443U ERMITTELN KARTENART * *----> --------------------------------- PERFORM I25-BA443U * *----> ---------------------- * *----> ERGEBNIS AUFRUF BA443U * *----> ---------------------- IF NOT VBA4439-HIFNR-OK THEN * *----> ------ * *----> FEHLER * *----> ------ SET M-FEHLER-BA443U TO TRUE MOVE 1 TO BS1830-KZKRI MOVE 96 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE VBA4439-HIFKAT TO BS2300-HIFKAM MOVE VBA4439-HIFNR TO BS2300-HIFNRM MOVE VBA4439-FETXT TO BS2300-FTXT1M PERFORM U84-PROT-E2-VM END-IF * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST AND NOT VBA4439-HIFNR-OK THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' EMV BA443U FEHLER ERMITTLUNG KARTENART' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' 'HIF= ' VBA4439-HIFKAT '-' VBA4439-HIFNR 'FEHLERTEXT=' VBA4439-FETXT END-IF CONTINUE. ./USER F051510-BA437U TEXT. * *----> ------------------------------------------------- * *----> KARTENBANKLEITZAHL, RZBK, TEILDATENBANK UND TRART * *----> MIT BA437U ERMITTELN * *----> ------------------------------------------------- ./USER F051510-BA437U PROC. * *----> ---------------- * *----> DISPLAY FüR TEST * *----> ---------------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' KARTENBANKLEITZAHL, RZBK, TEILDATENBANK' ' UND TRART MIT BA437U ERMITTELN' END-IF * *----> ------------------------------------------------- * *----> KARTENBANKLEITZAHL, RZBK, TEILDATENBANK UND TRART * *----> MIT BA437U ERMITTELN * *----> ------------------------------------------------- MOVE L-VBA4371 TO VBA4371 MOVE SWT-PGM-NAME TO VBA4371-PGM MOVE KCD TO VBA4371-PEST SET VBA4371-ANWEND-ECC TO TRUE SET VBA4371-FUNKT-OHNE-GERAET TO TRUE MOVE VBA0872-SYSID TO VBA4371-SYSID MOVE VBA0872-IMSIDG TO VBA4371-IMSIDG MOVE VBA0872-IMSTYP TO VBA4371-IMSTYP MOVE VBA0872-FIRMA TO VBA4371-FIRMA MOVE BS7435-BMP002-PANROUTNR TO VBA4371-ROUTNR MOVE VBA4439-KART TO VBA4371-KART MOVE ZERO TO VBA4371-BLZKA * *----> ------------------------------------------ * *----> AUFRUF BA437U - ERMITTLUNG TRANSAKTIONSART * *----> ------------------------------------------ PERFORM I30-BA437U * *----> --------------- * *----> ERGEBNIS BA437U * *----> --------------- IF VBA4379-HIFNR-OK THEN * *----> ---------------------------------------------- * *----> DIE ERMITTELTEN WERTE IM SYNC-SEGMENT AUFHEBEN * *----> ---------------------------------------------- MOVE VBA4379-BLZKA TO BS1830-BLZ MOVE VBA4379-RZBKK TO BS1830-RZBK MOVE VBA4379-TRART TO BS1830-ATRART BS2300-HIFVAM MOVE VBA4379-TRART TO BS1830-TRART MOVE VBA4379-LDBIDK TO BS1830-TDBC ELSE IF VBA4379-HIFNR NOT = 'K008' THEN * *----> ------ * *----> FEHLER * *----> ------ SET M-FEHLER-BA437U TO TRUE MOVE 1 TO BS1830-KZKRI MOVE 92 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE VBA4379-HIFKAT TO BS2300-HIFKAM MOVE VBA4379-HIFNR TO BS2300-HIFNRM MOVE VBA4379-FETXT TO BS2300-FTXT1M PERFORM U84-PROT-E2-VM END-IF END-IF * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PRüFEN OB TRANSAKTION IM RICHTIGEN IMS IST' END-IF IF M-KEIN-FEHLER AND ( VBA4379-HIFNR = 'K008' OR VBA4379-SYSIDK NOT = VBA0872-SYSID ) THEN * *----> ------------------------------ * *----> ANFRAGE NICHT IM RICHTIGEN IMS * *----> ------------------------------ IF TRC-EINGABE-1-5 = 'STIIM' THEN * *----> --------------------- * *----> ANFRAGE WURDE BEREITS * *----> EINMAL WEITERGELEITET * *----> --------------------- MOVE 1 TO BS1830-KZKRI MOVE 92 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE VBA0872-IMSID TO FTXT4-WERT MOVE FTXT4 TO BS2300-FTXT1M MOVE '0002' TO BS2300-HIFNRM MOVE VBA4379-TRART TO BS2300-HIFVAM MOVE PID TO BS2300-HIFPIM MOVE 'ROA' TO BS2300-HIFKAM PERFORM U84-PROT-E2-VM SET M-FEHLER-FALSCHES-IMS TO TRUE ELSE * *----> ------------------------ * *----> ANFRAGE AN RICHTIGES IMS * *----> WEITERLEITEN * *----> ------------------------ MOVE ZERO TO BS7435-BMP039-AWCD BS2300-AWCD MOVE VBA0872-IMSID TO FTXT4-WERT MOVE FTXT4 TO BS2300-FTXT1M MOVE '0001' TO BS2300-HIFNRM MOVE VBA4379-TRART TO BS2300-HIFVAM MOVE PID TO BS2300-HIFPIM MOVE 'ROA' TO BS2300-HIFKAM PERFORM U84-PROT-E2-VM SET M-FEHLER-WEITERROUTEN TO TRUE END-IF END-IF CONTINUE. ./USER F051515-KORREL TEXT. * *----> --------------------------------------- * *----> KORRELATIONSPRÜFUNGEN AUF DIE NACHRICHT * *----> --------------------------------------- ./USER F051515-KORREL PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' KORRELATIONSPRUEFUNGEN DER UMGESETZTEN BMPS' END-IF * *----> ----------- * *----> SPUR2-DATEN * *----> ----------- IF BS7435-BIT-BMP035-ON THEN PERFORM U10-BMP35-SPUR2 END-IF * *----> --------------- * *----> SICHERHEITSINFO * *----> --------------- IF BS7435-BIT-BMP053-ON THEN PERFORM U15-BMP53-SII END-IF * *----> -------------- * *----> ERSATZBETRÄGE * *----> BEI TEILSTORNO * *----> -------------- IF BS7435-BIT-BMP095-ON THEN PERFORM U20-BMP95-ERSBET END-IF * *----> ------------------------------- * *----> FEHLER IN KORRELATIONSPRÜFUNGEN * *----> ------------------------------- IF BS2300-HIFNRM NOT = SPACE THEN MOVE 1 TO BS1830-KZKRI MOVE VBA4379-TRART TO BS2300-HIFVAM MOVE PID TO BS2300-HIFPIM MOVE 'PIS' TO BS2300-HIFKAM PERFORM U84-PROT-E2-VM SET M-FEHLER-PLAUSI TO TRUE END-IF CONTINUE. ./USER F051520-PLAUSI-BMP55 TEXT. * *----> -------------------------- * *----> PLAUSIBILITÄTSPRÜFUNG DER * *----> UMGESETZTEN BMP55 * *----> -------------------------- ./USER F051520-PLAUSI-BMP55 PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' CHIPPRüFUNGEN BMP55 UND TRANSAKTIONSZäHLER' END-IF * *----> ------------------------- * *----> PLAUSIBILITÄTSPRÜFUNG DER * *----> UMGESETZTEN BMP55 * *----> ------------------------- * *----> --------------------------------------- * *----> DYNAMISCHE ERMITTLUNG DER TABELLENLÄNGE * *----> --------------------------------------- COMPUTE BMP55-MAX = LENGTH OF BS4353-TAGS / LENGTH OF BS4353-TAGTAB (1) * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN PERFORM U11-DISPBMP55 END-IF * *----> --------------- * *----> PLAUSI TAG 9F10 * *----> --------------- PERFORM U53-PLAUSI-TAG-9F10 * *----> ------------------- * *----> PLAUSI WEITERE TAGS * *----> ------------------- IF M-KEIN-FEHLER THEN PERFORM WITH TEST BEFORE VARYING BMP55-IND FROM +1 BY +1 UNTIL BMP55-IND > BMP55-MAX OR BS2300-HIFNRM NOT = SPACE EVALUATE BS4353-TAGNR (BMP55-IND) WHEN X'9F27' PERFORM U52-PLAUSI-TAG-9F27 WHEN X'0095' WHEN X'4095' PERFORM U56-PLAUSI-TAG-0095 WHEN X'009A' WHEN X'409A' PERFORM U57-PLAUSI-TAG-009A WHEN X'009C' WHEN X'409C' PERFORM U58-PLAUSI-TAG-009C WHEN X'9F02' PERFORM U59-PLAUSI-TAG-9F02 WHEN X'5F2A' PERFORM U60-PLAUSI-TAG-5F2A WHEN X'4040' WHEN X'9F26' WHEN X'9F10' WHEN X'9F37' WHEN X'9F36' WHEN X'0082' WHEN X'4082' WHEN X'0084' WHEN X'4084' WHEN X'9F03' WHEN X'9F1E' WHEN X'9F34' WHEN X'9F35' WHEN X'9F53' WHEN X'9F33' WHEN X'9F09' WHEN X'9F41' WHEN X'9F1A' CONTINUE WHEN OTHER * *----> ------------------- * *----> INFO PROTOKOLLIEREN * *----> ------------------- MOVE 2 TO VFU068U-LL MOVE BS4353-TAGNR (BMP55-IND) TO VFU068U-ITEXT PERFORM U49-HEXSTRING STRING 'BMP55 TAG #' VFU068U-OTEXT(1:4) '# IST UNBEKANNT!' DELIMITED BY SIZE INTO BS2300-FTXT1M SET M-PROT-BMP55-TAG-UNBEKANNT TO TRUE PERFORM U90-VM-SATZ-SCHREIBEN END-EVALUATE END-PERFORM END-IF * *----> ------------------------- * *----> FEHLER PLAUSI-CHECK BMP55 * *----> ------------------------- IF M-FEHLER-PLAUSI-BMP55 THEN MOVE 1 TO BS1830-KZKRI MOVE PID TO BS2300-HIFPIM IF BS7435-BMP039-AWCD = ZERO THEN MOVE 77 TO BS7435-BMP039-AWCD END-IF MOVE 'PIT' TO BS2300-HIFKAM PERFORM U90-VM-SATZ-SCHREIBEN PERFORM U84-PROT-E2-VM END-IF CONTINUE. ./USER U11-DISPBMP55 TEXT. * *----> ------------------- * *----> AUSGABE BMP55-DATEN * *----> ------------------- ./USER U11-DISPBMP55 PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP55-TAGS DISPLAY' END-IF * *----> ------------------- * *----> AUSGABE BMP55-DATEN * *----> ------------------- PERFORM WITH TEST BEFORE VARYING BMP55-IND FROM +1 BY +1 UNTIL BMP55-IND > BMP55-MAX IF BS4353-TAGLEN (BMP55-IND) > 0 THEN MOVE BS4353-TAGLEN (BMP55-IND) TO Z-TAGLEN * *----> ----------------------- * *----> PAC HEXA IN DRUCKFORMAT * *----> MIT FU068U AUFBEREITEN * *----> ----------------------- MOVE 2 TO VFU068U-LL MOVE BS4353-TAGNR (BMP55-IND) TO VFU068U-ITEXT PERFORM U49-HEXSTRING DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ' BMP55-IND ' BS4353-TAGNR:' VFU068U-OTEXT(1:4) DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS4353-TAGLEN:' Z-TAGLEN MOVE BS4353-TAGLEN (BMP55-IND) TO VFU068U-LL MOVE BS4353-TAGINH (BMP55-IND) TO VFU068U-ITEXT PERFORM U49-HEXSTRING COMPUTE Z-TAGLEN = Z-TAGLEN * 2 DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS4353-TAGINH:' VFU068U-OTEXT (1:Z-TAGLEN) END-IF END-PERFORM CONTINUE. ./USER F051530-MAC-VERIFIZIERUNG TEXT. * *----> --------------------- * *----> MAC PRÜFEN MIT BA341U * *----> --------------------- ./USER F051530-MAC-VERIFIZIERUNG PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MAC VERIFY MIT BA341U' END-IF * *----> ------------------------------------ * *----> VERBINDUNGSBEREICH VBA3411 VERSORGEN * *----> ------------------------------------ MOVE L-VBA3411 TO VBA3411 MOVE SWT-PGM-NAME TO VBA3411-PNAME SET VBA3411-FUNKT-MACVERIFY TO TRUE SET VBA3411-ANWEND-ECC-NATIONAL TO TRUE SET VBA3411-KOMPAR-BETR-AS TO TRUE SET VBA3411-SYNBEZ-KARTE TO TRUE * MOVE NIX TO VBA3411-KARBLZ MOVE BS7435-BMP002-PANKTONR TO VBA3411-KARKTO MOVE BS7435-BMP023-FOLG TO VBA3411-FOLGE MOVE BS7435-BMP014-VERFDT TO VBA3411-VERF MOVE BS7435-BMP011-TRNR TO VBA3411-TRNR MOVE Z-TRDAT TO VBA3411-TRDAT MOVE BS7435-BMP012-TRUHR TO VBA3411-TRUHR MOVE VBA0872-IMSTYP TO VBA3411-IMSTYP MOVE VBA0872-FIRMA TO VBA3411-FIRMA MOVE VBA0872-IMSIDG TO VBA3411-IMSIDG MOVE VBA0872-SYSID TO VBA3411-SYSID MOVE VBA5559-OFSEKY TO VBA3411-OFSKEY MOVE VBA5559-LLISOM TO VBA3411-DATSL * *----> ------------------------------------ * *----> KRYPTO-IDNR MIT 260007 (CP) BELEGEN * *----> ------------------------------------ IF VBA0872-IMSTYP-TEST THEN MOVE K-IDNR-CP-TEST TO VBA3411-IDNR ELSE MOVE K-IDNR-CP-PROD TO VBA3411-IDNR END-IF SET VBA3411-GENVER-VORGEGEBEN TO TRUE MOVE E-MSG-ISOSA TO ISO-BA341U * *----> ----------- * *----> CALL BA341U * *----> ----------- PERFORM I15-BA341U * *----> ------------------ * *----> ERGEBNIS AUSWERTEN * *----> ------------------ IF NOT VBA3419-HIFNR-OK THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MAC FALSCH!' ' MAC FALSCH!' ' MAC FALSCH!' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MAC FALSCH!' ' MAC FALSCH!' ' MAC FALSCH!' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MAC FALSCH!' ' MAC FALSCH!' ' MAC FALSCH!' END-IF * *----> ------------------------------ * *----> MAC IN EINGABEMESSAGE UNGÜLTIG * *----> ------------------------------ MOVE 1 TO BS1830-KZKRI MOVE 97 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE VBA3419-HIFKAT TO BS2300-HIFKAM MOVE VBA3419-HIFNR TO BS2300-HIFNRM MOVE VBA3419-DEVINF TO BS2300-FTXT1M PERFORM U84-PROT-E2-VM * *----> -------------------------- * *----> KEINE WEITERE VERARBEITUNG * *----> -------------------------- SET M-FEHLER-MAC-VER TO TRUE ELSE MOVE ISO-BA341U TO E-MSG-ISOSA IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MAC OK' END-IF END-IF CONTINUE. ./USER F0520-SYNC-S1-BA108U TEXT. * *----> ------------------------------------------- * *----> BA108U SYNCHRONISATION S1 NACHRICHTENABLAUF * *----> ------------------------------------------- ./USER F0520-SYNC-S1-BA108U PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BA108U: SYNCHRONISATION ' END-IF * *----> ------------------------------------------- * *----> SYNCHRONISATION MIT PROTOKOLLIERUNG EINGABE * *----> 'S1JJNN' * *----> I IIII * *----> I III+-AUSGABE PROTOKOLLIEREN * *----> I II+-VERARBEITUNGSSATZ PROTOKOLLIEREN * *----> I I+-EINGABE PROTOKOLLIEREN * *----> I +-SYNC-UPDATEN * *----> +-STEUERKENNZEICHEN WO STEHE ICH S1/S2 * *----> ------------------------------------------- MOVE 'S1JJNN' TO VBA1081-STKZ * *----> ---------------------- * *----> AWCD AUF GRUNDSTELLUNG * *----> WENN UNGÜLTIGER WERT * *----> ---------------------- IF BS7435-BMP039-AWCD NOT NUMERIC THEN MOVE ZERO TO BS7435-BMP039-AWCD BS2300-AWCD END-IF * *----> --------------- * *----> SYNCHRONISATION * *----> --------------- PERFORM U01-PROT-UND-SYNC * *----> --------------------------------- * *----> SYNCHRONISATIONSFEHLER * *----> SONDERFALL: * *----> HIFNR 230 = STORNO VOR ANFRAGE * *----> (230 IST ALS SYNC-OK DEFINIERT!) * *----> - BEI MASCHINELLEM STORNO: FEHLER * *----> --> ZURUECK AN CARDPROCESS * *----> - BEI MANUELLEM STORNO: OK * *----> --> WEITER IN DIE VERARBEITUNG * *----> --------------------------------- IF VBA1081-HIFNR-SYNC-NOK OR (VBA1081-HIFNR = '230 ' AND (NOT BS7435-BMP025-KONCD-MANUSTORNO)) THEN * *----> ----------------------------------------- * *----> SETZEN ANTWORTCODE * *----> DAMIT EINE DOPPELTE AUTORISIERUNGSANFRAGE * *----> NICHT DURCH CARDPROCESS ERSATZAUTORISIERT * *----> WIRD (DIES WAERE BEI AWCD = 9X DER FALL), * *----> WIRD DER AWCD = 05 GESETZT. * *----> DAMIT EIN STORNO NICHT WIEDERHOLT * *----> ANGELIEFERT WIRD, GEHT ER MIT AWCD 00 * *----> AN CP ZURÜCK. ER WIRD JEDOCH * *----> PROTOKOLLIERT, DAMIT BEI DER EVTL. * *----> SPÄTER KOMMENDEN ANFRAGE REAGIERT * *----> WERDEN KANN * *----> ----------------------------------------- MOVE 96 TO BS7435-BMP039-AWCD BS2300-AWCD IF VBA1081-HIFNR-SYNC-DOPP-TRA THEN MOVE 1 TO BS1830-KZKRI MOVE 05 TO BS7435-BMP039-AWCD BS2300-AWCD END-IF IF BS7435-NTYP = 420 OR 421 THEN MOVE ZERO TO BS7435-BMP039-AWCD BS2300-AWCD END-IF MOVE VBA1081-HIFKAT TO BS2300-HIFKAM MOVE VBA1081-HIFNR TO BS2300-HIFNRM MOVE VBA1081-HIFTEXT TO BS2300-FTXT1M * *----> -------------------- * *----> BMP55 PROTOKOLLIEREN * *----> -------------------- IF BS7435-BIT-BMP055-ON AND BS7435-NTYP = 100 THEN PERFORM U03-PROTOKOLLIERUNG-EMV END-IF * *----> ---------------- * *----> VM-SATZ AUSGEBEN * *----> ---------------- MOVE 'A1NNJN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC * *----> -------------------------- * *----> KEINE WEITERE VERARBEITUNG * *----> -------------------------- SET M-FEHLER-SYNCHRONISATION TO TRUE ELSE * *----> -------------------- * *----> BMP55 PROTOKOLLIEREN * *----> -------------------- IF BS7435-BIT-BMP055-ON AND BS7435-NTYP = 100 THEN PERFORM U03-PROTOKOLLIERUNG-EMV END-IF END-IF CONTINUE. ./USER F0525-AUSGABE TEXT. * *----> --------------------- * *----> AUSGANG ENTSPRECHEND * *----> SCHALTER VERARBEITUNG * *----> --------------------- ./USER F0525-AUSGABE PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PGM-AUSGABE' END-IF * *----> ------------------------------------------------- * *----> Ab hier handelt es sich um den Nachrichtenausgang * *----> ------------------------------------------------- SET M-WEG-AUS TO TRUE EVALUATE TRUE WHEN M-FEHLER-WEITERROUTEN * *----> -------------------------- * *----> NACHRICHT INS RICHTIGE IMS * *----> WEITERROUTEN * *----> -------------------------- PERFORM F052510-SEND-MSG-AN-IMS WHEN M-FEHLER-ANTWORTEN * *----> ---------------------- * *----> NACHRICHT ZURÜCK AN CP * *----> ---------------------- PERFORM F052505-SEND-MSG-AN-CP WHEN M-KEIN-FEHLER AND BS7435-BIT-BMP055-OFF * *----> -------------------------- * *----> NACHRICHT AN BA669T ZUR * *----> AUTORISIERUNG WEITERLEITEN * *----> -------------------------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ZUR AUTORISIERUNG AN BA669T WEITERLEITEN' END-IF MOVE 'BA669X1' TO SWITCH-TRANS MOVE VBA4379-LDBIDK TO SWITCH-TDB PERFORM F052515-SEND-MSG-AN-FOLGE-PGM WHEN M-KEIN-FEHLER AND BS7435-BIT-BMP055-ON * *----> -------------------------- * *----> NACHRICHT AN BA670T ZUR * *----> AUTORISIERUNG WEITERLEITEN * *----> -------------------------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ZUR AUTORISIERUNG AN BA670T WEITERLEITEN' END-IF MOVE 'BA670X1' TO SWITCH-TRANS MOVE VBA4379-LDBIDK TO SWITCH-TDB PERFORM F052515-SEND-MSG-AN-FOLGE-PGM END-EVALUATE CONTINUE. ./USER F052505-SEND-MSG-AN-CP TEXT. * *----> ----------------------------------- * *----> FEHLERANTWORT ZURüCK AN CARDPROCESS * *----> ----------------------------------- ./USER F052505-SEND-MSG-AN-CP PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' FEHLERANTWORT ZURüCK AN CARDPROCESS' END-IF * *----> ---------------------- * *----> NTYP AUSGABE ERMITTELN * *----> ---------------------- EVALUATE TRUE WHEN BS7435-NTYP = 100 MOVE 110 TO BS7435-NTYP WHEN BS7435-NTYP = (420 OR 421) MOVE 430 TO BS7435-NTYP * *----> ----------------------- * *----> STORNO MIT 00 ANTWORTEN * *----> ----------------------- IF BS7435-BMP039-AWCD > 00 THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' STORNO-AWCD=#' BS7435-BMP039-AWCD '#' ' MIT 00 GEPATCHT' END-IF MOVE 00 TO BS7435-BMP039-AWCD END-IF END-EVALUATE * *----> ---------------------- * *----> ABSENDER BELEGEN BMP33 * *----> ---------------------- MOVE 3 TO BS7435-BMP033-BMP33L MOVE 26 TO Z-IDNR-1-2 MOVE ZERO TO Z-IDNR-3 MOVE VBA0872-SYSID TO Z-IDNR-4-6 MOVE Z-IDNR TO BS7435-BMP033-IDNR * *----> -------------------------- * *----> BMP53 BELEGEN OHNE PIN * *----> -------------------------- MOVE 0100000002000000 TO BS7435-BMP053 * *----> -------------------------------------------- * *----> BMP55 AUSSCHALTEN * *----> FALLS HIER BEREITS EIN FEHLER ERKANNT WURDE, * *----> KANN KEINE BMP 55 FUER DIE AUSGABENACHRICHT * *----> GEBILDET WERDEN. * *----> -------------------------------------------- SET BS7435-BIT-BMP055-OFF TO TRUE * *----> --------------------------------- * *----> BMP57 ZUFALLSWERT INITIALISIEREN * *----> --------------------------------- MOVE LOW-VALUE TO BS7435-BMP057-ZFZMAC BS7435-BMP057-ZFZPAC * *----> ------------------------- * *----> BA555U GENO-ISO-UMSETZUNG * *----> ------------------------- PERFORM U82-GENO-ISO IF NOT M-FEHLER-KEINE-ANTWORT THEN MOVE ISOSA-01 TO BS7534-ISOSA * *----> ---------------------------------- * *----> UPDATE FS80 AUSGABE-TRC * *----> AUSGABE-NTYP * *----> WENN TEST : AUSGABE-SATZ ERSTELLEN * *----> ---------------------------------- MOVE IO-PCB-NAME TO BS1830-EMPFL IF VBA0872-IMSTYP-TEST THEN MOVE 'F2JNNJ' TO VBA1081-STKZ MOVE 'A1' TO BS2319-ART MOVE 668 TO BS2319-PRST MOVE BS7534-ISOSA TO BS2319-GENISO ELSE MOVE 'F2JNNN' TO VBA1081-STKZ END-IF * *----> --------------- * *----> EINTRAG IN FS80 * *----> --------------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' UPDATE KONTROLL-DB' END-IF PERFORM U01-PROT-UND-SYNC * *----> ---------------------- * *----> MAC RECHNEN MIT BA341U * *----> ---------------------- PERFORM U81-MAC-GENERIERUNG IF NOT M-FEHLER-KEINE-ANTWORT THEN PERFORM U83-SEND-MSG END-IF END-IF CONTINUE. ./USER F052510-SEND-MSG-AN-IMS TEXT. * *----> -------------------------- * *----> FALSCH GEROUTETE NACHRICHT * *----> INS RICHTIGE IMS SCHICKEN * *----> -------------------------- ./USER F052510-SEND-MSG-AN-IMS PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' NACHRICHT IN RICHTIGES IMS SCHICKEN' END-IF * *----> -------------------------- * *----> FALSCH GEROUTETE NACHRICHT * *----> INS RICHTIGE IMS SCHICKEN * *----> -------------------------- MOVE TRC-EINGABE TO SWITCH-TRANS MOVE 'IM' TO SWITCH-TXKON-RED MOVE VBA4379-IMSIDK TO SWITCH-TXIMS-RED MOVE SWITCH-TRANS-RED TO VBA3561-TRC MOVE SPACE TO VBA3561-PEST MOVE SWT-PGM-NAME TO VBA3561-PGM MOVE VBA4379-SYSIDG TO VBA3561-SYSID SET VBA3561-ANWEND-GAA-INTERNAT TO TRUE SET VBA3561-AP-PASSIV TO TRUE SET VBA3561-MSG-JA TO TRUE MOVE VBA5559-LLISOM TO MSG-LAENGE ADD 8 TO MSG-LAENGE MOVE E-MSG-ISOSA TO MSG-DATEN * *----> ------------- * *----> AUFRUF BA356U * *----> ------------- PERFORM V20-BA356U * *----> ---------------------------------------- * *----> FEHLER/HINWEISFELDER PROTOKOLLSATZ: * *----> NUMMER UND KATEGORIE SIND INDIVIDUELL, * *----> VORGANG UND PROGRAMM NICHT, DIESE WERDEN * *----> ALSO ALLGEMEIN GEFUELLT. * *----> ---------------------------------------- IF VBA3569-M-RC-FEHLER THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' VBA3569-FTEXT CALL FU008U USING K-ABEND INFO-TEXT END-CALL END-IF CONTINUE. ./USER F052515-SEND-MSG-AN-FOLGE-PGM TEXT. * *----> -------------------------------- * *----> WEITERLEITEN AN AN FOLGEPROGRAMM * *----> ZUR AUTORISIERUNG * *----> -------------------------------- ./USER F052515-SEND-MSG-AN-FOLGE-PGM PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' WEITERLEITEN MSG AN FOLGEPROGRAMME' ' ZUR AUTORISIERUNG' END-IF MOVE SWITCH-TRANS TO VBA3561-TRC MOVE SPACE TO VBA3561-PEST MOVE SWT-PGM-NAME TO VBA3561-PGM MOVE VBA4379-SYSIDG TO VBA3561-SYSID MOVE VBA4379-LDBIDG TO VBA3561-LDBID SET VBA3561-ANWEND-ECC-NATIONAL TO TRUE SET VBA3561-AP-PASSIV TO TRUE SET VBA3561-MSG-JA TO TRUE MOVE BS7435 TO SEND-BS7435 MOVE BS4353 TO SEND-BS4353 MOVE LENGTH OF GENO-DATEN TO MSG-LAENGE MOVE GENO-DATEN TO MSG-DATEN * *----> -------------------------------- * *----> WEITERLEITEN AN AN FOLGEPROGRAMM * *----> ZUR AUTORISIERUNG * *----> -------------------------------- PERFORM V20-BA356U * *----> ---------------------------------------- * *----> FEHLER/HINWEISFELDER PROTOKOLLSATZ: * *----> NUMMER UND KATEGORIE SIND INDIVIDUELL, * *----> VORGANG UND PROGRAMM NICHT, * *----> ---------------------------------------- IF VBA3569-M-RC-FEHLER THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' VBA3569-FTEXT CALL FU008U USING K-ABEND INFO-TEXT END-CALL END-IF CONTINUE. ./USER F0590-UEBERWACHUNG TEXT. * *----> ---------------------------------------- * *----> EVENT-DATEN FÜR SB-ÜBERWACHUNG SCHREIBEN * *----> ---------------------------------------- ./USER F0590-UEBERWACHUNG PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' EVENT-DATEN FÜR SB-ÜBERWACHUNG SCHREIBEN' END-IF * *----> ------------------------------------- * *----> UEBERGABEBEREICH VON BA781U VERSORGEN * *----> ------------------------------------- MOVE L-VBA7811 TO VBA7811 MOVE SWT-PGM-NAME TO VBA7811-PGM SET VBA7811-FUNKT-LOG TO TRUE SET VBA7811-SYSKOMP-IS TO TRUE SET VBA7811-SENDEMPF-AQ TO TRUE SET VBA7811-UMGEB-ECC TO TRUE IF VBA0872-IMSTYP-TEST THEN SET VBA7811-TRACE-ON TO TRUE ELSE SET VBA7811-TRACE-OFF TO TRUE END-IF SET VBA7811-APPL-ECC-NAT TO TRUE MOVE VBA4379-TRART TO VBA7811-TRART MOVE BS7435-NTYP TO VBA7811-NTYP MOVE BS7435-BMP003-ABWKZ TO VBA7811-ABWKZ MOVE Z-TRDAT TO VBA7811-TRDAT MOVE BS7435-BMP012-TRUHR TO VBA7811-TRUHR MOVE BS7435-BMP011-TRNR TO VBA7811-TRNR MOVE BS7435-BMP039-AWCD TO VBA7811-AWCD MOVE BS2300-HIFVAM TO VBA7811-HIFVA MOVE BS2300-HIFPIM TO VBA7811-HIFPID MOVE BS2300-HIFKAM TO VBA7811-HIFKAT MOVE BS2300-HIFNRM TO VBA7811-HIFNR MOVE BS2300-FTXT1M TO VBA7811-HIFTXT MOVE S-WEG TO VBA7811-WEG MOVE VBA0872-PLEX TO VBA7811-PLEX MOVE VBA0872-IMSIDG TO VBA7811-IMSIDG MOVE VBA0872-LDBID TO VBA7811-LDBID MOVE VBA0872-SYSID TO VBA7811-SYSID MOVE VBA4379-RZBKK TO VBA7811-RZBKKA MOVE VBA4379-BLZKA TO VBA7811-BLZKA MOVE BS7435-BMP002-PAN TO VBA7811-PAN MOVE BS7435-BMP002-PANKTONR TO VBA7811-KTOKA MOVE BS7435-BMP023-FOLG TO VBA7811-FOLGE MOVE BS7435-BMP014-VERFDT TO VBA7811-VERF MOVE BS1830-GAANRI TO VBA7811-GAANRI-OR MOVE BS1830-BNKIDI TO VBA7811-BNKIDI-OR PERFORM I40-BA781U CONTINUE. ./USER U01-PROT-UND-SYNC TEXT. * *----> ----------------------------------- * *----> PROTOKOLLIEREN ODER SYNCHRONISIEREN * *----> MIT BA108U * *----> ----------------------------------- ./USER U01-PROT-UND-SYNC PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PROTOKOLLIEREN/SYNCHRONISIEREN MIT BA108U' END-IF IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' AUFRUF-BA108U MIT: VBA1081-STKZ =#' VBA1081-STKZ '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-ART =#' BS2300-ART '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-HIFKAT=#' BS2300-HIFKAM '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-HIFNR =#' BS2300-HIFNRM '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2319-ART =#' BS2319-ART '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2328-ART =#' BS2328-ART '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-FTXT1M=#' BS2300-FTXT1M '#' END-IF SET VBA1081-HERK-ECC-EMV-S2 TO TRUE MOVE 668 TO VBA1081-PRST MOVE ZERO TO VBA1081-AWC * *----> ------------------------------ * *----> STKZ UMSCHIESSEN VON A1 AUF F1 * *----> ------------------------------ IF VBA1081-STKZ(1:2) = 'A1' AND M-FEHLER THEN MOVE 'F1' TO VBA1081-STKZ(1:2) END-IF * *----> ------------- * *----> AUFRUF BA108U * *----> ------------- PERFORM I10-BA108U IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' AUFRUF BA108U MIT ' VBA1081-STKZ ' HIF=#' VBA1081-HIFNR ' ' VBA1081-HIFTEXT '#' END-IF * *----> --------------------------------------------- * *----> PROGRAMM-ABBRUCH WENN * *----> UNGÜLTIGE HIFNR AUS BA108U * *----> BEI ALLEN AKTIONEN, DIE NICHT SYNCHRONISATION * *----> SIND * *----> --------------------------------------------- IF VBA1081-HIFNR-SYNC-NOK AND VBA1081-STKZ(1:2) NOT = 'S1' THEN MOVE VBA1081-HIFKAT TO FEHLER-1-HIFKAT MOVE VBA1081-HIFNR TO FEHLER-1-HIFNR MOVE FEHLER-1 TO INFO-TABELLE IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ABBRUCH WEGEN ' FEHLER-1 END-IF CALL FU008U USING K-ABEND INFO-TEXT END-CALL END-IF CONTINUE. ./USER U03-PROTOKOLLIERUNG-EMV TEXT. * *----> --------------------------------- * *----> EC-SATZ SPEICHERN MIT BMP55 DATEN * *----> --------------------------------- ./USER U03-PROTOKOLLIERUNG-EMV PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ZUSäTZLICHE FEHLERPROTOKOLLIERUNG FüR EMV' END-IF * *----> -------------------- * *----> BMP55 PROTOKOLLIEREN * *----> -------------------- MOVE 'EC' TO BS4400E-ART MOVE 'BS4353' TO BS4400E-COPY MOVE LENGTH OF BS4353-BMP55E TO BS4400E-VARLNG MOVE BS4353-BMP55E TO BS4400E-VAR MOVE 'A1NJNN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC CONTINUE. ./USER U07-FTXT102-BEREITSTELLEN TEXT. * *----> ---------------------------------------- * *----> FEHLERTEXT FÜR DIE AUSGABE BEREITSTELLEN * *----> ---------------------------------------- ./USER U07-FTXT102-BEREITSTELLEN PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' FEHLERTEXT FÜR DIE AUSGABE BEREITSTELLEN' END-IF * *----> --------------------- * *----> TAG-NR ALS FEHLERCODE * *----> --------------------- MOVE Z-TAGNR TO BS2300-HIFNRM MOVE BS4353-TAGLEN (BMP55-IND) TO VFU068U-LL MOVE BS4353-TAGINH (BMP55-IND) TO VFU068U-ITEXT PERFORM U49-HEXSTRING MOVE VFU068U-OTEXT TO FTXT102-WERT MOVE FTXT102 TO BS2300-FTXT1M CONTINUE. ./USER U08-FTXT103-BEREITSTELLEN TEXT. * *----> ---------------------------------------- * *----> FEHLERTEXT FÜR DIE AUSGABE BEREITSTELLEN * *----> ---------------------------------------- ./USER U08-FTXT103-BEREITSTELLEN PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' FEHLERTEXT FÜR DIE AUSGABE BEREITSTELLEN' END-IF MOVE 1 TO VFU068U-LL MOVE Z-CHAR TO VFU068U-ITEXT PERFORM U49-HEXSTRING MOVE VFU068U-OTEXT TO FTXT103-WERT2 MOVE FTXT103 TO BS2300-FTXT1M CONTINUE. ./USER U10-BMP35-SPUR2 TEXT. * *----> ------------------------------------ * *----> BMP35-PRÜFUNG SPUR-2-DATEN AUS BMP35 * *----> ------------------------------------ ./USER U10-BMP35-SPUR2 PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP35 LÄNGE SPUR2-DATEN' END-IF IF BS2300-HIFNRM = SPACE THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP35 SP2PAN' END-IF * *----> --------------------------------------- * *----> NUR STELLE 1-19 DER PAN VERGLEICHEN, DA * *----> - TRENNZEICHEN IN BMP 2 = 'F' * *----> - TRENNZEICHEN IN BMP 35 = 'D' * *----> --------------------------------------- IF BS7435-BMP035-SP2PAN(1:19) NOT = BS7435-BMP002-PAN(1:19) THEN MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '035D' TO BS2300-HIFNRM * *----> ---------------------- * *----> TEXT SP2PAN UNGÜLTIG * *----> ---------------------- MOVE FTXT27 TO BS2300-FTXT1M END-IF END-IF IF BS2300-HIFNRM = SPACE THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP35 SP2VER' END-IF MOVE BS7435-BMP014-VERFDT TO Z-VFDAT IF BS7435-BMP035-SP2VFD NOT = Z-VFDAT THEN MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '035F' TO BS2300-HIFNRM * *----> ---------------------- * *----> VERFALLDATUM UNGUELTIG * *----> ---------------------- MOVE FTXT27 TO BS2300-FTXT1M END-IF END-IF IF BS2300-HIFNRM = SPACE THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP35 SP2FNR' END-IF MOVE BS7435-BMP023-FOLG TO Z-KARNR IF BS7435-BMP035-SP2FNR NOT = Z-KARNR THEN MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '035G' TO BS2300-HIFNRM * *----> ------------------------------- * *----> TEXT KARTENFOLGE-NR. UNGÜLTIG * *----> ------------------------------- MOVE FTXT27 TO BS2300-FTXT1M END-IF END-IF CONTINUE. ./USER U15-BMP53-SII TEXT. * *----> ---------------------------------------- * *----> PRÜFUNG SICHERHEITSINFORMATION AUS BMP53 * *----> UND PIN-DATEN AUS BMP52 * *----> ---------------------------------------- ./USER U15-BMP53-SII PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP53 SICHERHEITSINFORMATION' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ZUSAMMEN MIT BMP52 PIN-DATEN' END-IF * *----> --------------------------------- * *----> PRÜFUNG BMP53 AUF GÜLTIGEN INHALT * *----> --------------------------------- EVALUATE TRUE * *----> ----------------------------------- * *----> SPUR-2-MAGNETSTREIFEN-TRANSAKTIONEN * *----> (ALSO TX OHNE BMP 55) * *----> MUESSEN EINEN PAC HABEN * *----> ----------------------------------- WHEN BS7435-NTYP-ANFRAGE AND BS7435-BIT-BMP052-ON AND BS7435-BMP053-MIT-PIN AND BS7435-BIT-BMP055-OFF CONTINUE * *----> ---------------------- * *----> EMV-TRANSAKTIONEN * *----> MIT ONLINE-PIN-PRüFUNG * *----> ---------------------- WHEN BS7435-NTYP-ANFRAGE AND BS7435-BIT-BMP052-ON AND BS7435-BMP053-MIT-PIN AND BS7435-BIT-BMP055-ON CONTINUE * *----> ----------------------- * *----> EMV-TRANSAKTIONEN * *----> MIT OFFLINE-PIN-PRüFUNG * *----> ----------------------- WHEN BS7435-NTYP-ANFRAGE AND BS7435-BIT-BMP052-OFF AND BS7435-BMP053-OHNE-PIN AND BS7435-BIT-BMP055-ON CONTINUE * *----> ------------------------- * *----> STORNOS GENERELL OHNE PAC * *----> ------------------------- WHEN BS7435-NTYP-STORNO-ANFR AND BS7435-BIT-BMP052-OFF AND BS7435-BMP053-OHNE-PIN WHEN BS7435-NTYP-STORNO-WDH AND BS7435-BIT-BMP052-OFF AND BS7435-BMP053-OHNE-PIN CONTINUE WHEN OTHER MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '053A' TO BS2300-HIFNRM * *----> ------------------------------- * *----> TEXT SICHERHEITSINFO UNGÜLTIG * *----> ------------------------------- MOVE BS7435-BMP053 TO FTXT58-WERT MOVE FTXT58 TO BS2300-FTXT1M IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP53 UNGÜLTIGER INHALT' END-IF * *----> ----------------------- * *----> PAC HEXA IN DRUCKFORMAT * *----> MIT FU068U AUFBEREITEN * *----> ----------------------- MOVE 8 TO VFU068U-LL MOVE BS7435-BMP052-PAC TO VFU068U-ITEXT PERFORM U49-HEXSTRING MOVE VFU068U-OTEXT TO FTXT57-WERT MOVE BS7435-BMP053 TO FTXT58-WERT * *----> --------------------------------------- * *----> BS2300-FTXT1M MIT BMP52 UND BMP53 FÜLLEN * *----> --------------------------------------- STRING '52=' FTXT57-WERT ' 53=' FTXT58-WERT DELIMITED BY SIZE INTO BS2300-FTXT1M END-STRING END-EVALUATE CONTINUE. ./USER U20-BMP95-ERSBET TEXT. * *----> ------------------------------------------------- * *----> PRÜFUNG ERSATZBETRÄGE BEI (TEIL-)STORNO AUS BMP95 * *----> ------------------------------------------------- ./USER U20-BMP95-ERSBET PROC. IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BMP95 ERSATZBETRÄGE BEI (TEIL-)STORNO' END-IF MOVE BS7435-BMP095-TEILBT TO Z-TEILBT MOVE Z-TEILBT-X TO FTXT60-WERT1 MOVE BS7435-BMP004-BETRAG TO Z-TEILBT MOVE Z-TEILBT-X TO FTXT60-WERT2 * *----> ------------------------------------ * *----> ERSATZBETRAG GRöSSER URSPRUNGSBETRAG * *----> ------------------------------------ IF BS7435-BMP095-TEILBT > BS7435-BMP004-BETRAG THEN MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '095P' TO BS2300-HIFNRM * *----> --------------------------- * *----> TEXT ERSATZBETRAG UNGÜLTIG * *----> --------------------------- MOVE FTXT60 TO BS2300-FTXT1M END-IF CONTINUE. ./USER U50-BITSTRING TEXT. * *----> ------------------------ * *----> ZEICHEN IN BITS AUFLÖSEN * *----> ------------------------ ./USER U50-BITSTRING PROC. * *----> -------------------------- * *----> ZEICHEN IN HEXA-HORIZONTAL * *----> -------------------------- MOVE 1 TO VFU068U-LL MOVE Z-CHAR TO VFU068U-ITEXT PERFORM U49-HEXSTRING IF RETURN-CODE NOT = ZERO THEN MOVE RETURN-CODE TO FEHLER-2-CODE MOVE FEHLER-2 TO INFO-TABELLE IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ABBRUCH WEGEN ' FEHLER-2 END-IF CALL FU008U USING K-ABEND INFO-TEXT END-CALL END-IF MOVE VFU068U-OTEXT TO Z-CHAR-HEX PERFORM WITH TEST BEFORE VARYING CHAR-IND FROM +1 BY +1 UNTIL CHAR-IND > 2 COMPUTE BITS-IND = CHAR-IND * 4 - 3 EVALUATE Z-CHAR-HEX (CHAR-IND:1) WHEN '0' MOVE '0000' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '1' MOVE '0001' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '2' MOVE '0010' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '3' MOVE '0011' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '4' MOVE '0100' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '5' MOVE '0101' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '6' MOVE '0110' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '7' MOVE '0111' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '8' MOVE '1000' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN '9' MOVE '1001' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN 'A' MOVE '1010' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN 'B' MOVE '1011' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN 'C' MOVE '1100' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN 'D' MOVE '1101' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN 'E' MOVE '1110' TO Z-CHAR-BITSTRING (BITS-IND:) WHEN 'F' MOVE '1111' TO Z-CHAR-BITSTRING (BITS-IND:) END-EVALUATE END-PERFORM CONTINUE. ./USER U52-PLAUSI-TAG-9F27 TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U52-PLAUSI-TAG-9F27 PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PLAUSI TAG 9F27' END-IF MOVE BS4353-KTKRPT TO Z-CHAR PERFORM U50-BITSTRING IF Z-CHAR-BITSTRING-BIT-1-IST-1 AND Z-CHAR-BITSTRING-BIT-2-IST-0 AND Z-CHAR-BITSTRING-BIT-3-IST-0 AND Z-CHAR-BITSTRING-BIT-4-IST-0 AND Z-CHAR-BITSTRING-BIT-5-IST-0 AND Z-CHAR-BITSTRING-BIT-6-IST-0 AND Z-CHAR-BITSTRING-BIT-7-IST-0 AND Z-CHAR-BITSTRING-BIT-8-IST-0 THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD PERFORM U07-FTXT102-BEREITSTELLEN STRING 'BMP55 ' 'BS4353-KTKRPT NOK ' '=#' BS4353-KTKRPT '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F27' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-IF CONTINUE. ./USER U53-PLAUSI-TAG-9F10 TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U53-PLAUSI-TAG-9F10 PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PLAUSI TAG 9F10' END-IF IF BS4353-KVERSA-SECCOS-5 OR BS4353-KVERSA-SECCOS-6 THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '9F10' TO BS2300-HIFNRM MOVE '2' TO FTXT103-WERT1 MOVE BS4353-KVERSA TO Z-CHAR PERFORM U08-FTXT103-BEREITSTELLEN STRING 'BMP55 ' 'BS4353-KVERSA NICHT SECCOS 5/6 ' '=#' BS4353-KVERSA '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F10' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-IF * *----> -------- * *----> SECCOS 5 * *----> -------- IF BS4353-KVERSA-SECCOS-5 THEN IF BS2300-HIFNRM = SPACE THEN MOVE BS4353-KCVR1 TO Z-CHAR PERFORM U50-BITSTRING IF Z-CHAR-BITSTRING-BIT-1-IST-0 THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '9F10' TO BS2300-HIFNRM MOVE '3.1' TO FTXT103-WERT1 PERFORM U08-FTXT103-BEREITSTELLEN STRING 'BMP55 ' 'SECCOS 5 BS4353-KCVR1 NOK ' '=#' BS4353-KCVR1 '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F10' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-IF END-IF IF BS2300-HIFNRM = SPACE THEN EVALUATE TRUE * *----> -------- * *----> CVR 3. BYTE: * *----> LINKES HALBBYTE = F * *----> KARTENINHABER-AUTHENTIKATION MITTELS * *----> OFFLINE-PIN DURCH DIE ANWENDUNG NICHT * *----> UNTERSTüTZT * *----> RECHTES HALBBYTE = 1,3,5,7 * *----> OFFLINE-PIN-PRüFUNG NICHT DURCHGEFüHRT, * *----> GGF. FBZ DER OFFLINE-PIN DEKREMENTIERT * *----> BZW. FBZ DER OFFLINE-PIN IST 0. * *----> -------- WHEN BS4353-KCFBZ = 'F' SET M-PIN-PRUEFUNG-ONLINE TO TRUE WHEN (BS4353-KCPFL = '1' OR = '3' OR = '5' OR = '7') SET M-PIN-PRUEFUNG-ONLINE TO TRUE WHEN BS4353-KCPFL = '8' SET M-PIN-PRUEFUNG-OFFLINE TO TRUE WHEN OTHER SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '9F10' TO BS2300-HIFNRM MOVE '3.3' TO FTXT103-WERT1 STRING BS4353-KCFBZ '/' BS4353-KCPFL DELIMITED BY SIZE INTO FTXT103-WERT2 END-STRING MOVE FTXT103 TO BS2300-FTXT1M STRING 'BMP55 ' 'SECCOS 5 PIN-PRF NOK ' 'KOMBINATION' ' ABWKZ=#' BS7434-BMP003-ABWKZ '#' ' BS4353-KCFBZ=#' BS4353-KCFBZ '#' ' BS4353-KCPFL=#' BS4353-KCPFL '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F10' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-EVALUATE END-IF IF BS2300-HIFNRM = SPACE THEN EVALUATE TRUE WHEN M-PIN-PRUEFUNG-ONLINE AND BS7435-BIT-BMP052-ON AND BS7435-BMP053-MIT-PIN CONTINUE WHEN M-PIN-PRUEFUNG-OFFLINE AND BS4353-KCFBZ = '3' CONTINUE WHEN OTHER SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '9F10' TO BS2300-HIFNRM MOVE '3.3' TO FTXT103-WERT1 STRING BS4353-KCFBZ '/' BS4353-KCPFL DELIMITED BY SIZE INTO FTXT103-WERT2 END-STRING MOVE FTXT103 TO BS2300-FTXT1M STRING 'BMP55 ' 'SECCOS 5 PIN-PRüFUNG NOK ' 'NOT ONL-OK & NOT OFFL-OK' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F10' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-EVALUATE END-IF ELSE * *----> -------- * *----> SECCOS 6 * *----> -------- IF BS2300-HIFNRM = SPACE THEN MOVE BS4353-S6KCVR1 TO Z-CHAR PERFORM U50-BITSTRING * *----> --------------------------------- * *----> LINKES HALBBYTE DES CVR1 MUSS * *----> DEN WERT 'A' HABEN, DAMIT ES SICH * *----> UM EINEN ARQC HANDELT, DAS DURCH * *----> DAS ERSTE GENERATE AC VON DER * *----> KARTE ERZEUGT WURDE * *----> --------------------------------- IF Z-CHAR-BITSTRING-BIT-1-IST-1 AND Z-CHAR-BITSTRING-BIT-2-IST-0 AND Z-CHAR-BITSTRING-BIT-3-IST-1 AND Z-CHAR-BITSTRING-BIT-4-IST-0 THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '9F10' TO BS2300-HIFNRM MOVE '3.1' TO FTXT103-WERT1 PERFORM U08-FTXT103-BEREITSTELLEN STRING 'BMP55 ' 'SECCOS 6 CVR1 NOK' '=#' BS4353-S6KCVR1 '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F10' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-IF END-IF IF BS2300-HIFNRM = SPACE THEN * *----> ------------------------------------- * *----> BEI OFFLINE-PIN-PRUEFUNG * *----> MUSS CVR2 LINKES HALBBYTE DIE * *----> WERTE BIT 1 = 1, BIT 2/3 = 0 * *----> HABEN, DIES ENTSPRICHT IM FELD * *----> S6KCPFL DEN WERTEN 8 BZW. 9. * *----> ------------------------------------- IF (BS4353-S6KCPFL = '8' OR = '9') SET M-PIN-PRUEFUNG-OFFLINE TO TRUE ELSE SET M-PIN-PRUEFUNG-ONLINE TO TRUE END-IF END-IF IF BS2300-HIFNRM = SPACE THEN EVALUATE TRUE WHEN M-PIN-PRUEFUNG-ONLINE AND BS7435-BIT-BMP052-ON AND BS7435-BMP053-MIT-PIN CONTINUE WHEN M-PIN-PRUEFUNG-OFFLINE AND BS4353-S6KCFBZ = '3' CONTINUE WHEN OTHER SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '9F10' TO BS2300-HIFNRM MOVE '3.2' TO FTXT103-WERT1 STRING BS4353-S6KCFBZ '/' BS4353-S6KCPFL DELIMITED BY SIZE INTO FTXT103-WERT2 END-STRING MOVE FTXT103 TO BS2300-FTXT1M STRING 'BMP55 ' 'SECCOS 6 PIN-PRüFUNG NOK ' 'NOT ONL-OK & NOT OFFL-OK' ' S6KCFBZ=#' BS4353-S6KCFBZ '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '9F10' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-EVALUATE END-IF END-IF CONTINUE. ./USER U56-PLAUSI-TAG-0095 TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U56-PLAUSI-TAG-0095 PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' PLAUSI TAG 95' END-IF MOVE BS4353-TTVR (3:1) TO Z-CHAR PERFORM U50-BITSTRING IF M-PIN-PRUEFUNG-OFFLINE THEN IF Z-CHAR-BITSTRING-BIT-1-IST-0 AND Z-CHAR-BITSTRING-BIT-2-IST-0 AND Z-CHAR-BITSTRING-BIT-3-IST-0 AND Z-CHAR-BITSTRING-BIT-4-IST-0 AND Z-CHAR-BITSTRING-BIT-5-IST-0 AND Z-CHAR-BITSTRING-BIT-6-IST-0 THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD MOVE '0095' TO BS2300-HIFNRM MOVE '3' TO FTXT103-WERT1 PERFORM U08-FTXT103-BEREITSTELLEN STRING 'BMP55 ' 'TAG 95 NOK' '=#' BS4353-TTVR '#' ' TTVR(3:1)=#' Z-CHAR '#' DELIMITED BY SIZE INTO Z-HIFTXT MOVE 'PIT' TO Z-HIFKAT MOVE '0095' TO Z-HIFNR PERFORM U90-VM-SATZ-SCHREIBEN END-IF END-IF CONTINUE. ./USER U57-PLAUSI-TAG-009A TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U57-PLAUSI-TAG-009A PROC. * *----> ---------------------- * *----> JJ AUS DATUM ENTFERNEN * *----> ---------------------- MOVE BS4353-TDATUM TO Z-DATUM IF Z-DATUM-MMTT = BS7435-BMP013-TRDAT THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD PERFORM U07-FTXT102-BEREITSTELLEN END-IF CONTINUE. ./USER U58-PLAUSI-TAG-009C TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U58-PLAUSI-TAG-009C PROC. IF BS4353-TSATYP = BS7435-BMP003-ABWKZ-1-2 THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD PERFORM U07-FTXT102-BEREITSTELLEN END-IF CONTINUE. ./USER U59-PLAUSI-TAG-9F02 TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U59-PLAUSI-TAG-9F02 PROC. MOVE BS7435-BMP004-BETRAG TO Z-BETRAG IF BS4353-TBETR = Z-BETRAG-ONK THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD PERFORM U07-FTXT102-BEREITSTELLEN END-IF CONTINUE. ./USER U60-PLAUSI-TAG-5F2A TEXT. * *----> ---------------------- * *----> PLAUSIBILITÄTS-PRÜFUNG * *----> ---------------------- ./USER U60-PLAUSI-TAG-5F2A PROC. IF BS4353-AWAEHR > ZERO AND BS4353-AWAEHR = BS7435-BMP049-WAEACQ THEN CONTINUE ELSE SET M-FEHLER-PLAUSI-BMP55 TO TRUE MOVE 30 TO BS7435-BMP039-AWCD BS2300-AWCD PERFORM U07-FTXT102-BEREITSTELLEN END-IF CONTINUE. ./USER U81-MAC-GENERIERUNG TEXT. * *----> ---------------------- * *----> MAC RECHNEN MIT BA341U * *----> ---------------------- ./USER U81-MAC-GENERIERUNG PROC. * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BA341U MAC-GEN' END-IF * *----> ------------------------------------ * *----> VERBINDUNGSBEREICH VBA3411 VERSORGEN * *----> ------------------------------------ MOVE L-VBA3411 TO VBA3411 MOVE SWT-PGM-NAME TO VBA3411-PNAME SET VBA3411-FUNKT-MACGEN TO TRUE SET VBA3411-ANWEND-ECC-NATIONAL TO TRUE SET VBA3411-KOMPAR-AS-BETR TO TRUE SET VBA3411-SYNBEZ-KARTE TO TRUE * MOVE NIX TO VBA3411-KARBLZ MOVE BS7435-BMP002-PANKTONR TO VBA3411-KARKTO MOVE BS7435-BMP023-FOLG TO VBA3411-FOLGE MOVE BS7435-BMP014-VERFDT TO VBA3411-VERF MOVE BS7435-BMP011-TRNR TO VBA3411-TRNR MOVE Z-TRDAT TO VBA3411-TRDAT MOVE BS7435-BMP012-TRUHR TO VBA3411-TRUHR MOVE VBA0872-IMSTYP TO VBA3411-IMSTYP MOVE VBA0872-FIRMA TO VBA3411-FIRMA MOVE VBA0872-IMSIDG TO VBA3411-IMSIDG MOVE VBA0872-SYSID TO VBA3411-SYSID MOVE VBA5559-OFSEKY TO VBA3411-OFSKEY MOVE VBA5559-LLISOM TO VBA3411-DATSL IF VBA0872-IMSTYP-TEST THEN MOVE K-IDNR-CP-TEST TO VBA3411-IDNR ELSE MOVE K-IDNR-CP-PROD TO VBA3411-IDNR END-IF SET VBA3411-GENVER-VORGEGEBEN TO TRUE MOVE BS7534-ISOSA TO ISO-BA341U * *----> ----------- * *----> CALL BA341U * *----> ----------- PERFORM I15-BA341U * *----> ------------------ * *----> ERGEBNIS AUSWERTEN * *----> ------------------ IF NOT VBA3419-HIFNR-OK THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MAC GENERATE FEHLERHAFT HIFNR =#' VBA3419-HIFNR '#' END-IF * *----> -------------------------- * *----> FEHLER BEI MAC-GENERIERUNG * *----> -------------------------- MOVE 1 TO BS1830-KZKRI MOVE '00' TO BS2300-AWCD MOVE VBA3419-HIFKAT TO BS2300-HIFKAM MOVE VBA3419-HIFNR TO BS2300-HIFNRM MOVE VBA3419-DEVINF TO BS2300-FTXT1M MOVE 'A1NNJN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC * *----> -------------------------- * *----> KEINE WEITERE VERARBEITUNG * *----> -------------------------- SET M-FEHLER-MAC-GEN TO TRUE ELSE MOVE ISO-BA341U TO BS7534-ISOSA END-IF CONTINUE. ./USER U82-GENO-ISO TEXT. * *----> ------------------------- * *----> BA555U GENO-ISO-UMSETZUNG * *----> ------------------------- ./USER U82-GENO-ISO PROC. * *----> ------------------------------------ * *----> UMSETZEN GENO-FORMAT NACH ISO-FORMAT * *----> MIT BA555U * *----> ------------------------------------ IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BA555U GENO-ISO-UMSETZUNG' END-IF * *----> ---------------------------------------- * *----> BA555U ISO-GENO UMSETZUNG EINGABEMESSAGE * *----> ---------------------------------------- MOVE L-VBA5551 TO VBA5551 MOVE SWT-PGM-NAME TO VBA5551-PGM SET VBA5551-PEST-A TO TRUE SET VBA5551-FKT-GENO-ISO TO TRUE SET VBA5551-KOMPAR-AS-AS TO TRUE * *----> ----------------------- * *----> POINTERLEISTE VERSORGEN * *----> ----------------------- MOVE 'VFU1431' TO VBA5551-PTAB-BEZ(1) SET VBA5551-PTAB-PTR(1) TO ADDRESS OF VFU1431 MOVE 'VBA0872' TO VBA5551-PTAB-BEZ(2) SET VBA5551-PTAB-PTR(2) TO ADDRESS OF VBA0872 MOVE 'ISODATEN' TO VBA5551-PTAB-BEZ(3) MOVE E-MSG-ISOSA TO ISOSA-01 SET VBA5551-PTAB-PTR(3) TO ADDRESS OF ISOSA-01 MOVE 'BS7435' TO VBA5551-PTAB-BEZ(4) SET VBA5551-PTAB-PTR(4) TO ADDRESS OF BS7435 MOVE 'BS4353' TO VBA5551-PTAB-BEZ(5) SET VBA5551-PTAB-PTR(5) TO ADDRESS OF BS4353 MOVE 'ISOBMP55' TO VBA5551-PTAB-BEZ(7) SET VBA5551-PTAB-PTR(7) TO ADDRESS OF ISOBMP55 * *----> ---------------------- * *----> AUFRUF BA555U GENO-ISO * *----> ---------------------- PERFORM I20-BA555U * *----> ----------------- * *----> ERGEBNIS GENO-ISO * *----> ----------------- IF NOT VBA5559-RC-OK THEN * *----> ----------------------------- * *----> FEHLER BEI GENO-ISO-UMSETZUNG * *----> ----------------------------- SET M-FEHLER-GENO-ISO TO TRUE MOVE 1 TO BS1830-KZKRI MOVE PID TO BS2300-HIFPIM MOVE VBA5559-HIFKAT TO BS2300-HIFKAM MOVE VBA5559-HIFNR TO BS2300-HIFNRM MOVE VBA5559-HIFTXT TO BS2300-FTXT1M MOVE 'A1NNJN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC END-IF CONTINUE. ./USER U83-SEND-MSG TEXT. * *----> ------------------- * *----> NACHRICHT VERSENDEN * *----> ------------------- ./USER U83-SEND-MSG PROC. MOVE 'STO' TO VBA3561-TRC MOVE SPACE TO VBA3561-PEST MOVE SWT-PGM-NAME TO VBA3561-PGM MOVE VBA4379-SYSIDG TO VBA3561-SYSID MOVE VBA4379-LDBIDG TO VBA3561-LDBID SET VBA3561-ANWEND-GAA-INTERNAT TO TRUE SET VBA3561-AP-PASSIV TO TRUE SET VBA3561-MSG-JA TO TRUE MOVE IO-PCB-NAME TO VBA3561-LTERM MOVE VBA5559-LLISOM TO MSG-LAENGE * *----> ------------------------------ * *----> DIE LÄNGE UM MAC-LÄNGE ERHÖHEN * *----> ------------------------------ ADD 8 TO MSG-LAENGE MOVE BS7534-ISOSA TO MSG-DATEN * *----> ------------------------- * *----> BA356U NACHRICHT AUSGEBEN * *----> ------------------------- PERFORM V20-BA356U IF VBA3569-M-RC-FEHLER THEN * *----> ----------------------------- * *----> ABBRUCH BEI SENDE-FEHLER????? * *----> ----------------------------- DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ' VBA3569-FTEXT CALL FU008U USING K-ABEND INFO-TEXT END-IF * *----> ----------- * *----> TESTTRACING * *----> ----------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(001:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(041:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(081:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(121:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(161:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(201:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(241:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(281:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(321:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(361:40) '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' MSG-OUT(..) =#' BS7534-ISOSA(401:40) '#' END-IF CONTINUE. ./USER U84-PROT-E2-VM TEXT. * *----> ----------------------------------- * *----> PROTOKOLLIERUNG VON E2- UND VM-SATZ * *----> ----------------------------------- ./USER U84-PROT-E2-VM PROC. * *----> --------------------------------- * *----> PROTOKOLLIERUNG VON E2-SATZ * *----> STEUERKENNZEICHEN MIT SYNC-UPDATE * *----> --------------------------------- MOVE 'F1JJNN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC * *----> ----------------------------------------- * *----> BMP55 PROTOKOLLIEREN BEI CHIP-NACHRICHTEN * *----> ----------------------------------------- IF BS7435-BIT-BMP055-ON AND BS7435-NTYP = 100 THEN PERFORM U03-PROTOKOLLIERUNG-EMV END-IF * *----> ------------------------ * *----> BA108U VM-SATZ SPEICHERN * *----> ------------------------ MOVE 'A1NNJN' TO VBA1081-STKZ PERFORM U01-PROT-UND-SYNC CONTINUE. ./USER U90-VM-SATZ-SCHREIBEN TEXT. * *----> ---------------------------------------------- * *----> PROTOKOLLIERUNG FEHLERSäTZE IN DIE KONTROLL-DB * *----> MIT BA108U, SATZART VM * *----> ---------------------------------------------- ./USER U90-VM-SATZ-SCHREIBEN PROC. * *----> ------------ * *----> TEST-TRACING * *----> ------------ IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' KONTROLL-DB SCHREIBEN MIT' ' SATZART: VM ' END-IF * *----> ----------------------------------------- * *----> BELEGEN VBA1081 AUFRUF PROTOKOLLIERUNG VM * *----> ----------------------------------------- * MOVE 'A1NNJN' TO VBA1081-STKZ MOVE 'F1JNJN' TO VBA1081-STKZ MOVE BS7435-NTYP TO VBA1081-NTE SET VBA1081-HERK-ECC-EMV-S2 TO TRUE MOVE '668' TO VBA1081-PRST MOVE BS7435-BMP003-ABWKZ TO VBA1081-ABWKZ MOVE ZERO TO VBA1081-AWC * *----> --------------------------------- * *----> BELEGEN VM, FEHLERPROTOKOLLIERUNG * *----> --------------------------------- MOVE 'VM' TO BS2300-ART MOVE BS7435-BMP039-AWCD TO BS2300-AWCD MOVE BS7435-NTYP TO BS2300-NTYP MOVE BS7435-BMP003-ABWKZ TO BS2300-ABWKZ MOVE '668' TO BS2300-PRSTM * *----> ----------------------- * *----> HIFVAM HIF VORGANGSART * *----> ----------------------- MOVE VBA4379-TRART TO BS2300-HIFVAM * *----> ---------------------------------- * *----> HIFPIM HIF PROGRAMM-IDENTIFIKATION * *----> ---------------------------------- MOVE PID TO BS2300-HIFPIM * *----> ------------------ * *----> HIFREM HIF RESERVE * *----> ------------------ MOVE SPACE TO BS2300-HIFREM * *----> ----------------------------------------- * *----> VERGABE DES FEHLERTEXT ABHäNGIG VON DER * *----> RUFENDEN PROGRAMMROUTINE * *----> BS2300-ZSCHM --> '2': ZWEIZEILIGE AUSGABE * *----> ----------------------------------------- EVALUATE TRUE WHEN M-PROT-BMP55-TAG-UNBEKANNT WHEN M-FEHLER-PLAUSI-BMP55 * *----> ---------------------- * *----> AUSGABE IN EINER ZEILE * *----> ---------------------- MOVE '1' TO BS2300-ZSCHM WHEN OTHER * *----> ---------------------- * *----> AUSGABE IN ZWEI ZEILEN * *----> ---------------------- MOVE BS2300-FTXT1M TO BS2300-FTXT2M MOVE 'BA668T HIER FEHLT EINE FEHLERMELDUNG' TO BS2300-FTXT1M MOVE '2' TO BS2300-ZSCHM END-EVALUATE * *----> ----------- * *----> TEST-TRACE * *----> ----------- IF VBA0872-IMSTYP-TEST THEN IF BS2300-ZSCHM = '1' OR '2' THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-FTXT1M:' BS2300-FTXT1M '#' END-IF IF BS2300-ZSCHM = '2' THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-FTXT2M:' BS2300-FTXT2M '#' END-IF DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VBA1081-STKZ = #' VBA1081-STKZ '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VBA1081-NTE = #' VBA1081-NTE '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VBA1081-HERK = #' VBA1081-HERK '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VBA1081-PRST = #' VBA1081-PRST '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VBA1081-ABWKZ = #' VBA1081-ABWKZ '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' VBA1081-AWC = #' VBA1081-AWC '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-ART = #' BS2300-ART '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-AWCD = #' BS2300-AWCD '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-NTYP = #' BS2300-NTYP '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-ABWKZ = #' BS2300-ABWKZ '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-PRSTM = #' BS2300-PRSTM '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-HIFVAM = #' BS2300-HIFVAM '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-HIFKAM = #' BS2300-HIFKAM '#' DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' BS2300-HIFNRM = #' BS2300-HIFNRM '#' END-IF * *----> ---------------------------------------- * *----> AUFRUF BA108U - SCHREIBEN IN KONTROLL-DB * *----> ---------------------------------------- CALL BA108U USING VBA1081 PCB-SYNCP PCB-PROTP BS1830 BS2328 BS2300 BS2319 * *----> ------------------------------------- * *----> PROGRAMMABBRUCH MIT FEHLERTEXT FU008U * *----> ------------------------------------- IF VBA1081-AWC NOT = ZERO THEN IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' FEHLER AUS BA108U:' VBA1081-AWC END-IF SET M-FEHLER-BA108U TO TRUE PERFORM U99-ABEND END-IF * *----> ----------------------------------- * *----> PROTOKOLLSCHALTER LöSCHEN! WICHTIG! * *----> ----------------------------------- SET M-PROT-UNBELEGT TO TRUE MOVE SPACE TO BS2300-FTXT2M * *----> ---------- * *----> TEST-TRACE * *----> ---------- IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' ----------------------------' '--ENDE-PROT-VM---------------' END-IF CONTINUE. ./USER U99A REPLACING. ./USER U99-ABEND TEXT. * *----> ------------------------------------------- * *----> PROGRAMMABBRUCH MIT FEHLERTEXT DURCH FU008U * *----> ------------------------------------------- ./USER U99-ABEND PROC. * *----> ------------ * *----> TEST-TRACING * *----> ------------ IF VBA0872-IMSTYP-TEST THEN DISPLAY SWT-PGM-NAME SWT-MODNAME ' :' ' JETZT MACHTS PENG!' END-IF * *----> ----------------- * *----> INFO-TEXT BELEGEN * *----> ----------------- MOVE '14' TO INFO-ANZAHL MOVE SWT-PGM-NAME TO INFO-PGM MOVE BS7435-NTYP TO INFO-NT MOVE VBA4379-BLZKA TO INFO-BLZ MOVE BS7435-BMP002-PANKTONR TO INFO-KTONR MOVE BS7435-BMP011-TRNR TO INFO-TRNR MOVE Z-TRDAT TO INFO-TRDAT MOVE BS7435-BMP012-TRUHR TO INFO-TRUHR MOVE VBA4379-RZBKK TO INFO-RZBK MOVE BS7435-BMP025-KONCD TO INFO-KOND * *----> --------------------------------------- * *----> DUMP-TEXTE ABHäNGIG VOM FEHLER AUFBAUEN * *----> --------------------------------------- EVALUATE TRUE WHEN M-FEHLER-BA108U-PROT WHEN M-FEHLER-BA108U MOVE VBA1081-AWC TO INFO-BA108U-AWC STRING INFO-BA108U '*********' ' VBA1081=' VBA1081 DELIMITED BY SIZE INTO INFO-TABELLE WHEN OTHER MOVE BS2300-FTXT1M TO INFO-TABELLE END-EVALUATE * *----> ----------------- * *----> JETZT MACHTS PENG * *----> ----------------- CALL FU008U USING K-ABEND INFO-TEXT CONTINUE. ./USER I05X REPLACING. ./USER I10X REPLACING. ./USER I15X REPLACING. ./USER I20X REPLACING. ./USER I25X REPLACING. ./USER I30X REPLACING. ./USER I35X REPLACING. ./USER I50X REPLACING. ./USER I55X REPLACING. ./USER V20Y05 REPLACING.