String mit Zoned-Repräsentation in packed umwandeln

[dschroeder]

Hallo,
ich muss leider nochmal etwas fragen. Wahrscheinlich sehe ich den Wald vor lauter Bäumen gerade nicht:

Ich bekomme (aus einer zu importierenden Textdatei) einen String, der eine Zahl im gezonten Format enthält. Also z.B. "000005843M". Gibt es eine einfache Möglichkeit, das in eine gepackte Zahl umzuwandeln? Am liebste wäre mir etwas Allgemeingültiges, das die Dezimalstellen flexibel handhabt. Aber das ist erstmal nicht entscheidend.

Im obigen Beispiel müsste -584,34 herauskommen (glaube ich). Also 2 Dezimalstellen.

Ich habe schon mit Konvertierungen peri Datenstruktur oder per SQL-Funktion ZONED() versucht. Aber es hat bisher nicht geklappt. Ist das echt so schwierig? Muss ich das echt selber ausprogrammieren?

[KingofKning]

Wenn Du über SQL sprichst, kannst Du doch solche Konstruktionen machen "CASE WHEN BWVGAR = 151 THEN -BWBMEN WHEN BWVGAR = 7 THEN -BWBMEN ELSE BWBMEN END"
Sprich Case etc. Wenn "M" dann /-100 (dividiert)

GG 4719

[dschroeder]

Danke für deine Antwort. Ich benötige das nicht in SQL. Mein Ziel ist es, ein möglichst allgemeingültiges Tool zu schreiben, das einen gezonten Wert (als String) bekommt und eine gepackte Zahl, z.B. immer im Format packed(30:10), zurückgibt. Da SQL eine Funktion ZONED() anbietet, hatte ich zunächst gedacht, ich könnte damit im embedded SQL etwas anfangen. Hat aber nicht geklappt.

Ich werde es wohl tatsächlich ausprogrammieren müssen. Ein Tool, was mir das letzte Byte in eine Ziffer und ein Vorzeichen umwandelt, habe ich bereits. Ich hatte nur gedacht, es gäbe heutzutage irgendeine total einfach Methode, die ich übersehe.

[BenderD]

... versteh ich das irgendwie falsch? Das ist doch elementar, das Einzige, was nicht ganz glatt ist: weder der Alfawert noch eine zoned Variable weiß wieviel Nachkommastellen er/sie hat.
Das ist doch simpel eine Procedure huddel2pack(huddel : scale), die eine packed(30:10) zurückgibt (huddel ist alfa, scale ist int).
Drin eine DS mit Alfa und zoned Feld überlagert. Parameter in alfa rein, durch scale dividieren und an den Returnwert zuweisen.

D*B

[Dschainers]

Ich denke mal man muss da schon eine Routine sich ausdenken.
Egal ob Huddel, Pack oder sonst was (@BenderD).
Auch egal in welcher Programmumgebung.
Einfach eine Routine schreiben, die man immer aufrufen kann.
Ich mach meine Sachen am Liebsten immer selbst, da weiß ich was ich hab.

[dschroeder]

... versteh ich das irgendwie falsch? Das ist doch elementar, das Einzige, was nicht ganz glatt ist: weder der Alfawert noch eine zoned Variable weiß wieviel Nachkommastellen er/sie hat.
Das ist doch simpel eine Procedure huddel2pack(huddel : scale), die eine packed(30:10) zurückgibt (huddel ist alfa, scale ist int).
Drin eine DS mit Alfa und zoned Feld überlagert. Parameter in alfa rein, durch scale dividieren und an den Returnwert zuweisen.

D*B

Ja, du hast recht. Genauso habe ich es jetzt auch gelöst. Habe gestern wohl etwas auf dem Schlauch gestanden. Bin gerade erst damit fertig geworden, sonst hätte ich mich schon eher gemeldet. Also vielen Dank.

Hier die Lösung:

dcl-proc um_cvtZonedStrToPacked export;
   dcl-pi *n packed(30:10);
      i#zoned varchar(30) const;
      i#dezimalOpt packed(2) const options(*nopass);
   end-pi;


dcl-s dezimal packed(2);
dcl-s divisor packed(30);
dcl-s result packed(30:10);


dcl-ds convert;
   charFeld char(30);
   zonedFeld zoned(30) overlay(charFeld);
end-ds;


