GeMIS_WEB/GUI/swissQR/SwissQrCode.p

/*------------------------------------------------------------------------
    File        : demoSwissQrCode.p
    Purpose     : 

    Syntax      :

    Description : 

    Author(s)   : javier.garcia
    Created     : Wed Sep 23 15:51:17 CEST 2020
    Notes       :
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

BLOCK-LEVEL ON ERROR UNDO, THROW.

USING src.ch.adprime.swissQR.SwissQrHandler FROM PROPATH.
USING src.ch.adprime.swissQR.beans.Address FROM PROPATH.
USING src.ch.adprime.swissQR.beans.Bill FROM PROPATH.
USING src.ch.adprime.swissQR.beans.Format FROM PROPATH.
USING src.ch.adprime.swissQR.beans.SwissQr FROM PROPATH.
USING src.ch.adprime.swissQR.incl.Language FROM PROPATH.
USING src.ch.adprime.communication.FileHandler FROM PROPATH.

DEFINE INPUT PARAMETER iphAufko    AS HANDLE    NO-UNDO.
DEFINE INPUT PARAMETER ipcFileName AS CHARACTER NO-UNDO.

DEFINE VARIABLE ii         AS INTEGER   NO-UNDO.
DEFINE VARIABLE cQRIBAN    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFirma     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cName      AS CHARACTER NO-UNDO.
DEFINE VARIABLE cZusatz    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cStrasse   AS CHARACTER NO-UNDO.
DEFINE VARIABLE cStrNr     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cLkz       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPlz       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cOrt       AS CHARACTER NO-UNDO.
DEFINE VARIABLE lBetrag    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE PZReferenz AS CHARACTER NO-UNDO.
DEFINE VARIABLE cString    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFileName  AS CHARACTER NO-UNDO.
DEFINE VARIABLE hFeld      AS HANDLE    NO-UNDO.
DEFINE VARIABLE iBank      AS INTEGER   NO-UNDO.
DEFINE VARIABLE iKnrStart  AS INTEGER   NO-UNDO.
DEFINE VARIABLE iKnrLang   AS INTEGER   NO-UNDO.
DEFINE VARIABLE iFnrStart  AS INTEGER   NO-UNDO.
DEFINE VARIABLE iFnrLang   AS INTEGER   NO-UNDO.
DEFINE VARIABLE iSprcd     AS INTEGER   NO-UNDO.

{ swissqr/propertiesSwissQR.i }

DEFINE VARIABLE oSwissQrHandler      AS SwissQrHandler NO-UNDO.
DEFINE VARIABLE oSwissQr             AS SwissQr        NO-UNDO.
DEFINE VARIABLE oBill                AS Bill           NO-UNDO.
DEFINE VARIABLE oCreditor            AS Address        NO-UNDO.
DEFINE VARIABLE oDebitor             AS Address        NO-UNDO.
DEFINE VARIABLE oFormat              AS Format         NO-UNDO.

DEFINE VARIABLE opErrorMessage       AS CHARACTER      NO-UNDO.
DEFINE VARIABLE opDataBuffer         AS MEMPTR         NO-UNDO.
DEFINE VARIABLE opFormat             AS CHARACTER      NO-UNDO.
DEFINE VARIABLE opReference          AS CHARACTER      NO-UNDO.

DEFINE VARIABLE retVal               AS LOGICAL        NO-UNDO.

DEFINE VARIABLE cAccount             AS CHARACTER      NO-UNDO.
DEFINE VARIABLE fAmount              AS DECIMAL        NO-UNDO.
DEFINE VARIABLE cCurrency            AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cBillInformation     AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cReference           AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cUnstructuredMessage AS CHARACTER      NO-UNDO.

DEFINE VARIABLE cAddressLine1Cred    AS CHARACTER      NO-UNDO.    
DEFINE VARIABLE cAddressLine2Cred    AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cCityCred            AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cCountryCodeCred     AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cHouseNoCred         AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cNameCred            AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cPostalCodeCred      AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cStreetCred          AS CHARACTER      NO-UNDO.

DEFINE VARIABLE cAddressLine1Deb     AS CHARACTER      NO-UNDO.    
DEFINE VARIABLE cAddressLine2Deb     AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cCityDeb             AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cCountryCodeDeb      AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cHouseNoDeb          AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cNameDeb             AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cPostalCodeDeb       AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cStreetDeb           AS CHARACTER      NO-UNDO.

DEFINE BUFFER bAdresse FOR Adresse.

DEFINE TEMP-TABLE tAufko LIKE Aufko
    FIELD iRecid  AS RECID
    FIELD lBetrag AS LOGICAL.
DEFINE VARIABLE htAufko AS HANDLE NO-UNDO.
htAufko = TEMP-TABLE tAufko:DEFAULT-BUFFER-HANDLE.

/* ********************  Preprocessor Definitions  ******************** */