if %parms >= %parmnum(i#dezimalOpt);
   dezimal = i#dezimalOpt;
endif;


monitor;
   charFeld = *zero;
   //Den zoned String rechtsbündig unter Beibehaltung der Vornullen 
   //in das charFeld einfügen:
   charFeld = um_insertRight(charFeld:%trim(i#zoned));
on-error;
   zonedFeld = 0;
endmon;

divisor = 10**dezimal;
result = zonedFeld / divisor;
return result;

end-proc;

[Rainer Ross]

Hallo,
ich habe noch eine Idee für eine Lösung, die auf der Idee beruht, dass, wenn der String in Hex umgewandelt wird, das Vorzeichen im vorletzten Byte gespeichert ist.

Jede Zahl hat einen Hexwert, z.B. 1 = F1, 2 = F2, 9 = F9
Das Vorzeichen wird im letzten Zeichen eingebaut, so dass der Hexwert von 000005843M als Ergebnis F0F0F0F0F0F5F8F4F3D4 hat. Das bedeutet, wenn das vorletzte Byte der Hexsequenz nicht F ist, muss die Zahl negativ sein.

         ctl-opt main(main) dftactgrp(*no) option(*nounref);                                                            
      //------------------------------------------------------------------//                                            
      //                                                                  //                                            
      // Convert Zoned to Packed from String                              //                                            
      //                                                                  //                                            
      //-----------------                                                 //                                            
      // R.Ross 06.2017 *                                                 //                                            
      //------------------------------------------------------------------//                                            
      // CVTHC - Convert Character to Hex                                 //                                            
      //------------------------------------------------------------------//                                            
                                                                                                                        
         dcl-pr charToHex    extproc('cvthc');                                                                          
                 ##hex       char(100) options(*varsize);                                                               
                 ##chr       char(100) options(*varsize);                                                               
                 ##len       int(10)   value;                                                                            
         end-pr;                                                                                                        
                                                                                                                        
      //------------------------------------------------------------------//                                            
      // Main                                                             //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc Main;                                                                                                 
                                                                                                                        
         dcl-s   p#string    varchar(50);             // String                                                         
         dcl-s   p#number    packed(30:9);            // Number                                                         
                                                                                                                        
           p#string = '000005843M';                                                                                     
                                                                                                                        
           p#number = cvtZonedToPacked(p#string:2);                                                                     
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//                                            
      // Convert Zoned to Packed from String                              //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc cvtZonedToPacked;                                                                                     
         dcl-pi *n           like(p#number);                                                                            
                 ##string    like(p#string) const options(*varsize:*trim);                                              
                 ##decimals  uns(5)         const options(*nopass);                                                     
         end-pi;                                                                                                        
                                                                                                                        
         dcl-s   p#number    packed(30:9);            // Number                                                         
         dcl-s   p#string    char(100);               // String                                                         
         dcl-s   p#hex       char(100);               // Hex                                                            
         dcl-s   p#length    uns(10);                 // Length                                                         
                                                                                                                        
           p#string = ##string;                       // String                                                         
           p#length = %len(%trim(p#string));          // StringLength                                                   
                                                                                                                        
           charToHex(p#hex:p#string:p#length * 2);    // Character to Hex                                               
                                                                                                                        
           if %subst(p#hex:(p#length * 2) - 1) = 'F'; // F = Positive Number                                            
              p#number = %dec(%trim(p#string):30:9);  // StringToNumber                                                 
            else;                                     // Negative Number                                                
              %subst(p#string:p#length:1) = %subst(p#hex:p#length * 2:1);                                               
              p#string = %trim(p#string) + '-';       // Negative Sign                                                  
              p#number = %dec(%trim(p#string):30:9);  // StringToNumber                                                 
           endif;                                                                                                       
                                                                                                                        
           if %parms >= %parmnum(##decimals);         // Decimals                                                       
              p#number /= 10 ** ##decimals;           // Decimals                                                       
           endif;                                                                                                       
                                                                                                                        
           return p#number;                           // Number                                                         
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//

Herzliche Grüße
Rainer

[dschroeder]

Hallo Rainer,

geht sicherlich auch. Ich bin mir allerdings nicht sicher, ob die Anweisung p#number /= 10 ** ##decimals; so einfach funktioniert. Ich hatte das so ähnlich bei mir zuerst auch drin. In irgendeinem Testfall (den ich aber nicht mehr weiß) hatte ich dann aber einen Rundungsfehler auf der letzten Stelle. Ich glaube, durch die "komplexe" Anweisung geht etwas Genauigkeit verloren. Nachdem ich das in einzelne Rechenschritte zerlegt habe, lief es auch in dem Testfall perfekt.

Dieter

[BenderD]

Ich bin mir allerdings nicht sicher, ob die Anweisung p#number /= 10 ** ##decimals; so einfach funktioniert. Ich hatte das so ähnlich bei mir zuerst auch drin. In irgendeinem Testfall (den ich aber nicht mehr weiß) hatte ich dann aber einen Rundungsfehler auf der letzten Stelle. Ich glaube, durch die "komplexe" Anweisung geht etwas Genauigkeit verloren. Nachdem ich das in einzelne Rechenschritte zerlegt habe, lief es auch in dem Testfall perfekt.

Dieter

... möglicherweise rechnet der das mit float, was diesen Effekt erklären würde. Den Knast in den Variablennamen sollte man sich verkneifen, §$&# und Konsorten gehören zu den Zeichen, die im EBCDIC nicht konsistent übertragen werden, was im internationalen Umfeld zu Problemen führen kann.

D*B

[Fuerchau]

Warum immer so kompliziert?
Die klassische MOVE-Anweisung regelt das automatisch und bei fehlerhaften Ziffern einfach ein Monitor drumrum:

D MYNumber 31p 0
D MyChar 30

// Woherauch immer der Wert kommt
evalr MyChar = WasAuchImmer;
monitor;
C MOVE(P) MyChar MyNumber
on-error *all;
// Fehlerbehandlung
endmon;

Der Move überträgt rechtsbündig in das Zielfeld. Ziffern werden konvertiert und vom rechten Zeichen wird die linke Tetrade (C, D, E, F) als Vorzeichen und die Rechte Tetrade (0-9) als Ziffer.
So haben wir seit gefühlten 100 Jahren konvertiert.
Die Kommaausrichtung kann dann wie gehabt erfolgen.

Und wofür CharToHex?
Ein einfaches %Bitand(Char:'0') ergibt eben x'F0' = '0'.

[dschroeder]

Warum immer so kompliziert?
Die klassische MOVE-Anweisung regelt das automatisch und bei fehlerhaften Ziffern einfach ein Monitor drumrum:
...
Der Move überträgt rechtsbündig in das Zielfeld. Ziffern werden konvertiert und vom rechten Zeichen wird die linke Tetrade (C, D, E, F) als Vorzeichen und die Rechte Tetrade (0-9) als Ziffer.
So haben wir seit gefühlten 100 Jahren konvertiert.
Die Kommaausrichtung kann dann wie gehabt erfolgen.

Der MOVE hat einem wirklich oft aus der Patsche geholfen bei Konvertierung und so. Aber im fully free format sind keine fixed form Anweisungen mehr möglich. Der MOVE scheidet in ganz neuen Programmen deshalb (leider) aus. Bei dem Beispiel von Rainer Ross scheint es sich allerdings nur um "total free" (und nicht "fully free") zu handeln. Da ginge der MOVE tatsächlich noch.

[Rainer Ross]

Ich werfe aufgrund der Anregung von Baldur noch eine Idee für "total" und "fully" free in den Hut

               ctl-opt main(main) dftactgrp(*no) option(*nounref);                                                            
      //------------------------------------------------------------------//                                            
      //                                                                  //                                            
      // Convert Zoned to Packed from String                              //                                            
      //                                                                  //                                            
      //-----------------                                                 //                                            
      // R.Ross 06.2017 *                                                 //                                            
      //------------------------------------------------------------------//                                            
      // Main                                                             //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc Main;                                                                                                 
                                                                                                                        
         dcl-s   LocString   varchar(30);             // String                                                         
         dcl-s   LocNumber   packed(11:2);            // Number                                                         
                                                                                                                        
           LocString = '000005843M';                                                                                    
           LocNumber = cvtZonedToPacked(LocString:2);                                                                   
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//                                            
      // Convert Zoned to Packed from String                              //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc cvtZonedToPacked;                                                                                     
         dcl-pi *n           like(LocNumber);                                                                           
                 PiString    varchar(30) const options(*varsize:*trim);                                                 
                 PiDecimals  uns(5)      const options(*nopass);                                                        
         end-pi;                                                                                                        
                                                                                                                        
         dcl-ds  PsString    qualified;                                                                                 
                  String     char(30);                                                                                  
                  Number     zoned(30) pos(01);                                                                         
         end-ds;                                                                                                        
                                                                                                                        
         dcl-s   LocNumber   packed(30:9);            // Number                                                         
                                                                                                                        
           evalr PsString.String = PiString;                                                                            
           LocNumber = PsString.Number;                                                                                 
                                                                                                                        
           if %parms >= %parmnum(PiDecimals);         // Decimals                                                       
              LocNumber /= 10 ** PiDecimals;          // Decimals                                                       
           endif;                                                                                                       
                                                                                                                        
           return LocNumber;                          // Number                                                         
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//