/* ***************************  Main Block  *************************** */

MAINBLOCK:
DO WHILE TRUE:
    CREATE tAufko.
    htAufko:BUFFER-COPY(iphAufko).

    FIND Steuer NO-LOCK
        WHERE Steuer.Firma = tAufko.Firma.
        
    cURL_API-QrCode     = DYNAMIC-FUNCTION ('getFehlwert':U, tAufko.Firma, 'HTTP_QRCODE')    NO-ERROR. 
    cKeyName_API-QrCode = DYNAMIC-FUNCTION ('getFehlwert':U, tAufko.Firma, 'KEYNAME_QRCODE') NO-ERROR. 
    cApiKey_API-QrCode  = DYNAMIC-FUNCTION ('getFehlwert':U, tAufko.Firma, 'API_KEY_QRCODE') NO-ERROR.       
    
    FIND bAdresse NO-LOCK
        WHERE bAdresse.Firma = tAufko.Firma
        AND   bAdresse.Knr   = tAufko.Fak_Knr NO-ERROR.
    IF NOT AVAILABLE bAdresse THEN RETURN.
    iSprcd = bAdresse.Sprcd.
    
    FIND Debst NO-LOCK 
        WHERE Debst.Firma = tAufko.Firma
        AND   Debst.Knr   = tAufko.Fak_Knr NO-ERROR.
    iBank = Debst.BESR_Art.
    
    FIND Bankst NO-LOCK 
        WHERE Bankst.Bank = iBank NO-ERROR.
    IF NOT AVAILABLE Bankst THEN 
    DO:
        IF iBank = 0 THEN 
        DO:
            iBank = 1.
            FIND Bankst NO-LOCK 
                WHERE Bankst.Bank = iBank NO-ERROR.
        END.
    END.
    IF NOT AVAILABLE Bankst THEN 
    DO:
        FIND FIRST Bankst NO-LOCK NO-ERROR. 
    END.
    IF NOT AVAILABLE Bankst THEN RETURN.

    /*  ------------------  */
    /*  Kreditor-Adresse    */    
    /*  ------------------  */
    FIND Steuer NO-LOCK WHERE Steuer.Firma = tAufko.Firma.
    
    cFirma    = Steuer.Firma1.
    cZusatz   = Steuer.Firma2. 

    iKnrStart = INTEGER(SUBSTRING(STRING(Steuer.St07,'9999'),01,02)).
    iKnrLang  = INTEGER(SUBSTRING(STRING(Steuer.St07,'9999'),03,02)).
    iFnrStart = INTEGER(SUBSTRING(STRING(Steuer.St08,'9999'),01,02)).
    iFnrLang  = INTEGER(SUBSTRING(STRING(Steuer.St08,'9999'),03,02)).
    
    ii = NUM-ENTRIES(Steuer.Strasse, ' ').
    IF ii > 1 THEN cStrNr = ENTRY(ii, Steuer.Strasse, ' ').
    
    IF cStrNr = '' THEN cStrasse = Steuer.Strasse.
    ELSE                cStrasse = TRIM(REPLACE(Steuer.Strasse, cStrNr, '')).
    
    ii = NUM-ENTRIES(Steuer.Ort, ' ').
    IF ii > 1 THEN cPlz = ENTRY(1, Steuer.Ort, ' ').
    
    IF cPlz = '' THEN cOrt = Steuer.Ort.
    ELSE              cOrt = TRIM(REPLACE(Steuer.Ort, cPlz, '')).
    
    IF cLkz = '' THEN cLkz = 'CH'.

    /*  ----------------------  */
    /*  Debitor-/Kunden-Adresse */ 
    /*  ----------------------  */
    DO WHILE TRUE:
        IF  tAufko.Adr[04] = '' AND
            tAufko.Adr[05] = '' THEN     /*  Keine Adresse im Auftrag vorhanden  */
        DO:
            IF bAdresse.Firma1 <> '' THEN cName = TRIM(SUBSTRING(bAdresse.Firma1  + ' ' + bAdresse.Firma2,01,40)).
            ELSE                          cName = TRIM(SUBSTRING(bAdresse.Vorname + ' ' + bAdresse.Name  ,01,40)).
            ASSIGN
                cAddressLine1Deb = ''
                cAddressLine2Deb = ''
                cCityDeb         = bAdresse.Ort
                cCountryCodeDeb  = bAdresse.Lkz
                cHouseNoDeb      = ''
                cNameDeb         = cName 
                cPostalCodeDeb   = bAdresse.Plz
                cStreetDeb       = bAdresse.Strasse.
                
            ii = NUM-ENTRIES(cStreetDeb, ' ').
            IF ii > 1 THEN cHouseNoDeb = ENTRY(ii, cStreetDeb, ' ').
    
            IF cHouseNoDeb <> '' THEN cStreetDeb = TRIM(REPLACE(cStreetDeb, cHouseNoDeb, '')).
    
            LEAVE.
        END.
    
        ELSE 
        DO:        /*  Adresse im Auftrag erfasst  */ 
            ASSIGN
                cAddressLine1Deb = ''
                cAddressLine2Deb = ''
                cCityDeb         = tAufko.Adresse[05]
                cCountryCodeDeb  = bAdresse.Lkz
                cHouseNoDeb      = ''
                cPostalCodeDeb   = ''
                cStreetDeb       = tAufko.Adresse[04].
            DO ii = 1 TO 3:
                IF tAufko.Adr[ii] = '' THEN NEXT.
                cNameDeb = tAufko.Adresse[ii].
                LEAVE.
            END.
            
            ii = NUM-ENTRIES(cStreetDeb, ' ').
            IF ii > 1 THEN cHouseNoDeb = ENTRY(ii, cStreetDeb, ' ').
    
            IF cHouseNoDeb <> '' THEN cStreetDeb = TRIM(REPLACE(cStreetDeb, cHouseNoDeb, '')).
    
            ii = NUM-ENTRIES(cCityDeb, ' ').
            IF ii > 1 THEN cPostalCodeDeb = ENTRY(1, cCityDeb, ' ').
    
            IF cPostalCodeDeb <> '' THEN cCityDeb = TRIM(REPLACE(cCityDeb, cPostalCodeDeb, '')).
            LEAVE.
        END.
    
        LEAVE.
    END.

    FIND Kondi NO-LOCK 
        WHERE Kondi.Sprcd = bAdresse.Sprcd
        AND   Kondi.Kond  = tAufko.Kond NO-ERROR.
    lBetrag = (IF tAufko.Auf_Tot > 0 THEN TRUE ELSE FALSE).
    IF AVAILABLE Kondi THEN 
    DO:
        IF  Kondi.Skonto[01] <> 0 OR
            Kondi.Skonto[02] <> 0 THEN lBetrag = FALSE.
    END.
    
    hFeld = htAufko:BUFFER-FIELD('lBetrag') NO-ERROR.
    IF VALID-HANDLE(hFeld) THEN 
    DO:
        IF hFeld:BUFFER-VALUE BEGINS 'n' THEN lBetrag = FALSE.
    END.

    PZReferenz = FILL('0', 26).
    SUBSTRING(PZReferenz,01)        = STRING(Bank.BESR-Konto,'99999999999999').
    cString = FILL('9', iKnrLang).
    SUBSTRING(PZReferenz,iKnrStart) = STRING(tAufko.Fak_Knr,cString).
    cString = FILL('9', iFnrLang).
    SUBSTRING(PZReferenz,iFnrStart) = STRING(tAufko.Faknr  ,cString).

    RUN PRUEFZIFFER ( INPUT-OUTPUT PZReferenz, OUTPUT cReference ).

    cString   = SUBSTITUTE('&1;&2;&3;&4;&5;&6', cFirma, cStrasse, cStrNr, cLkz, cPlz, cOrt).
    cFileName = SUBSTITUTE('&1&2_&3', cPathQRCodes, 'QR_CODE', STRING(tAufko.Faknr,'9999999')).

    ASSIGN
        fAmount              = (IF lBetrag THEN tAufko.Auf_Tot ELSE 0.00)
        cCurrency            = tAufko.Frw
        cBillInformation     = ''
        cUnstructuredMessage = SUBSTITUTE('Faktura &1', TRIM(STRING(tAufko.Faknr,"zzzzzz9"))).

    cAccount = REPLACE(Bankst.QR-IBAN, ' ', '').

    ASSIGN 
        cAddressLine1Cred = ''  /*cZusatz*/
        cAddressLine2Cred = ''
        cCityCred         = cOrt
        cCountryCodeCred  = cLkz
        cHouseNoCred      = cStrNr
        cNameCred         = cFirma
        cPostalCodeCred   = cPlz
        cStreetCred       = cStrasse.
    
    IF lDebug THEN 
        MESSAGE cFirma SKIP cZusatz SKIP cStrasse '-' cStrNr SKIP
            clkz '-' cPlz '-' cOrt
            VIEW-AS ALERT-BOX.

// Setup bill
    oBill = NEW Bill().
    oBill:cAccount              = cAccount.
    oBill:cCurrency             = cCurrency.
    oBill:cReference            = cReference.
    oBill:cUnstructuredMessage  = cUnstructuredMessage.
    IF lBetrag THEN oBill:fAmount = fAmount.

    IF lDebug THEN
        MESSAGE cNameDeb SKIP cStreetDeb SKIP cHouseNoDeb SKIP cCountryCodeDeb SKIP cpostalcodedeb SKIP ccitydeb SKIP
            cNamecred SKIP cStreetcred SKIP cHouseNocred SKIP cCountryCodecred SKIP cpostalcodecred SKIP ccitycred SKIP
            caccount SKIP famount SKIP ccurrency SKIP cbillinformation SKIP creference SKIP
            VIEW-AS ALERT-BOX.
// Set creditor
    oCreditor = NEW Address(
        INPUT cAddressLine1Cred,
        INPUT cAddressLine2Cred,
        INPUT cCityCred,
        INPUT cCountryCodeCred,
        INPUT cHouseNoCred,
        INPUT cNameCred,
        INPUT cPostalCodeCred,
        INPUT cStreetCred).

// Set debtor
    oDebitor = NEW Address(
        INPUT cAddressLine1Deb,
        INPUT cAddressLine2Deb,
        INPUT cCityDeb,
        INPUT cCountryCodeDeb,
        INPUT cHouseNoDeb,
        INPUT cNameDeb,
        INPUT cPostalCodeDeb,
        INPUT cStreetDeb).

// Set Format Props
    oFormat = NEW Format().
    oFormat:iResoluation = 300.
    /*oFormat:eLanguage   = LANGUAGE:EN.                              */
    /*oFormat:eFormatTyp  = FormatTyp:JPG.                            */
    /*oFormat:ePositionBill = PositionBill:END_OF_DOCUMENT.           */
    /*oFormat:eOutputSize   = OutputSize:QR_BILL_WITH_HORIZONTAL_LINE.*/

    CASE Steuer.Fwc10:  /*  Installation/Kunde  */
        WHEN 'LaTorre' THEN DO:
            CASE iSprcd:
                WHEN 2 THEN iSprcd = 3.
                WHEN 3 THEN iSprcd = 2.
                WHEN 4 THEN iSprcd = 5.
                END CASE.
            END.
    END CASE.

    CASE iSprcd:
        WHEN 1 THEN 
            oFormat:eLanguage = LANGUAGE:DE.
        WHEN 2 THEN 
            oFormat:eLanguage = LANGUAGE:FR.
        WHEN 3 THEN 
            oFormat:eLanguage = LANGUAGE:IT.
        WHEN 5 THEN 
            oFormat:eLanguage = LANGUAGE:EN.
    END.

/*    lDebug = TRUE.*/
    oSwissQr        = NEW SwissQr(INPUT oBill, INPUT oCreditor, INPUT oDebitor, INPUT oFormat ).
    oSwissQrHandler = NEW SwissQrHandler(INPUT cURL_API-QrCode, INPUT cKeyName_API-QrCode, INPUT cApiKey_API-QrCode, INPUT lDebug).

    retVal = oSwissQrHandler:getSwissQrBill(
        INPUT  oSwissQR, 
        OUTPUT opErrorMessage,
        OUTPUT opDataBuffer,
        OUTPUT opFormat,
        OUTPUT opReference).

    IF lDebug THEN 
        MESSAGE "ENDE: " retVal SKIP 
            'Message' operrormessage SKIP 
            'Format' opformat SKIP 
            'Referenz' opreference
            VIEW-AS ALERT-BOX.       

    IF retVal THEN 
    DO:
        retVal = FileHandler:saveFile(
            INPUT "",
            INPUT ipcFileName,
            INPUT opFormat,
            INPUT opDataBuffer,
            OUTPUT opErrorMessage).
    END.

    LEAVE.
END.
    

/* **********************  Internal Procedures  *********************** */

PROCEDURE PRUEFZIFFER:
    /* ------------------------------------------------------------------------- */
    /*  Prufziffer MODULO 10, Rekursiv (27 Stellig Ref.-Nr.)                     */
    /* ------------------------------------------------------------------------- */
    /*                                                                           */
    /*  Uebergabe Variable:  1.  String Betrag              (12-stellig)         */
    /*                       2.  String Referenz            (27-stellig)         */
    /*                       3.  String Teilnehmernummer    ( 9-stellig)         */
    /*                                                                           */
    /*  Erstellung der VESR-Codierzeile                                          */
    /*                                                                           */
    /*---------------------------------------------------------------------------*/

    DEFINE INPUT-OUTPUT PARAMETER PZReferenz   AS CHARACTER FORMAT "x(27)".
    DEFINE OUTPUT       PARAMETER VSZeile      AS CHARACTER FORMAT "x(58)".
    
    DEFINE VARIABLE l1     AS INTEGER.
    DEFINE VARIABLE l2     AS INTEGER.
    DEFINE VARIABLE l3     AS INTEGER.
    DEFINE VARIABLE PZ     AS INTEGER.
    DEFINE VARIABLE x1     AS INTEGER.
    DEFINE VARIABLE x2     AS INTEGER.
    DEFINE VARIABLE x3     AS INTEGER.
    DEFINE VARIABLE VMOD10 AS CHARACTER FORMAT "x(11)" EXTENT 11.

    VMOD10[01] = "09468271350".
    VMOD10[02] = "94682713509".
    VMOD10[03] = "46827135098".
    VMOD10[04] = "68271350947".
    VMOD10[05] = "82713509466".
    VMOD10[06] = "27135094685".
    VMOD10[07] = "71350946824".
    VMOD10[08] = "13509468273".
    VMOD10[09] = "35094682712".
    VMOD10[10] = "50946827131".

    l1 = 12.
    l2 = 26.
    l3 = 08.

    DO WHILE l2 = 26:
        x2 = 1.
        x1 = INT(SUBSTRING(PZReferenz,01    ,01)).
        x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).

        DO x3 = 2 TO 26:
            x1 = INT(SUBSTRING(PZReferenz    ,x3    ,01)).
            x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
        END.

        PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
        SUBSTRING(PZReferenz,27) = STRING(PZ,"9").
        LEAVE.
    END.
    
    VSZeile = PZReferenz.

END PROCEDURE.